Released DVBA*2.7*156 SEQ #140 Extracted from mail message **KIDS**:DVBA*2.7*156^ **INSTALL NAME** DVBA*2.7*156 "BLD",8378,0) DVBA*2.7*156^AUTOMATED MED INFO EXCHANGE^0^3100831^y "BLD",8378,1,0) ^^3^3^3100819^ "BLD",8378,1,1,0) This patch fixes issues while compiling reports on Linux environments "BLD",8378,1,2,0) where the reports, when printed, are missing page breaks and removes extra "BLD",8378,1,3,0) pages printed during 2507 Request print/reprints. "BLD",8378,4,0) ^9.64PA^^ "BLD",8378,6.3) 8 "BLD",8378,"INID") ^ "BLD",8378,"INIT") "BLD",8378,"KRN",0) ^9.67PA^779.2^20 "BLD",8378,"KRN",.4,0) .4 "BLD",8378,"KRN",.401,0) .401 "BLD",8378,"KRN",.402,0) .402 "BLD",8378,"KRN",.403,0) .403 "BLD",8378,"KRN",.5,0) .5 "BLD",8378,"KRN",.84,0) .84 "BLD",8378,"KRN",3.6,0) 3.6 "BLD",8378,"KRN",3.8,0) 3.8 "BLD",8378,"KRN",9.2,0) 9.2 "BLD",8378,"KRN",9.8,0) 9.8 "BLD",8378,"KRN",9.8,"NM",0) ^9.68A^3^2 "BLD",8378,"KRN",9.8,"NM",2,0) DVBAB82^^0^B78772719 "BLD",8378,"KRN",9.8,"NM",3,0) DVBCRPR1^^0^B11695100 "BLD",8378,"KRN",9.8,"NM","B","DVBAB82",2) "BLD",8378,"KRN",9.8,"NM","B","DVBCRPR1",3) "BLD",8378,"KRN",19,0) 19 "BLD",8378,"KRN",19.1,0) 19.1 "BLD",8378,"KRN",101,0) 101 "BLD",8378,"KRN",409.61,0) 409.61 "BLD",8378,"KRN",771,0) 771 "BLD",8378,"KRN",779.2,0) 779.2 "BLD",8378,"KRN",870,0) 870 "BLD",8378,"KRN",8989.51,0) 8989.51 "BLD",8378,"KRN",8989.52,0) 8989.52 "BLD",8378,"KRN",8994,0) 8994 "BLD",8378,"KRN","B",.4,.4) "BLD",8378,"KRN","B",.401,.401) "BLD",8378,"KRN","B",.402,.402) "BLD",8378,"KRN","B",.403,.403) "BLD",8378,"KRN","B",.5,.5) "BLD",8378,"KRN","B",.84,.84) "BLD",8378,"KRN","B",3.6,3.6) "BLD",8378,"KRN","B",3.8,3.8) "BLD",8378,"KRN","B",9.2,9.2) "BLD",8378,"KRN","B",9.8,9.8) "BLD",8378,"KRN","B",19,19) "BLD",8378,"KRN","B",19.1,19.1) "BLD",8378,"KRN","B",101,101) "BLD",8378,"KRN","B",409.61,409.61) "BLD",8378,"KRN","B",771,771) "BLD",8378,"KRN","B",779.2,779.2) "BLD",8378,"KRN","B",870,870) "BLD",8378,"KRN","B",8989.51,8989.51) "BLD",8378,"KRN","B",8989.52,8989.52) "BLD",8378,"KRN","B",8994,8994) "BLD",8378,"QDEF") ^^^^NO^^^^^^NO "BLD",8378,"QUES",0) ^9.62^^ "BLD",8378,"REQB",0) ^9.611^1^1 "BLD",8378,"REQB",1,0) DVBA*2.7*119^1 "BLD",8378,"REQB","B","DVBA*2.7*119",1) "MBREQ") 0 "PKG",223,-1) 1^1 "PKG",223,0) AUTOMATED MED INFO EXCHANGE^DVBA^The entire AMIE package 7131/2507. "PKG",223,20,0) ^9.402P^^ "PKG",223,22,0) ^9.49I^1^1 "PKG",223,22,1,0) 2.7^2950410^2950508 "PKG",223,22,1,"PAH",1,0) 156^3100831 "PKG",223,22,1,"PAH",1,1,0) ^^3^3^3100831 "PKG",223,22,1,"PAH",1,1,1,0) This patch fixes issues while compiling reports on Linux environments "PKG",223,22,1,"PAH",1,1,2,0) where the reports, when printed, are missing page breaks and removes extra "PKG",223,22,1,"PAH",1,1,3,0) pages printed during 2507 Request print/reprints. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","DVBAB82") 0^2^B78772719^B72768005 "RTN","DVBAB82",1,0) DVBAB82 ;ALB - CAPRI DVBA REPORTS;03/08/02 "RTN","DVBAB82",2,0) ;;2.7;AMIE;**42,90,100,119,156**;Apr 10, 1995;Build 8 "RTN","DVBAB82",3,0) Q "RTN","DVBAB82",4,0) ; "RTN","DVBAB82",5,0) START(MSG,RPID,PARM) ; CALLED BY REMOTE PROCEDURE DVBAB REPORTS "RTN","DVBAB82",6,0) ;Parameters "RTN","DVBAB82",7,0) ;============= "RTN","DVBAB82",8,0) ; MSG : Output - ^TMP("DVBA",$J) "RTN","DVBAB82",9,0) ; RPID : Report Identification Number "RTN","DVBAB82",10,0) ; PARM : Input parameters separated by "^" "RTN","DVBAB82",11,0) ; "RTN","DVBAB82",12,0) N DVBHFS,DVBERR,DVBGUI,I "RTN","DVBAB82",13,0) K ^TMP("DVBA",$J) "RTN","DVBAB82",14,0) S DVBGUI=1,DVBERR=0,DVBHFS=$$HFS(),RPID=$G(RPID) "RTN","DVBAB82",15,0) I RPID<1!(RPID>9) S ^TMP("DVBA",$J,1)="0^Undefined Report ID" G END "RTN","DVBAB82",16,0) D HFSOPEN("DVBRP",DVBHFS,"W") I DVBERR G END "RTN","DVBAB82",17,0) I RPID=1 D CRMS G END "RTN","DVBAB82",18,0) I RPID=3 D CPRNT G END "RTN","DVBAB82",19,0) D CHECK I DVBERR G END "RTN","DVBAB82",20,0) I RPID=2 D CRRR G END "RTN","DVBAB82",21,0) I RPID=4 D CRPON G END "RTN","DVBAB82",22,0) I RPID=5 D CIRPT G END "RTN","DVBAB82",23,0) I RPID=6 D DSRP G END "RTN","DVBAB82",24,0) I RPID=7 D SDPP G END "RTN","DVBAB82",25,0) I RPID=8 D SPRPT G END "RTN","DVBAB82",26,0) I RPID=9 D VIEW "RTN","DVBAB82",27,0) ; "RTN","DVBAB82",28,0) END D HFSCLOSE("DVBRP",DVBHFS) "RTN","DVBAB82",29,0) ;Replace "##FFFF##" with Form Feeds - code needed for LINUX environments "RTN","DVBAB82",30,0) S I=0 F S I=$O(^TMP("DVBA",$J,1,I)) Q:'I D "RTN","DVBAB82",31,0) .S:^TMP("DVBA",$J,1,I)["##FFFF##" ^TMP("DVBA",$J,1,I)=$P(^TMP("DVBA",$J,1,I),"##FFFF##")_$C(13,12)_$P(^TMP("DVBA",$J,1,I),"##FFFF##",2) "RTN","DVBAB82",32,0) .S ^TMP("DVBA",$J,1,I)=^TMP("DVBA",$J,1,I)_$C(13) "RTN","DVBAB82",33,0) .S:^TMP("DVBA",$J,1,I)["$END" ^TMP("DVBA",$J,1,I)="" "RTN","DVBAB82",34,0) S MSG=$NA(^TMP("DVBA",$J)) "RTN","DVBAB82",35,0) Q "RTN","DVBAB82",36,0) CHECK ; VALIDATE INPUT PARAMETERS "RTN","DVBAB82",37,0) I $G(PARM)="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Input Parameters" "RTN","DVBAB82",38,0) Q "RTN","DVBAB82",39,0) ; "RTN","DVBAB82",40,0) SDPP ; Report # 7 - Full (Patient Profile MAS) Report "RTN","DVBAB82",41,0) ;Parameters "RTN","DVBAB82",42,0) ;============= "RTN","DVBAB82",43,0) ; DFN : Patient Identification Number "RTN","DVBAB82",44,0) ; SDR : R/Range or A/All "RTN","DVBAB82",45,0) ; SDBD : Begining date "RTN","DVBAB82",46,0) ; SDED : Ending date "RTN","DVBAB82",47,0) ; SDP : Print the profile? 1 OR 0 "RTN","DVBAB82",48,0) ; SDTYP(2) : Print appointments? 1 OR 0 "RTN","DVBAB82",49,0) ; SDTYP(1) : Print add/edits? 1 or 0 "RTN","DVBAB82",50,0) ; SDTYP(4) : Print enrollments? 1 or 0 "RTN","DVBAB82",51,0) ; SDTYP(3) : Print dispositions? 1 OR 0 "RTN","DVBAB82",52,0) ; SDTYP(7) : Print team information? 1 OR 0 "RTN","DVBAB82",53,0) ; SDTYP(5) : Print means test? 1 OR 0 "RTN","DVBAB82",54,0) ; "RTN","DVBAB82",55,0) N SDTYP,SDBD,SDED,SDACT,SDPRINT,SDYES,SDRANGE,SDBEG,SDEN "RTN","DVBAB82",56,0) S DFN=$P(PARM,"^",1),SDR=$P(PARM,"^",2),SDBD=$P(PARM,"^",3),SDED=$P(PARM,"^",4) "RTN","DVBAB82",57,0) S SDP=$P(PARM,"^",5),SDTYP(2)=$P(PARM,"^",6),SDTYP(1)=$P(PARM,"^",7) "RTN","DVBAB82",58,0) S SDTYP(4)=$P(PARM,"^",8),SDTYP(3)=$P(PARM,"^",9),SDTYP(7)=$P(PARM,"^",10),SDTYP(5)=$P(PARM,"^",11) "RTN","DVBAB82",59,0) D VAL Q:DVBERR "RTN","DVBAB82",60,0) S SDACT="",(SDYES,SDRANGE,SDPRINT)=0 "RTN","DVBAB82",61,0) I SDR="R" S SDRANGE=1 "RTN","DVBAB82",62,0) I SDP=1 S SDYES=1,SDPRINT=1 "RTN","DVBAB82",63,0) I 'SDRANGE S (SDBD,SDBEG)=2800101,(SDED,SDEND)=$$ENDDT(),SDHDR=1 "RTN","DVBAB82",64,0) D ENS^%ZISS "RTN","DVBAB82",65,0) N SDYN,DVB S SDPRINT=1,DVB(1)=SDBD_";"_SDED,DVB(4)=DFN,DVB("FLDS")=1 "RTN","DVBAB82",66,0) ;I $$SDAPI^SDAMA301(.DVB)>0 D "RTN","DVBAB82",67,0) I $O(^DPT(DFN,"S",SDBD)) D "RTN","DVBAB82",68,0) . I SDTYP(2)=1 S SDTYP(2)="" Q "RTN","DVBAB82",69,0) . K SDTYP(2) "RTN","DVBAB82",70,0) IF $$EXOE^SDOE(DFN,SDBD,SDED) D "RTN","DVBAB82",71,0) . I SDTYP(1)=1 S SDTYP(1)="" Q "RTN","DVBAB82",72,0) . K SDTYP(1) "RTN","DVBAB82",73,0) I $D(^DPT(DFN,"DE")) D "RTN","DVBAB82",74,0) . I SDTYP(4)=1 S SDTYP(4)="",SDACT=0 Q "RTN","DVBAB82",75,0) . K SDTYP(4) "RTN","DVBAB82",76,0) I $D(^DPT(DFN,"DIS")),$S('SDRANGE:1,+$O(^("DIS",9999999-(SDED+.9)))&($O(^(9999999-(SDED+.9)))<(9999999-(SDBD-.1))):1,1:0) D "RTN","DVBAB82",77,0) . I SDTYP(3)=1 S SDTYP(3)="" Q "RTN","DVBAB82",78,0) . K SDTYP(3) "RTN","DVBAB82",79,0) S SDYN=$$LST^DGMTU(DFN) I SDYN D "RTN","DVBAB82",80,0) . I SDTYP(5)=1 S SDTYP(5)="" Q "RTN","DVBAB82",81,0) . K SDTYP(5) "RTN","DVBAB82",82,0) I SDTYP(7)=1 D "RTN","DVBAB82",83,0) . S SDTYP(7)="",GBL="^TMP(""SDPP"","_$J_")" Q "RTN","DVBAB82",84,0) . K SDTYP(7) "RTN","DVBAB82",85,0) D PRINT^SDPPRT "RTN","DVBAB82",86,0) K ^TMP($J,"SDAMA301") S VALMBCK="R" "RTN","DVBAB82",87,0) Q "RTN","DVBAB82",88,0) ENDDT() ;Calculate end date for "all" date "RTN","DVBAB82",89,0) N X S X=$O(^DPT(DFN,"S",""),-1) S:X
0 S XDA=DFNIEN,DA=$P(^DVB(396.2,DFNIEN,0),U,1),ADMDT=$P(^DVB(396.2,DFNIEN,0),U,2),MB=$P(^(0),U,3) "RTN","DVBAB82",126,0) . . D REPRINT^DVBADSNT "RTN","DVBAB82",127,0) D DEQUE^DVBADSRP "RTN","DVBAB82",128,0) Q "RTN","DVBAB82",129,0) ; "RTN","DVBAB82",130,0) SPRPT ; Report # 8 - OP(Operation Report) "RTN","DVBAB82",131,0) ;Parameters "RTN","DVBAB82",132,0) ;============= "RTN","DVBAB82",133,0) ; DFN : Patient Identification Number "RTN","DVBAB82",134,0) ; SRTN : Select Operation "RTN","DVBAB82",135,0) ; "RTN","DVBAB82",136,0) N DFN,SRTN,MAGTMPR2,SRSITE "RTN","DVBAB82",137,0) I $O(^SRO(133,1))'="B" S SRSITE=1 "RTN","DVBAB82",138,0) S DFN=$P(PARM,"^",1),SRTN=$P(PARM,"^",2),MAGTMPR2=1 "RTN","DVBAB82",139,0) D VAL Q:DVBERR "RTN","DVBAB82",140,0) D ^SROPRPT "RTN","DVBAB82",141,0) Q "RTN","DVBAB82",142,0) ; "RTN","DVBAB82",143,0) CRPON ; Report # - 4 Reprint C&P Final Report "RTN","DVBAB82",144,0) ;Parameters "RTN","DVBAB82",145,0) ;============= "RTN","DVBAB82",146,0) ; RTYPE : Select Reprint Option (D)ate or (V)eteran "RTN","DVBAB82",147,0) ; RUNDATE : ORIGINAL PROCESSING date "RTN","DVBAB82",148,0) ; ANS : Reprinted by the RO or MAS "RTN","DVBAB82",149,0) ; % : LAB 1 OR 0 "RTN","DVBAB82",150,0) ; DA(1) : Patient IEN for lab results "RTN","DVBAB82",151,0) ; DFN : Patient Identification Number "RTN","DVBAB82",152,0) ; "RTN","DVBAB82",153,0) U IO "RTN","DVBAB82",154,0) N ONE "RTN","DVBAB82",155,0) S RTYPE=$P(PARM,"^",1),RUNDATE=$P(PARM,"^",2),ANS=$P(PARM,"^",3),%=$P(PARM,"^",4),DA(1)=$P(PARM,"^",5),DFN=$P(PARM,"^",6),DA=DA(1) "RTN","DVBAB82",156,0) I RTYPE="V" D VAL Q:DVBERR "RTN","DVBAB82",157,0) S XDD=^DD("DD"),$P(ULINE,"_",70)="_",ONE="N",Y=DT "RTN","DVBAB82",158,0) X XDD S HD="Reprint C & P Exams",SUPER=0 "RTN","DVBAB82",159,0) I $D(^XUSEC("DVBA C SUPERVISOR",DUZ)) S SUPER=1 "RTN","DVBAB82",160,0) S DVBCDT(0)=Y,PGHD="Compensation and Pension Exam Report",LOC=DUZ(2),PG=0,DVBCSITE=$S($D(^DVB(396.1,1,0)):$P(^(0),U,1),1:"Not specified") "RTN","DVBAB82",161,0) I "^D^V^"'[RTYPE S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Data Type" Q "RTN","DVBAB82",162,0) I ANS="R" K AUTO "RTN","DVBAB82",163,0) I ANS="M" S AUTO=1 "RTN","DVBAB82",164,0) I "^M^R^"'[ANS S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Data Type" Q "RTN","DVBAB82",165,0) I RTYPE="D" D GO^DVBCRPRT Q "RTN","DVBAB82",166,0) I RTYPE="V" D "RTN","DVBAB82",167,0) . S ONE="Y",RO=$P(^DVB(396.3,DA,0),U,3) "RTN","DVBAB82",168,0) . I RO'=DUZ(2)&('$D(AUTO))&(SUPER=0) W !!,*7,"Those results do not belong to your office.",!! Q "RTN","DVBAB82",169,0) . I RO=DUZ(2)&('$D(AUTO))&("RC"'[($P(^DVB(396.3,DA,0),U,18))) W *7,!!,"This request has not been released to the Regional Office yet.",!! Q "RTN","DVBAB82",170,0) . S PRTDATE=$P(^DVB(396.3,DA,0),U,16) I PRTDATE="" W *7,!!,"This has never been printed.",!! I SUPER=0 S OUT=1 Q "RTN","DVBAB82",171,0) . I %=1 D REN2^DVBCLABR Q "RTN","DVBAB82",172,0) . ;D OV^DVBCRPON "RTN","DVBAB82",173,0) . K DVBAON2 D SETLAB^DVBCPRNT,VARS^DVBCUTIL,STEP2^DVBCRPRT "RTN","DVBAB82",174,0) Q "RTN","DVBAB82",175,0) ; "RTN","DVBAB82",176,0) CIRPT ; Report # 5 - Insufficient Exam Report "RTN","DVBAB82",177,0) ;Parameters "RTN","DVBAB82",178,0) ;============= "RTN","DVBAB82",179,0) ; RPTTYPE : D/Detailed or S/Summary "RTN","DVBAB82",180,0) ; BEGDT : Beginning date $H/FileMan "RTN","DVBAB82",181,0) ; ENDDT : Ending date $H/FileMan "RTN","DVBAB82",182,0) ; RESANS : Insufficient Reason "RTN","DVBAB82",183,0) ; "RTN","DVBAB82",184,0) U IO "RTN","DVBAB82",185,0) S RPTTYPE=$P(PARM,"^",1),BEGDT=$P(PARM,"^",2),ENDDT=$P(PARM,"^",3),RESANS=$P(PARM,"^",4) "RTN","DVBAB82",186,0) I RPTTYPE="S" D SUM^DVBCIRPT Q "RTN","DVBAB82",187,0) I RPTTYPE="D" D "RTN","DVBAB82",188,0) . I RESANS="" S Y=-1 D INREAS "RTN","DVBAB82",189,0) . I '$D(DVBAARY("REASON")) S DVBAQTSL="" "RTN","DVBAB82",190,0) . S DVBCYQ="" "RTN","DVBAB82",191,0) . I RESANS'="" S Y=RESANS D INREAS "RTN","DVBAB82",192,0) . K DTOUT,DUOUT "RTN","DVBAB82",193,0) . S Y=-1 D EXMTPE,DETAIL^DVBCIRP1 "RTN","DVBAB82",194,0) Q "RTN","DVBAB82",195,0) ; "RTN","DVBAB82",196,0) EXMTPE ; "RTN","DVBAB82",197,0) N YSAVE,DVBAXIFN "RTN","DVBAB82",198,0) S YSAVE=Y "RTN","DVBAB82",199,0) F DVBAXIFN=0:0 S DVBAXIFN=$O(^DVB(396.6,DVBAXIFN)) Q:+DVBAXIFN=0 DO "RTN","DVBAB82",200,0) . S ^TMP($J,"XMTYPE",DVBAXIFN)="" "RTN","DVBAB82",201,0) S Y=-1 "RTN","DVBAB82",202,0) I +YSAVE>0 S ^TMP($J,"XMTYPE",+YSAVE)="" "RTN","DVBAB82",203,0) S Y=YSAVE "RTN","DVBAB82",204,0) Q "RTN","DVBAB82",205,0) INREAS ; "RTN","DVBAB82",206,0) N YSAVE,DVBXIFN "RTN","DVBAB82",207,0) S YSAVE=Y "RTN","DVBAB82",208,0) F DVBAXIFN=0:0 S DVBAXIFN=$O(^DVB(396.94,DVBAXIFN)) Q:+DVBAXIFN=0 DO "RTN","DVBAB82",209,0) . S DVBAARY("REASON",DVBAXIFN)="" "RTN","DVBAB82",210,0) S Y=-1 "RTN","DVBAB82",211,0) I +YSAVE>0 S DVBAARY("REASON",+YSAVE)="" "RTN","DVBAB82",212,0) S Y=YSAVE "RTN","DVBAB82",213,0) Q "RTN","DVBAB82",214,0) ; "RTN","DVBAB82",215,0) CRMS ; Report # 1 - Regional Office 21- day Certificate Printing Report. "RTN","DVBAB82",216,0) ; No Parameters "RTN","DVBAB82",217,0) ; "RTN","DVBAB82",218,0) U IO "RTN","DVBAB82",219,0) D ^DVBACRMS "RTN","DVBAB82",220,0) Q "RTN","DVBAB82",221,0) ; "RTN","DVBAB82",222,0) CRRR ; Report # 2 - Reprint a 21 - day Certificate for the RO "RTN","DVBAB82",223,0) ;Parameters "RTN","DVBAB82",224,0) ;============= "RTN","DVBAB82",225,0) ; DVBSEL : Select one of the following: "RTN","DVBAB82",226,0) ; N Patient Name "RTN","DVBAB82",227,0) ; D ORIGINAL PROCESSING DATE "RTN","DVBAB82",228,0) ; SDATE : ORIGINAL PROCESSING date - $H/FileMan "RTN","DVBAB82",229,0) ; XDA : Patient IEN "RTN","DVBAB82",230,0) ; "RTN","DVBAB82",231,0) U IO "RTN","DVBAB82",232,0) S DVBSEL=$P(PARM,"^",1),SDATE=$P(PARM,"^",2),XDA=$P(PARM,"^",3) "RTN","DVBAB82",233,0) I "^D^N^"'[DVBSEL S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Data Type" Q "RTN","DVBAB82",234,0) I DVBSEL="D" D I DVBERR Q "RTN","DVBAB82",235,0) . I SDATE="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Date" Q "RTN","DVBAB82",236,0) . S %DT="X" S X=SDATE D ^%DT I Y<0 D Q "RTN","DVBAB82",237,0) . . S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Date Format" "RTN","DVBAB82",238,0) I DVBSEL="N" D I DVBERR Q "RTN","DVBAB82",239,0) . I XDA="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Patient IEN" Q "RTN","DVBAB82",240,0) . S DIC=2,DIC(0)="NZX",X=XDA D ^DIC I Y<0 D I DVBERR Q "RTN","DVBAB82",241,0) . . S DVBERR=1,^TMP("DVBA",$J,1)="0^Invalid Patient Name." "RTN","DVBAB82",242,0) . S DFN=XDA "RTN","DVBAB82",243,0) D INIT^DVBACRRR I 'CONT Q "RTN","DVBAB82",244,0) D HDR^DVBACRRR,DATA^DVBACRRR "RTN","DVBAB82",245,0) Q "RTN","DVBAB82",246,0) ; "RTN","DVBAB82",247,0) CPRNT ; Report # 3 - Print C&P Final Report (manual) Report "RTN","DVBAB82",248,0) ; No Parameters "RTN","DVBAB82",249,0) ; "RTN","DVBAB82",250,0) S XDD=^DD("DD"),$P(ULINE,"_",70)="_",Y=DT "RTN","DVBAB82",251,0) X XDD S DVBCDT(0)=Y,PGHD="Compensation and Pension Exam Report",DVBCSITE=$S($D(^DVB(396.1,1,0)):$P(^(0),U,1),1:"Not Specified") "RTN","DVBAB82",252,0) D GO^DVBCPRNT "RTN","DVBAB82",253,0) Q "RTN","DVBAB82",254,0) VAL ; VALIDATE PATIENT "RTN","DVBAB82",255,0) I $G(DFN)="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Patient IEN" G END "RTN","DVBAB82",256,0) S DIC=2,DIC(0)="NZX",X=DFN D ^DIC "RTN","DVBAB82",257,0) I Y<0 S DVBERR=1,^TMP("DVBA",$J,1)="0^Invalid Patient Name." G END "RTN","DVBAB82",258,0) Q "RTN","DVBAB82",259,0) ; "RTN","DVBAB82",260,0) HFS() ; -- get hfs file name "RTN","DVBAB82",261,0) N H "RTN","DVBAB82",262,0) S H=$H "RTN","DVBAB82",263,0) Q "DVBA_"_$J_"_"_$P(H,",")_"_"_$P(H,",",2)_".DAT" "RTN","DVBAB82",264,0) ; "RTN","DVBAB82",265,0) HFSOPEN(HANDLE,DVBHFS,DVBMODE) ; Open File "RTN","DVBAB82",266,0) S DVBDIRY=$$GET^XPAR("DIV","DVB HFS SCRATCH") "RTN","DVBAB82",267,0) ;I DVBDIRY="" S ECERR=1 D Q "RTN","DVBAB82",268,0) ;. S ^TMP("DVBA",$J,1)="0^A scratch directory for reports doesn't exist" "RTN","DVBAB82",269,0) D OPEN^%ZISH(HANDLE,,DVBHFS,$G(DVBMODE,"W")) D:POP Q:POP "RTN","DVBAB82",270,0) .S DVBERR=1,^TMP("DVBA",$J,1)="0^Unable to open file " "RTN","DVBAB82",271,0) S IOF="$$IOF^DVBAB82" ;resets screen position and adds page break flag - added to deal with Linux environments. "RTN","DVBAB82",272,0) Q "RTN","DVBAB82",273,0) ; "RTN","DVBAB82",274,0) HFSCLOSE(HANDLE,DVBHFS) ;Close HFS and unload data "RTN","DVBAB82",275,0) N DVBDEL,X,%ZIS "RTN","DVBAB82",276,0) D CLOSE^%ZISH(HANDLE) "RTN","DVBAB82",277,0) S ROOT=$NA(^TMP("DVBA",$J,1)),DVBDEL(DVBHFS)="" "RTN","DVBAB82",278,0) K @ROOT "RTN","DVBAB82",279,0) S X=$$FTG^%ZISH(,DVBHFS,$NA(@ROOT@(1)),4) "RTN","DVBAB82",280,0) S X=$$DEL^%ZISH(,$NA(DVBDEL)) "RTN","DVBAB82",281,0) Q "RTN","DVBAB82",282,0) IOF() ;used to reset position and insert page break flag when @IOF is executed. "RTN","DVBAB82",283,0) S $X=0,$Y=0 "RTN","DVBAB82",284,0) Q "##FFFF##"_$C(13,10) "RTN","DVBCRPR1") 0^3^B11695100^B11399941 "RTN","DVBCRPR1",1,0) DVBCRPR1 ;ALBANY-ISC/GTS-REPRINT C&P REPORT CONTINUED ;4/28/93 "RTN","DVBCRPR1",2,0) ;;2.7;AMIE;**2,119,156**;Apr 10, 1995;Build 8 "RTN","DVBCRPR1",3,0) ; "RTN","DVBCRPR1",4,0) ; ** Entry points called only from DVBCRPRT ** "RTN","DVBCRPR1",5,0) ; ** All TAGS are entry points ** "RTN","DVBCRPR1",6,0) HDR S PG=PG+1 "RTN","DVBCRPR1",7,0) I +$G(DVBGUI)&(PG>1) Q "RTN","DVBCRPR1",8,0) I PG>1 D HDR3^DVBCUTL2 Q "RTN","DVBCRPR1",9,0) S:ZPR'="E" TOTTIME=$$PROCDAY^DVBCUTL2(DA(1)) "RTN","DVBCRPR1",10,0) S:ZPR="E" TOTTIME=$$INSFTME^DVBCUTA1(DA(1)) "RTN","DVBCRPR1",11,0) S OUTTIME="Processing time: "_TOTTIME "RTN","DVBCRPR1",12,0) I (IOST?1"C-".E)!($D(DVBAON2)) W @IOF "RTN","DVBCRPR1",13,0) S:('$D(DVBAON2)) DVBAON2="" "RTN","DVBCRPR1",14,0) W !,"Date: ",DVBCDT(0),?(80-$L(PGHD)\2),PGHD,?71,"Page: ",PG,!?(80-$L(DVBCSITE)\2),DVBCSITE,! "RTN","DVBCRPR1",15,0) W ?29,"** REPRINT OF FINAL **",! W ?(80-$L(OUTTIME)\2),OUTTIME,! "RTN","DVBCRPR1",16,0) W ?(80-$L(EXHD)\2),EXHD,! F LNE=1:1:80 W "=" "RTN","DVBCRPR1",17,0) K LNE S:EXHD["AGENT ORANGE" DVBCAO=1 I EXHD'["AGENT ORANGE" K DVBCAO "RTN","DVBCRPR1",18,0) D SSNOUT^DVBCUTIL "RTN","DVBCRPR1",19,0) W !!?2,"Name: ",PNAM,?56,"SSN: ",DVBCSSNO,!?51,"C-Number: ",CNUM,!?56,"DOB: " S Y=DOB X XDD W Y,!?2,"Address: ",ADR1,! W:ADR2]"" ?11,ADR2,! W:ADR3]"" ?11,ADR3,!! "RTN","DVBCRPR1",20,0) K DVBCSSNO "RTN","DVBCRPR1",21,0) W !?2,"City,State,Zip+4: ",?48,"Res Phone: ",HOMPHON,!?5,CITY," ",STATE," ",ZIP,?48,"Bus Phone: ",BUSPHON,! "RTN","DVBCRPR1",22,0) W !,"Entered active service: " S Y=EOD X XDD S:Y="" Y="Not specified" W Y,?40,"Last rating exam date: ",LREXMDT,! S Y=RAD X XDD S:Y="" Y="Not specified" W "Released active service: " W Y,!!,"Priority of exam: ",PRIO,! "RTN","DVBCRPR1",23,0) F LNE=1:1:80 W "=" "RTN","DVBCRPR1",24,0) W ! "RTN","DVBCRPR1",25,0) Q "RTN","DVBCRPR1",26,0) ; "RTN","DVBCRPR1",27,0) UP F XIX=$Y:1:(IOSL-8) W ! ;DVBA*156 add more lines for footer padding "RTN","DVBCRPR1",28,0) Q "RTN","DVBCRPR1",29,0) ; "RTN","DVBCRPR1",30,0) BOT I '$D(AUTO),$D(PRINT) D UP W ?7,"This exam has been reviewed and approved by the examining physician" W:$D(DVBCAO) !?27,"and signed by the veteran" W ".",!!,"VA Form 2507",! ;for RO "RTN","DVBCRPR1",31,0) I $D(AUTO),$D(PRINT) D UP W ?7,"Adequated by: ___________________________________ Date: _____________",!! "RTN","DVBCRPR1",32,0) I $D(AUTO),$D(PRINT) W "Physician signature: ___________________________________ Date: _____________",!!,"VA Form 2507",! "RTN","DVBCRPR1",33,0) Q "RTN","DVBCRPR1",34,0) ; "RTN","DVBCRPR1",35,0) HDA S:'$D(XPG) XPG=0 S XPG=XPG+1 "RTN","DVBCRPR1",36,0) I (IOST?1"C-".E)!($D(DVBAON2)) W @IOF "RTN","DVBCRPR1",37,0) S:('$D(DVBAON2)) DVBAON2="" "RTN","DVBCRPR1",38,0) W !,"Final C&P Reports for print date " S Y=DT X XDD W Y,!!,"Operator: ",$S($D(^VA(200,+DUZ,0)):$P(^(0),U,1),1:"Unknown operator"),!,"Location: ",$S($D(^DIC(4,+DUZ(2),0)):$P(^(0),U,1),1:"Unknown location"),! "RTN","DVBCRPR1",39,0) W !,"Veteran Name",?28,"SSN",?43,"C-Number",?55,"Request date",! "RTN","DVBCRPR1",40,0) F XXLN=1:1:79 W "-" "RTN","DVBCRPR1",41,0) W !! "RTN","DVBCRPR1",42,0) Q "VER") 8.0^22.0 "BLD",8378,6) ^140 **END** **END**