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 Apr 09, 2024@21:47:58 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 ;;
