DVBCEXML ;ALB/GTS-557/THM-PRINT EXAM CHECKLIST FOR RO ; 5/16/91 1:52 PM
;;2.7;AMIE; **12**;Apr 10, 1995
;
K ^TMP($J) D HOME^%ZIS
W @IOF,!!,"Print Exam Checklist for the Regional Office",!!!
DEV S %ZIS="AEQ",%ZIS("A")="Output device: ",%ZIS("B")="0;P-OTHER" D ^%ZIS K %ZIS G:POP EXIT
I IOM<132 D ^%ZISC U 0 W *7,!!,"A margin of 132 is required for this printout",!! H 2 G DEV
I $D(IO("Q")) S ZTRTN="GO^DVBCEXML",ZTIO=ION,ZTDESC="Print Exam check list",ZTSAVE="" D ^%ZTLOAD W !!,"Request queued",!! H 2 G EXIT
;
GO ;
U IO
S PG=1
S HD="VA Regional Office - "_$$SITE^DVBCUTL4 W !?(IOM-$L(HD)\2),HD
S HD="Compensation and Pension Examination Request Worksheet"
W !?(IOM-$L(HD)\2),HD
D HDR
D DRIVE
W !!?13,"** Remarks:",!
;
EXIT D:$D(ZTQUEUED) KILL^%ZTLOAD
K AA,NAME,ZTSK,H,DVBCX,A,OLDEXM,HD G KILL^DVBCUTIL
Q
;
HDR W !!?15,"Veteran's Name: _________________________________________________",?90,"VAMC: __________________________"
W !!?21,"C-Number: ____________________",?91,"SSN: __________________________"
W !!?13,"Telephone-Day: _______________________ Night:_______________________ Power of Attorney: _________________"
W !!?18,"Date Ordered: ____________________________",?92,"By: __________________________"
W !!?14,"Priority of Exam: _________________________ ( ) Insufficient Exam Dated: _______________________"
W !?14," (See Remarks)"
W !!?14,"( ) General Medical Examination ( ) Review of Pertinent Medical Records in"
W !?14," Claims Folder is Required Prior to Examination",!!
Q
DRIVE ;
S DIF="^TMP($J,""DVBAR"",",XCNP=0
K ^TMP($J,"DVBAR")
F ROU="DVBCEXM1" S X=ROU X ^%ZOSF("LOAD")
K DIF,XCNP,ROU
N LP,TEXT
S LP=0,STOP=0
F S LP=$O(^TMP($J,"DVBAR",LP)) Q:(LP="")!(STOP) D
.S TEXT=^TMP($J,"DVBAR",LP,0)
.I (TEXT'[";;")!(TEXT[";AMIE;") Q
.I TEXT["TOF" D HD2
.I TEXT["END" S STOP=1 Q
.W:TEXT'["TOF" ?5,$P(TEXT,";;",2),! I $Y>55 D HD2
K ^TMP($J,"DVBAR"),TEXT,STOP,LP,PG,DVBAX,X
Q
;
HD2 S PG=PG+1 W @IOF,!?15,"Page: ",PG,!!?15,"Compensation and Pension Examination Request Worksheet, Cont.",!!!
Q
SETIOF ; ** Set device control var's
D HOME^%ZIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCEXML 2336 printed Nov 22, 2024@16:54:18 Page 2
DVBCEXML ;ALB/GTS-557/THM-PRINT EXAM CHECKLIST FOR RO ; 5/16/91 1:52 PM
+1 ;;2.7;AMIE; **12**;Apr 10, 1995
+2 ;
+3 KILL ^TMP($JOB)
DO HOME^%ZIS
+4 WRITE @IOF,!!,"Print Exam Checklist for the Regional Office",!!!
DEV SET %ZIS="AEQ"
SET %ZIS("A")="Output device: "
SET %ZIS("B")="0;P-OTHER"
DO ^%ZIS
KILL %ZIS
if POP
GOTO EXIT
+1 IF IOM<132
DO ^%ZISC
USE 0
WRITE *7,!!,"A margin of 132 is required for this printout",!!
HANG 2
GOTO DEV
+2 IF $DATA(IO("Q"))
SET ZTRTN="GO^DVBCEXML"
SET ZTIO=ION
SET ZTDESC="Print Exam check list"
SET ZTSAVE=""
DO ^%ZTLOAD
WRITE !!,"Request queued",!!
HANG 2
GOTO EXIT
+3 ;
GO ;
+1 USE IO
+2 SET PG=1
+3 SET HD="VA Regional Office - "_$$SITE^DVBCUTL4
WRITE !?(IOM-$LENGTH(HD)\2),HD
+4 SET HD="Compensation and Pension Examination Request Worksheet"
+5 WRITE !?(IOM-$LENGTH(HD)\2),HD
+6 DO HDR
+7 DO DRIVE
+8 WRITE !!?13,"** Remarks:",!
+9 ;
EXIT if $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+1 KILL AA,NAME,ZTSK,H,DVBCX,A,OLDEXM,HD
GOTO KILL^DVBCUTIL
+2 QUIT
+3 ;
HDR WRITE !!?15,"Veteran's Name: _________________________________________________",?90,"VAMC: __________________________"
+1 WRITE !!?21,"C-Number: ____________________",?91,"SSN: __________________________"
+2 WRITE !!?13,"Telephone-Day: _______________________ Night:_______________________ Power of Attorney: _________________"
+3 WRITE !!?18,"Date Ordered: ____________________________",?92,"By: __________________________"
+4 WRITE !!?14,"Priority of Exam: _________________________ ( ) Insufficient Exam Dated: _______________________"
+5 WRITE !?14," (See Remarks)"
+6 WRITE !!?14,"( ) General Medical Examination ( ) Review of Pertinent Medical Records in"
+7 WRITE !?14," Claims Folder is Required Prior to Examination",!!
+8 QUIT
DRIVE ;
+1 SET DIF="^TMP($J,""DVBAR"","
SET XCNP=0
+2 KILL ^TMP($JOB,"DVBAR")
+3 FOR ROU="DVBCEXM1"
SET X=ROU
XECUTE ^%ZOSF("LOAD")
+4 KILL DIF,XCNP,ROU
+5 NEW LP,TEXT
+6 SET LP=0
SET STOP=0
+7 FOR
SET LP=$ORDER(^TMP($JOB,"DVBAR",LP))
if (LP="")!(STOP)
QUIT
Begin DoDot:1
+8 SET TEXT=^TMP($JOB,"DVBAR",LP,0)
+9 IF (TEXT'[";;")!(TEXT[";AMIE;")
QUIT
+10 IF TEXT["TOF"
DO HD2
+11 IF TEXT["END"
SET STOP=1
QUIT
+12 if TEXT'["TOF"
WRITE ?5,$PIECE(TEXT,";;",2),!
IF $Y>55
DO HD2
End DoDot:1
+13 KILL ^TMP($JOB,"DVBAR"),TEXT,STOP,LP,PG,DVBAX,X
+14 QUIT
+15 ;
HD2 SET PG=PG+1
WRITE @IOF,!?15,"Page: ",PG,!!?15,"Compensation and Pension Examination Request Worksheet, Cont.",!!!
+1 QUIT
SETIOF ; ** Set device control var's
+1 DO HOME^%ZIS
+2 QUIT
