DVBAB4 ;ALB/KLB - CAPRI Exam checklist for RO ;03/01/00
;;2.7;AMIE;**35**;Apr 10, 1995
STRT(MSG) ;
K ^TMP($J,"CAPRI")
S CNT=1
S ^TMP($J,"CAPRI",CNT,0)=";;Exam Checklist for the Regional Office",CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1
S ^TMP($J,"CAPRI",CNT,0)=";;VA Regional Office - "_$$SITE^DVBCUTL4,CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1
S ^TMP($J,"CAPRI",CNT,0)=";;Compensation and Pension Examination Request Worksheet",CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1
S ^TMP($J,"CAPRI",CNT,0)=";;Veteran's Name: _______________________________________ VAMC: ____________________",CNT=CNT+1
S ^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)=";;C-Number: _______________ SSN: _______________",CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1
S ^TMP($J,"CAPRI",CNT,0)=";;Telephone-Day: _______________ Night: _______________ Power of Attorney: _______________",CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1
S ^TMP($J,"CAPRI",CNT,0)=";;Date Ordered: _______________ By: _________________________",CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1
S ^TMP($J,"CAPRI",CNT,0)=";;Priority of Exam: _______________ ( ) Insufficient Exam Dated: _______________",CNT=CNT+1
S ^TMP($J,"CAPRI",CNT,0)=" ;;(See Remarks)",CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1
S ^TMP($J,"CAPRI",CNT,0)=";;( ) General Medical Examination ( ) Review of Pertinent Medical Records in",CNT=CNT+1
S ^TMP($J,"CAPRI",CNT,0)=";; Claims Folder is Required Prior to Examinations",CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1,^TMP($J,"CAPRI",CNT,0)="",CNT=CNT+1
S DIF="^TMP($J,""CAPRI"",",XCNP=CNT
F ROU="DVBCEXM1" S X=ROU X ^%ZOSF("LOAD")
;M MSG=^TMP($J,"CAPRI")
K DIF,XCNP,ROU
S A=0
F S A=$O(^TMP($J,"CAPRI",A)) Q:'A D
.S XXX=$G(^TMP($J,"CAPRI",A,0))
.I (XXX[";AMIE;")!(XXX["TOF")!(XXX["END") K ^TMP($J,"CAPRI",A,0)
.E S MSG(A)=$P(XXX,";;",2)
K ^TMP($J,"CAPRI")
K A,CNT,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB4 2135 printed Nov 22, 2024@16:50:36 Page 2
DVBAB4 ;ALB/KLB - CAPRI Exam checklist for RO ;03/01/00
+1 ;;2.7;AMIE;**35**;Apr 10, 1995
STRT(MSG) ;
+1 KILL ^TMP($JOB,"CAPRI")
+2 SET CNT=1
+3 SET ^TMP($JOB,"CAPRI",CNT,0)=";;Exam Checklist for the Regional Office"
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
+4 SET ^TMP($JOB,"CAPRI",CNT,0)=";;VA Regional Office - "_$$SITE^DVBCUTL4
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
+5 SET ^TMP($JOB,"CAPRI",CNT,0)=";;Compensation and Pension Examination Request Worksheet"
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
+6 SET ^TMP($JOB,"CAPRI",CNT,0)=";;Veteran's Name: _______________________________________ VAMC: ____________________"
SET CNT=CNT+1
+7 SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=";;C-Number: _______________ SSN: _______________"
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
+8 SET ^TMP($JOB,"CAPRI",CNT,0)=";;Telephone-Day: _______________ Night: _______________ Power of Attorney: _______________"
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
+9 SET ^TMP($JOB,"CAPRI",CNT,0)=";;Date Ordered: _______________ By: _________________________"
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
+10 SET ^TMP($JOB,"CAPRI",CNT,0)=";;Priority of Exam: _______________ ( ) Insufficient Exam Dated: _______________"
SET CNT=CNT+1
+11 SET ^TMP($JOB,"CAPRI",CNT,0)=" ;;(See Remarks)"
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
+12 SET ^TMP($JOB,"CAPRI",CNT,0)=";;( ) General Medical Examination ( ) Review of Pertinent Medical Records in"
SET CNT=CNT+1
+13 SET ^TMP($JOB,"CAPRI",CNT,0)=";; Claims Folder is Required Prior to Examinations"
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
SET ^TMP($JOB,"CAPRI",CNT,0)=""
SET CNT=CNT+1
+14 SET DIF="^TMP($J,""CAPRI"","
SET XCNP=CNT
+15 FOR ROU="DVBCEXM1"
SET X=ROU
XECUTE ^%ZOSF("LOAD")
+16 ;M MSG=^TMP($J,"CAPRI")
+17 KILL DIF,XCNP,ROU
+18 SET A=0
+19 FOR
SET A=$ORDER(^TMP($JOB,"CAPRI",A))
if 'A
QUIT
Begin DoDot:1
+20 SET XXX=$GET(^TMP($JOB,"CAPRI",A,0))
+21 IF (XXX[";AMIE;")!(XXX["TOF")!(XXX["END")
KILL ^TMP($JOB,"CAPRI",A,0)
+22 IF '$TEST
SET MSG(A)=$PIECE(XXX,";;",2)
End DoDot:1
+23 KILL ^TMP($JOB,"CAPRI")
+24 KILL A,CNT,X
+25 QUIT
