- ANRVPR ;AUG/JLTP - PRINT VIST PATIENT RECORD ; 8 Jan 91 / 9:20 AM
- ;;4.0; Visual Impairment Service Team ;;12 Jun 98
- S DIC="^ANRV(2040,",DIC(0)="AEMQ",DIC("A")="Select VIST PATIENT: "
- D ^DIC K DIC G:Y<0 EXIT S DFN=+^ANRV(2040,+Y,0)
- S %ZIS="QM",%ZIS("B")="" D ^%ZIS G:POP EXIT
- I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^ANRVPR",ZTDESC="Print VIST Patient Record",ZTSAVE("DFN")="" D ^%ZTLOAD G EXIT
- DQ ;------ Non-interactive Entry Point ------
- N %I,AGE,ANFTI,ANLF,ANLT,ANRF,ANRHI,ANRM,ANRV,ANRVC,ANRVH,ANRVJ,ANRVMR
- N ANRVMRL,ANRVFN,ANRVI,ANRVPG,ANRVPS,ANTXT,ANWRD,D0,DA,DGA1,DGT,DGX,DIC
- N DIRUT,DIQ,DR,I,PNM,SSN,VA,VAERR,X,X1,X2,FIELD,OFFSET,ANRVD
- U IO D INIT^ANRVPR2,GETDATA^ANRVPR2
- D PRINT G:$D(DIRUT) EXIT D FINISH^ANRVPR1
- EXIT ; close device
- K DFN
- D ^%ZISC
- Q
- CNTR ;
- W ?(IOM\2-($L(X)\2)),X Q
- HDR ;
- W @IOF,! S ANRVPG=ANRVPG+1
- F ANRHI=0:0 S ANRHI=$O(ANRVH(ANRHI)) Q:'ANRHI W ! S X=ANRVH(ANRHI) D CNTR
- W !! Q
- FTR ; print footer
- F ANFTI=$Y:1:(IOSL-4) W !
- W !,PNM_" "_SSN S X="Page "_ANRVPG D CNTR W ! ;THIS ONE FOR OTHER SITES
- Q
- PRINT ;
- D HDR
- S ANRVD=0 F ANRVI=1:1 D Q:FIELD=""
- .S FIELD=$P($T(FIELD+ANRVI),";;",2) Q:FIELD=""
- .S ANRVD=$O(ANRV(ANRVD)) Q:'ANRVD
- .I $Y>(IOSL-6) D PAGE I $D(DIRUT) S ANRVI=99 Q
- .W !,FIELD,?30,ANRV(ANRVD) W:ANRVI=5 !
- Q:$D(DIRUT)
- I $O(ANRV(16,0)) W !,"Dependent(s) Name(s): " D
- .F I=0:0 S I=$O(ANRV(16,I)) Q:'I D
- ..I $Y>(IOSL-6) D PAGE I $D(DIRUT) S I=999999 Q
- ..W !?30,ANRV(16,I)
- Q:$D(DIRUT)
- W !!!,"VIST Eligibility:",?30,ANRV(17)
- W !,"Rated Disability:"
- F I=0:0 S I=$O(ANRV(17.1,I)) Q:'I D
- .W:I>1 !
- .W ?30,ANRV(17.1,I)
- D:$Y>(IOSL-6) PAGE Q:$D(DIRUT) W !!,"Eye Diagnosis: "
- F I=0:0 S I=$O(ANRV(17.5,I)) Q:'I W:I>1 ! W ?30,ANRV(17.5,I)
- S X1="Eye Exam Date (Last):^^Visual Acuity Right Eye:^Visual Acuity Left Eye:^Visual Field Right Eye:^Visual Field Left Eye:"
- S X2=ANRV(18) D MULT Q:$D(DIRUT)
- W ! S X1="VIST Review Date (Last):^Status of Review:^Type of Review:^Eligibility on Review Date:"
- S X2=ANRV(19) D MULT Q:$D(DIRUT)
- I $D(DIRUT) Q
- W !,"Field Visit Date (Last):",?30,ANRV(20)
- D PAGE Q:$D(DIRUT) W !! S X="VIS TEAM ASSESSMENT" D CNTR
- F OFFSET=1:1 S ANRF=$P($T(ANRF+OFFSET),";;",2) Q:ANRF="" D Q:$D(DIRUT)
- .D WP^ANRVPR1
- Q:$D(DIRUT)
- I $Y>(IOSL-6) D PAGE Q:$D(DIRUT)
- W !! S X="PLAN" D CNTR S ANRF=12 D WP^ANRVPR1
- Q
- MULT ;------ Print all fields from a single ^DIZ node ------
- F ANRM=1:1:$L(X1,U) D
- .I $Y>(IOSL-6) D PAGE I $D(DIRUT) S ANRM=$L(X1,U)+1 Q
- .W:$P(X1,U,ANRM)]"" !,$P(X1,U,ANRM),?30,$P(X2,U,ANRM)
- Q
- PAGE ;------ Go to a new page ------
- K DIRUT
- D FTR
- I $E(IOST)="C" R !,"Type ^ to exit or press RETURN...",X:DTIME S:'$T X="^"
- I X=U S DIRUT=1 Q
- D HDR Q
- FIELD ;;
- ;;Name:
- ;;Address:
- ;;City,State,Zip:
- ;;County:
- ;;Phone:
- ;;Social Security Number:
- ;;VA Claim Number:
- ;;Location of Claim File:
- ;;Service Dates:
- ;;Branch of Service (Last):
- ;;Date of Birth:
- ;;Place of Birth:
- ;;Age:
- ;;Employment Status:
- ;;Marital Status:
- ;;Living Arrangement:
- ;;Number of Dependents:
- ;;Name of Spouse:
- ;;
- ANRF ;;
- ;;4^General Health:
- ;;16^Financial/Benefits:
- ;;17^Patient History:
- ;;18^Activities:
- ;;19^Adjustment to Blindness:
- ;;20^Impressions:
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HANRVPR 3248 printed Mar 13, 2025@21:50:48 Page 2
- ANRVPR ;AUG/JLTP - PRINT VIST PATIENT RECORD ; 8 Jan 91 / 9:20 AM
- +1 ;;4.0; Visual Impairment Service Team ;;12 Jun 98
- +2 SET DIC="^ANRV(2040,"
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select VIST PATIENT: "
- +3 DO ^DIC
- KILL DIC
- if Y<0
- GOTO EXIT
- SET DFN=+^ANRV(2040,+Y,0)
- +4 SET %ZIS="QM"
- SET %ZIS("B")=""
- DO ^%ZIS
- if POP
- GOTO EXIT
- +5 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="DQ^ANRVPR"
- SET ZTDESC="Print VIST Patient Record"
- SET ZTSAVE("DFN")=""
- DO ^%ZTLOAD
- GOTO EXIT
- DQ ;------ Non-interactive Entry Point ------
- +1 NEW %I,AGE,ANFTI,ANLF,ANLT,ANRF,ANRHI,ANRM,ANRV,ANRVC,ANRVH,ANRVJ,ANRVMR
- +2 NEW ANRVMRL,ANRVFN,ANRVI,ANRVPG,ANRVPS,ANTXT,ANWRD,D0,DA,DGA1,DGT,DGX,DIC
- +3 NEW DIRUT,DIQ,DR,I,PNM,SSN,VA,VAERR,X,X1,X2,FIELD,OFFSET,ANRVD
- +4 USE IO
- DO INIT^ANRVPR2
- DO GETDATA^ANRVPR2
- +5 DO PRINT
- if $DATA(DIRUT)
- GOTO EXIT
- DO FINISH^ANRVPR1
- EXIT ; close device
- +1 KILL DFN
- +2 DO ^%ZISC
- +3 QUIT
- CNTR ;
- +1 WRITE ?(IOM\2-($LENGTH(X)\2)),X
- QUIT
- HDR ;
- +1 WRITE @IOF,!
- SET ANRVPG=ANRVPG+1
- +2 FOR ANRHI=0:0
- SET ANRHI=$ORDER(ANRVH(ANRHI))
- if 'ANRHI
- QUIT
- WRITE !
- SET X=ANRVH(ANRHI)
- DO CNTR
- +3 WRITE !!
- QUIT
- FTR ; print footer
- +1 FOR ANFTI=$Y:1:(IOSL-4)
- WRITE !
- +2 ;THIS ONE FOR OTHER SITES
- WRITE !,PNM_" "_SSN
- SET X="Page "_ANRVPG
- DO CNTR
- WRITE !
- +3 QUIT
- PRINT ;
- +1 DO HDR
- +2 SET ANRVD=0
- FOR ANRVI=1:1
- Begin DoDot:1
- +3 SET FIELD=$PIECE($TEXT(FIELD+ANRVI),";;",2)
- if FIELD=""
- QUIT
- +4 SET ANRVD=$ORDER(ANRV(ANRVD))
- if 'ANRVD
- QUIT
- +5 IF $Y>(IOSL-6)
- DO PAGE
- IF $DATA(DIRUT)
- SET ANRVI=99
- QUIT
- +6 WRITE !,FIELD,?30,ANRV(ANRVD)
- if ANRVI=5
- WRITE !
- End DoDot:1
- if FIELD=""
- QUIT
- +7 if $DATA(DIRUT)
- QUIT
- +8 IF $ORDER(ANRV(16,0))
- WRITE !,"Dependent(s) Name(s): "
- Begin DoDot:1
- +9 FOR I=0:0
- SET I=$ORDER(ANRV(16,I))
- if 'I
- QUIT
- Begin DoDot:2
- +10 IF $Y>(IOSL-6)
- DO PAGE
- IF $DATA(DIRUT)
- SET I=999999
- QUIT
- +11 WRITE !?30,ANRV(16,I)
- End DoDot:2
- End DoDot:1
- +12 if $DATA(DIRUT)
- QUIT
- +13 WRITE !!!,"VIST Eligibility:",?30,ANRV(17)
- +14 WRITE !,"Rated Disability:"
- +15 FOR I=0:0
- SET I=$ORDER(ANRV(17.1,I))
- if 'I
- QUIT
- Begin DoDot:1
- +16 if I>1
- WRITE !
- +17 WRITE ?30,ANRV(17.1,I)
- End DoDot:1
- +18 if $Y>(IOSL-6)
- DO PAGE
- if $DATA(DIRUT)
- QUIT
- WRITE !!,"Eye Diagnosis: "
- +19 FOR I=0:0
- SET I=$ORDER(ANRV(17.5,I))
- if 'I
- QUIT
- if I>1
- WRITE !
- WRITE ?30,ANRV(17.5,I)
- +20 SET X1="Eye Exam Date (Last):^^Visual Acuity Right Eye:^Visual Acuity Left Eye:^Visual Field Right Eye:^Visual Field Left Eye:"
- +21 SET X2=ANRV(18)
- DO MULT
- if $DATA(DIRUT)
- QUIT
- +22 WRITE !
- SET X1="VIST Review Date (Last):^Status of Review:^Type of Review:^Eligibility on Review Date:"
- +23 SET X2=ANRV(19)
- DO MULT
- if $DATA(DIRUT)
- QUIT
- +24 IF $DATA(DIRUT)
- QUIT
- +25 WRITE !,"Field Visit Date (Last):",?30,ANRV(20)
- +26 DO PAGE
- if $DATA(DIRUT)
- QUIT
- WRITE !!
- SET X="VIS TEAM ASSESSMENT"
- DO CNTR
- +27 FOR OFFSET=1:1
- SET ANRF=$PIECE($TEXT(ANRF+OFFSET),";;",2)
- if ANRF=""
- QUIT
- Begin DoDot:1
- +28 DO WP^ANRVPR1
- End DoDot:1
- if $DATA(DIRUT)
- QUIT
- +29 if $DATA(DIRUT)
- QUIT
- +30 IF $Y>(IOSL-6)
- DO PAGE
- if $DATA(DIRUT)
- QUIT
- +31 WRITE !!
- SET X="PLAN"
- DO CNTR
- SET ANRF=12
- DO WP^ANRVPR1
- +32 QUIT
- MULT ;------ Print all fields from a single ^DIZ node ------
- +1 FOR ANRM=1:1:$LENGTH(X1,U)
- Begin DoDot:1
- +2 IF $Y>(IOSL-6)
- DO PAGE
- IF $DATA(DIRUT)
- SET ANRM=$LENGTH(X1,U)+1
- QUIT
- +3 if $PIECE(X1,U,ANRM)]""
- WRITE !,$PIECE(X1,U,ANRM),?30,$PIECE(X2,U,ANRM)
- End DoDot:1
- +4 QUIT
- PAGE ;------ Go to a new page ------
- +1 KILL DIRUT
- +2 DO FTR
- +3 IF $EXTRACT(IOST)="C"
- READ !,"Type ^ to exit or press RETURN...",X:DTIME
- if '$TEST
- SET X="^"
- +4 IF X=U
- SET DIRUT=1
- QUIT
- +5 DO HDR
- QUIT
- FIELD ;;
- +1 ;;Name:
- +2 ;;Address:
- +3 ;;City,State,Zip:
- +4 ;;County:
- +5 ;;Phone:
- +6 ;;Social Security Number:
- +7 ;;VA Claim Number:
- +8 ;;Location of Claim File:
- +9 ;;Service Dates:
- +10 ;;Branch of Service (Last):
- +11 ;;Date of Birth:
- +12 ;;Place of Birth:
- +13 ;;Age:
- +14 ;;Employment Status:
- +15 ;;Marital Status:
- +16 ;;Living Arrangement:
- +17 ;;Number of Dependents:
- +18 ;;Name of Spouse:
- +19 ;;
- ANRF ;;
- +1 ;;4^General Health:
- +2 ;;16^Financial/Benefits:
- +3 ;;17^Patient History:
- +4 ;;18^Activities:
- +5 ;;19^Adjustment to Blindness:
- +6 ;;20^Impressions:
- +7 ;;
