source: WorldVistAEHR/trunk/r/VISUAL_IMPAIRMENT_SERVICE_TEAM-ANRV/ANRVPR.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1ANRVPR ;AUG/JLTP - PRINT VIST PATIENT RECORD ; 8 Jan 91 / 9:20 AM
2 ;;4.0; Visual Impairment Service Team ;;12 Jun 98
3 S DIC="^ANRV(2040,",DIC(0)="AEMQ",DIC("A")="Select VIST PATIENT: "
4 D ^DIC K DIC G:Y<0 EXIT S DFN=+^ANRV(2040,+Y,0)
5 S %ZIS="QM",%ZIS("B")="" D ^%ZIS G:POP EXIT
6 I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^ANRVPR",ZTDESC="Print VIST Patient Record",ZTSAVE("DFN")="" D ^%ZTLOAD G EXIT
7DQ ;------ Non-interactive Entry Point ------
8 N %I,AGE,ANFTI,ANLF,ANLT,ANRF,ANRHI,ANRM,ANRV,ANRVC,ANRVH,ANRVJ,ANRVMR
9 N ANRVMRL,ANRVFN,ANRVI,ANRVPG,ANRVPS,ANTXT,ANWRD,D0,DA,DGA1,DGT,DGX,DIC
10 N DIRUT,DIQ,DR,I,PNM,SSN,VA,VAERR,X,X1,X2,FIELD,OFFSET,ANRVD
11 U IO D INIT^ANRVPR2,GETDATA^ANRVPR2
12 D PRINT G:$D(DIRUT) EXIT D FINISH^ANRVPR1
13EXIT ; close device
14 K DFN
15 D ^%ZISC
16 Q
17CNTR ;
18 W ?(IOM\2-($L(X)\2)),X Q
19HDR ;
20 W @IOF,! S ANRVPG=ANRVPG+1
21 F ANRHI=0:0 S ANRHI=$O(ANRVH(ANRHI)) Q:'ANRHI W ! S X=ANRVH(ANRHI) D CNTR
22 W !! Q
23FTR ; print footer
24 F ANFTI=$Y:1:(IOSL-4) W !
25 W !,PNM_" "_SSN S X="Page "_ANRVPG D CNTR W ! ;THIS ONE FOR OTHER SITES
26 Q
27PRINT ;
28 D HDR
29 S ANRVD=0 F ANRVI=1:1 D Q:FIELD=""
30 .S FIELD=$P($T(FIELD+ANRVI),";;",2) Q:FIELD=""
31 .S ANRVD=$O(ANRV(ANRVD)) Q:'ANRVD
32 .I $Y>(IOSL-6) D PAGE I $D(DIRUT) S ANRVI=99 Q
33 .W !,FIELD,?30,ANRV(ANRVD) W:ANRVI=5 !
34 Q:$D(DIRUT)
35 I $O(ANRV(16,0)) W !,"Dependent(s) Name(s): " D
36 .F I=0:0 S I=$O(ANRV(16,I)) Q:'I D
37 ..I $Y>(IOSL-6) D PAGE I $D(DIRUT) S I=999999 Q
38 ..W !?30,ANRV(16,I)
39 Q:$D(DIRUT)
40 W !!!,"VIST Eligibility:",?30,ANRV(17)
41 W !,"Rated Disability:"
42 F I=0:0 S I=$O(ANRV(17.1,I)) Q:'I D
43 .W:I>1 !
44 .W ?30,ANRV(17.1,I)
45 D:$Y>(IOSL-6) PAGE Q:$D(DIRUT) W !!,"Eye Diagnosis: "
46 F I=0:0 S I=$O(ANRV(17.5,I)) Q:'I W:I>1 ! W ?30,ANRV(17.5,I)
47 S X1="Eye Exam Date (Last):^^Visual Acuity Right Eye:^Visual Acuity Left Eye:^Visual Field Right Eye:^Visual Field Left Eye:"
48 S X2=ANRV(18) D MULT Q:$D(DIRUT)
49 W ! S X1="VIST Review Date (Last):^Status of Review:^Type of Review:^Eligibility on Review Date:"
50 S X2=ANRV(19) D MULT Q:$D(DIRUT)
51 I $D(DIRUT) Q
52 W !,"Field Visit Date (Last):",?30,ANRV(20)
53 D PAGE Q:$D(DIRUT) W !! S X="VIS TEAM ASSESSMENT" D CNTR
54 F OFFSET=1:1 S ANRF=$P($T(ANRF+OFFSET),";;",2) Q:ANRF="" D Q:$D(DIRUT)
55 .D WP^ANRVPR1
56 Q:$D(DIRUT)
57 I $Y>(IOSL-6) D PAGE Q:$D(DIRUT)
58 W !! S X="PLAN" D CNTR S ANRF=12 D WP^ANRVPR1
59 Q
60MULT ;------ Print all fields from a single ^DIZ node ------
61 F ANRM=1:1:$L(X1,U) D
62 .I $Y>(IOSL-6) D PAGE I $D(DIRUT) S ANRM=$L(X1,U)+1 Q
63 .W:$P(X1,U,ANRM)]"" !,$P(X1,U,ANRM),?30,$P(X2,U,ANRM)
64 Q
65PAGE ;------ Go to a new page ------
66 K DIRUT
67 D FTR
68 I $E(IOST)="C" R !,"Type ^ to exit or press RETURN...",X:DTIME S:'$T X="^"
69 I X=U S DIRUT=1 Q
70 D HDR Q
71FIELD ;;
72 ;;Name:
73 ;;Address:
74 ;;City,State,Zip:
75 ;;County:
76 ;;Phone:
77 ;;Social Security Number:
78 ;;VA Claim Number:
79 ;;Location of Claim File:
80 ;;Service Dates:
81 ;;Branch of Service (Last):
82 ;;Date of Birth:
83 ;;Place of Birth:
84 ;;Age:
85 ;;Employment Status:
86 ;;Marital Status:
87 ;;Living Arrangement:
88 ;;Number of Dependents:
89 ;;Name of Spouse:
90 ;;
91ANRF ;;
92 ;;4^General Health:
93 ;;16^Financial/Benefits:
94 ;;17^Patient History:
95 ;;18^Activities:
96 ;;19^Adjustment to Blindness:
97 ;;20^Impressions:
98 ;;
Note: See TracBrowser for help on using the repository browser.