| [613] | 1 | DVBCEXML ;ALB/GTS-557/THM-PRINT EXAM CHECKLIST FOR RO ; 5/16/91  1:52 PM
 | 
|---|
 | 2 |  ;;2.7;AMIE; **12**;Apr 10, 1995
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  K ^TMP($J) D HOME^%ZIS
 | 
|---|
 | 5 |  W @IOF,!!,"Print Exam Checklist for the Regional Office",!!!
 | 
|---|
 | 6 | DEV S %ZIS="AEQ",%ZIS("A")="Output device: ",%ZIS("B")="0;P-OTHER" D ^%ZIS K %ZIS G:POP EXIT
 | 
|---|
 | 7 |  I IOM<132 D ^%ZISC U 0 W *7,!!,"A margin of 132 is required for this printout",!! H 2 G DEV
 | 
|---|
 | 8 |  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
 | 
|---|
 | 9 |  ;
 | 
|---|
 | 10 | GO ;
 | 
|---|
 | 11 |  U IO
 | 
|---|
 | 12 |  S PG=1
 | 
|---|
 | 13 |  S HD="VA Regional Office - "_$$SITE^DVBCUTL4 W !?(IOM-$L(HD)\2),HD
 | 
|---|
 | 14 |  S HD="Compensation and Pension Examination Request Worksheet"
 | 
|---|
 | 15 |  W !?(IOM-$L(HD)\2),HD
 | 
|---|
 | 16 |  D HDR
 | 
|---|
 | 17 |  D DRIVE
 | 
|---|
 | 18 |  W !!?13,"** Remarks:",!
 | 
|---|
 | 19 |  ;
 | 
|---|
 | 20 | EXIT D:$D(ZTQUEUED) KILL^%ZTLOAD
 | 
|---|
 | 21 |  K AA,NAME,ZTSK,H,DVBCX,A,OLDEXM,HD G KILL^DVBCUTIL
 | 
|---|
 | 22 |  Q
 | 
|---|
 | 23 |  ;
 | 
|---|
 | 24 | HDR W !!?15,"Veteran's Name: _________________________________________________",?90,"VAMC: __________________________"
 | 
|---|
 | 25 |  W !!?21,"C-Number: ____________________",?91,"SSN: __________________________"
 | 
|---|
 | 26 |  W !!?13,"Telephone-Day: _______________________  Night:_______________________    Power of Attorney: _________________"
 | 
|---|
 | 27 |  W !!?18,"Date Ordered: ____________________________",?92,"By: __________________________"
 | 
|---|
 | 28 |  W !!?14,"Priority of Exam:  _________________________         (    ) Insufficient Exam Dated: _______________________"
 | 
|---|
 | 29 |  W !?14,"                                                                                     (See Remarks)"
 | 
|---|
 | 30 |  W !!?14,"(    ) General Medical Examination                   (    ) Review of Pertinent Medical Records in"
 | 
|---|
 | 31 |  W !?14,"                                                            Claims Folder is Required Prior to Examination",!!
 | 
|---|
 | 32 |  Q
 | 
|---|
 | 33 | DRIVE ;
 | 
|---|
 | 34 |  S DIF="^TMP($J,""DVBAR"",",XCNP=0
 | 
|---|
 | 35 |  K ^TMP($J,"DVBAR")
 | 
|---|
 | 36 |  F ROU="DVBCEXM1" S X=ROU X ^%ZOSF("LOAD")
 | 
|---|
 | 37 |  K DIF,XCNP,ROU
 | 
|---|
 | 38 |  N LP,TEXT
 | 
|---|
 | 39 |  S LP=0,STOP=0
 | 
|---|
 | 40 |  F  S LP=$O(^TMP($J,"DVBAR",LP)) Q:(LP="")!(STOP)  D
 | 
|---|
 | 41 |  .S TEXT=^TMP($J,"DVBAR",LP,0)
 | 
|---|
 | 42 |  .I (TEXT'[";;")!(TEXT[";AMIE;") Q
 | 
|---|
 | 43 |  .I TEXT["TOF" D HD2
 | 
|---|
 | 44 |  .I TEXT["END" S STOP=1 Q
 | 
|---|
 | 45 |  .W:TEXT'["TOF" ?5,$P(TEXT,";;",2),! I $Y>55 D HD2
 | 
|---|
 | 46 |  K ^TMP($J,"DVBAR"),TEXT,STOP,LP,PG,DVBAX,X
 | 
|---|
 | 47 |  Q
 | 
|---|
 | 48 |  ;
 | 
|---|
 | 49 | HD2 S PG=PG+1 W @IOF,!?15,"Page: ",PG,!!?15,"Compensation and Pension Examination Request Worksheet, Cont.",!!!
 | 
|---|
 | 50 |  Q
 | 
|---|
 | 51 | SETIOF ;  ** Set device control var's
 | 
|---|
 | 52 |  D HOME^%ZIS
 | 
|---|
 | 53 |  Q
 | 
|---|