source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LREPIRP7.m@ 1535

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

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1LREPIRP7 ;DALOI/CKA - EPI-PRINT VERIFICATION REPORT ; 5/14/03
2 ;;5.2;LAB SERVICE;**281,320**;Sep 27, 1994
3 ; Reference to X ^DD("DD") supported by IA #10017
4 ;USED TO PRINT VERIFICATION REPORT
5 W !?5,"Print Detailed Verification Report Option",!!
6CHOOSE ;which date report to print
7 S LRNODE="LREPIREP",LRDATE=0,LRNUM=1
8 F S LRNODE=$O(^XTMP(LRNODE)) Q:LRNODE=""!(LRNODE'["LREPIREP") S LRDATE=$E(LRNODE,9,22) D
9 .S Y=LRDATE X ^DD("DD") S LRREP(LRNUM)=LRDATE_"^"_Y,LRNUM=LRNUM+1
10 F LRNUM=1:1 Q:'$D(LRREP(LRNUM)) W !,LRNUM_" "_$P(LRREP(LRNUM),"^",2),$E(^XTMP("LREPIREP"_$P(LRREP(LRNUM),"^"),"HDG",3),12,99)
11 S LRNUM=LRNUM-1
12 S DIR(0)="NO^1:"_LRNUM
13 S DIR("A")="Choose the number for the report you wish to print"
14 D ^DIR
15 G:$D(DIRUT) EXIT
16 S LRREP=Y
17 K DIR,DIRUT
18 G:$D(DIRUT) CHOOSE
19 S LRDATE=$P(LRREP(LRREP),"^")
20 I '$D(^XTMP("LREPIREP"_LRDATE,"DONE")) D Q
21 .W !!
22 .W !?5,"This report is not completed generating."
23 .W !?5,"Please try again later."
24 .S LREND=1
25PRIV ;PRIVACY MESSAGE
26 W !!!,"This report will contain Confidential Information."
27 K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue/proceed"
28 S DIR("B")="NO"
29 D ^DIR S:$D(DIRUT) LREND=1
30 G:'Y EXIT
31ALL K DIR,DIRUT
32 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Include All Pathogens"
33 S DIR("?")="Enter (Y)es or return for all entries to be Selected"
34 D ^DIR
35 S LRALL=+Y
36 K DIR
37 I +LRALL'>0 D
38 .W @IOF
39 .F Q:$D(DIRUT) D Q:X=""
40 ..S DIR(0)="PAO^69.5:EMZ",DIR("A")="Select Pathogens: "
41 ..S DIR("?")="Select the Pathogens. "
42 ..S DIR("S")="I Y<100"
43 ..D ^DIR
44 ..Q:$D(DIRUT)!(Y=-1)
45 ..S LREPI($P(^LAB(69.5,+Y,0),U,9))=+Y
46 ..K DIR,DTOUT,DUOUT,DIRUT
47 G:$D(DTOUT)!$D(DUOUT) Q
48 I '$D(LREPI)&('LRALL) W !,"Sorry No Pathogens Selected" G CHOOSE
49 D REP
50EXIT ;
51 D ^%ZISC
52 K DIC,D0,LRAUTO,LRBEG,LRDT,LREND,LRRNDT,LREPI,LRRPE,LRRPS,ZTSAVE
53 K ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT,POP,%ZIS
54 K LRCOUNT,LRLC,LRHDG,LRQUIT,LRHDGLC,LRPAGE,LRNODE
55 K DIR,DIRUT,DTOUT,DUOUT,J,LRMSGLIN,LRREP,LRSPSHT,MSG
56 K LRALL,LRCOUNT,LRDATE,LRDFN,LRDG1,LRDSPCNT,LRNUM,LROBR,LROBX,LRPAGE
57 K LRPATH,LRPID,LRSEG,LRTYPE,LRUPDNUM,LRZXECNT
58 K LRSBCNT,LRPV1,LRNOPAT,LRADMDT,LRDG1CNT,LRDISDT,LRDSP,LRDTHDG,LRHDGL2
59 K LRI,LRNAME,LRNTECNT,LRNUM1,LROBRCNT,LROBXCNT,LRPATHCT,LRPERCNT
60 K LRPV1CNT,LRPV1N,LRPV1ND,LRSUBCNT,LRTMP,LRTOT,LRTOTCNT,LRZXE,SITE,SSN
61 K ZTREQ
62 Q
63 ;
64REP ;
65Q S %ZIS="Q" D ^%ZIS Q:POP I '$D(IO("Q")) U IO D PRT Q
66 S ZTRTN="PRT^LREPIRP7",ZTSAVE("LR*")="",ZTDESC="PRINT EPI VERIFICATION REPORT",ZTREQ="@" D ^%ZTLOAD
67 I $D(ZTSK)[0 W !!?5,"Report Cancelled."
68 E W !!?5,"The Task has been queued",!,"Task #",$G(ZTSK) H 5
69 D HOME^%ZIS G EXIT
70 Q
71PRT ;Print report
72 I 'LRALL D PATH G EXIT
73 S LRPATH=0,LRDFN=0,LRPV1=0,LROBR=0,LROBX=0,LRPAGE=1,LRQUIT=0,LRNUM=0
74 S LRPATH=1 D PPRT1^LREPIRP8
75 I LRQUIT G EXIT
76 S LRDFN=0,LRPV1=0,LRDG1=0
77 S LRPATH=2 D PPRT3^LREPIRP8
78 I LRQUIT G EXIT
79 S LRDFN=0
80 F LRPATH=3,4,5,6 D PPRT1^LREPIRP8 Q:LRQUIT S LRDFN=0
81 I LRQUIT G EXIT
82 S LRDFN=0,LRPV1=0,LRDG1=0
83 S LRPATH=7 D PPRT2^LREPIRP8
84 I LRQUIT G EXIT
85 S LRDFN=0,LRNUM=0
86 S LRPATH=8 D PPRT1^LREPIRP8
87 I LRQUIT G EXIT
88 S LRDFN=0,LRPV1=0,LRDG1=0
89 S LRPATH=9 D PPRT2^LREPIRP8
90 I LRQUIT G EXIT
91 S LRDFN=0,LRNUM=0
92 S LRPATH=10 D PPRT1^LREPIRP8
93 I LRQUIT G EXIT
94 S LRDFN=0,LRPV1=0,LRDG1=0
95 F LRPATH=11,12,13,14 D PPRT4^LREPIRP8 Q:LRQUIT
96 I LRQUIT G EXIT
97 S LRDFN=0,LRPV1=0,LROBR=0,LROBX=0,LRDG1=0
98 F LRPATH=15,16,17 D PPRT3^LREPIRP8 Q:LRQUIT S LRDFN=0
99 I LRQUIT G EXIT
100 S LRDFN=0
101 F LRPATH=18,19,20,21,22,23 D PPRT1^LREPIRP8 Q:LRQUIT S LRDFN=0
102 I LRQUIT G EXIT
103 S LRDFN=0,LRPV1=0,LRDG1=0
104 W @IOF
105 W !,?70," PAGE ",LRPAGE
106 S LRHDGLC=0,LRLC=0
107 F S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,"UPDHDG",LRHDGLC)) Q:LRHDGLC="" W !,^(LRHDGLC)
108 S LRPAGE=LRPAGE+1
109 W !!,"Name LAST 4 Admission date Discharge date"
110 W !,"__________________________________________________________________"
111 S LRUPDNUM=0
112 F S LRUPDNUM=$O(^XTMP("LREPIREP"_LRDATE,"UPDATES",LRUPDNUM)) Q:LRUPDNUM="" W !,^(LRUPDNUM) I $Y>(IOSL+14) D NPG
113 W @IOF
114 W !,?70,"PAGE ",LRPAGE
115 S LRHDGLC=0,LRLC=0
116 F S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,"PHHDG",LRHDGLC)) Q:LRHDGLC="" W !,^(LRHDGLC)
117 S LRPAGE=LRPAGE+1
118 W !!
119 S LRTYPE="",LRZXECNT=0,LRCOUNT=0,LRSBCNT=0,LRDFN=0
120 F S LRTYPE=$O(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE)) Q:LRTYPE="" D D ZXETOT S LRSBCNT=0
121 .W !,LRTYPE
122 .F S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN)) Q:LRDFN="" D
123 ..F S LRZXECNT=$O(^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN,LRZXECNT)) Q:LRZXECNT="" D
124 ...W !,?5,^XTMP("LREPIREP"_LRDATE,"ZXE",LRTYPE,LRDFN,LRZXECNT)
125 ...S LRSBCNT=LRSBCNT+1
126 ...I $Y>(IOSL+1) D NPG
127 W !,"------------------------------------------------------------"
128 W !?5,"COUNT ",LRCOUNT
129 W @IOF
130 W !?70,"PAGE ",LRPAGE
131 S LRHDGLC=0,LRLC=LRLC+1,LRCOUNT=0,LRSUBCNT=0
132 F S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,"HEPCHDG",LRHDGLC)) Q:LRHDGLC="" W !,^(LRHDGLC)
133 S LRPAGE=LRPAGE+1
134 W !!
135 F LRNUM=1:1:7 W !! D
136 .I LRNUM=1 W !,"DECLINED ASSESSMENT FOR HEPATITIS C"
137 .I LRNUM=2 W !,"NO RISK FACTORS FOR HEPATITIS C"
138 .I LRNUM=3 W !,"PREVIOUSLY ASSESSED FOR HEPATITIS C"
139 .I LRNUM=4 W !,"RISK FACTORS FOR HEPATITIS C"
140 .I LRNUM=5 W !,"POSITIVE TEST FOR HEPATITIS C ANTIBODY"
141 .I LRNUM=6 W !,"NEGATIVE TEST FOR HEPATITIS C ANTIBODY"
142 .I LRNUM=7 W !,"HEPATITIS C DIAGNOSIS (ICD-9 BASED)"
143 .W !,"--------------------------------------"
144 .S LRTOT(LRNUM)=$G(^XTMP("LREPIREP"_LRDATE,"HEPTOT",LRNUM))
145 .I LRTOT(LRNUM)="" W !!,"NO PATIENTS REPORTED FOR THE REPORT PERIOD" Q
146 .S LRTYPE="",LRDSPCNT=0,LRCOUNT=0,LRSBCNT=0,LRDFN=0
147 .F S LRTYPE=$O(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE)) Q:LRTYPE="" D D:LRSBCNT>0 DSPTOT S LRSBCNT=0
148 ..F S LRDFN=$O(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN)) Q:LRDFN="" D
149 ...F S LRDSPCNT=$O(^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT)) Q:LRDSPCNT="" D
150 ....I LRNUM=1&(LRTYPE="DECLINED HEP C RISK ASSESSMENT") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) D:($Y>(IOSL+11)) NPG S LRSBCNT=LRSBCNT+1
151 ....I LRNUM=2&(LRTYPE="NO RISK FACTORS FOR HEP C") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) D:($Y>(IOSL+11)) NPG S LRSBCNT=LRSBCNT+1
152 ....I LRNUM=3&(LRTYPE="PREVIOUSLY ASSESSED HEP C RISK") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) D:($Y>(IOSL+11)) NPG S LRSBCNT=LRSBCNT+1
153 ....I LRNUM=4&(LRTYPE="RISK FACTOR FOR HEPATITIS C") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) D:($Y>(IOSL+11)) NPG S LRSBCNT=LRSBCNT+1
154 ....I LRNUM=5&(LRTYPE="HEP C VIRUS ANTIBODY POSITIVE") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) S LRSBCNT=LRSBCNT+1
155 ....I LRNUM=6&(LRTYPE="HEP C VIRUS ANTIBODY NEGATIVE") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) S LRSBCNT=LRSBCNT+1
156 ....I LRNUM=7&(LRTYPE="HEPATITIS C INFECTION") W !?5,^XTMP("LREPIREP"_LRDATE,"DSP",LRTYPE,LRDFN,LRDSPCNT) D:($Y>(IOSL+11)) NPG S LRSBCNT=LRSBCNT+1
157 W !,"-----------------------------------------------------------------"
158 W !?5,"COUNT ",LRCOUNT
159 K MSGLIN,LRSEG
160 Q
161PATH S LRPATH=0,LRDFN=0,LRPV1=0,LROBR=0,LROBX=0,LRPAGE=1,LRQUIT=0
162 F S LRPATH=$O(LREPI(LRPATH)) Q:'LRPATH D Q:LRQUIT S LRDFN=0
163 .I LRPATH=11!(LRPATH=12)!(LRPATH=13)!(LRPATH=14) D PPRT4^LREPIRP8 Q
164 .I LRPATH=7!(LRPATH=9) D PPRT2^LREPIRP8 Q
165 .I LRPATH=2!(LRPATH=15)!(LRPATH=16)!(LRPATH=17) D PPRT3^LREPIRP8 Q
166 .D PPRT1^LREPIRP8
167 G EXIT
168 Q
169ZXETOT ;PRINT PHARMACY SUBTOTALS
170 W !,"---------------------------------------------------------------"
171 W !,?5,"SUBCOUNT ",LRSBCNT
172 W !!
173 S LRCOUNT=LRCOUNT+LRSBCNT
174 Q
175DSPTOT W !,"---------------------------------------------------------------"
176 W !?5,"SUBCOUNT ",LRSBCNT
177 W !!
178 S LRCOUNT=LRCOUNT+LRSBCNT
179 Q
180PAUSE ;
181 Q:$G(LREND)
182 K DIR S DIR(0)="E" D ^DIR
183 S:($D(DTOUT))!($D(DUOUT)) LRQUIT=1
184 Q
185NPG ;NEW PAGE
186 D:$E(IOST,1,2)="C-" PAUSE
187 Q:$G(LRQUIT)
188 W @IOF
189 Q
190HDG ;
191 W @IOF
192 S LRLC=0
193 W !,?70," PAGE ",LRPAGE
194 F LRHDGLC=1:1:3 S LRHDG=$G(^XTMP("LREPIREP"_LRDATE,"HDG",LRHDGLC)) D
195 .W !,LRHDG
196 .S LRLC=LRLC+1
197 W ! S LRLC=LRLC+1
198 S LRHDGLC=0
199 F S LRHDGLC=$O(^XTMP("LREPIREP"_LRDATE,LRPATH,"HDG",LRHDGLC)) Q:LRHDGLC="" D
200 .S LRHDG=$G(^XTMP("LREPIREP"_LRDATE,LRPATH,"HDG",LRHDGLC))
201 .W !,LRHDG
202 .S LRLC=LRLC+1
203 S LRPAGE=LRPAGE+1
204 Q
Note: See TracBrowser for help on using the repository browser.