source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LREPIRS2.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 9.6 KB
Line 
1LREPIRS2 ;DALOI/CKA - EPI-PRINT LOCAL REPORT/SPREADSHEET ; 5/14/03
2 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
3 ; Reference to $$SITE^VASITE supported by IA #10112
4 ; Reference to X ^DD("DD") supported by IA #10017
5 W !?5,"Print Local Report/Spreadsheet Option"
6RORS ;REPORT OR SPREADSHEET
7 S DIR(0)="SO^1:REPORT;2:SPREADSHEET"
8 S DIR("A")="Which one do you wish to print"
9 D ^DIR
10 G:$D(DIRUT) EXIT
11 S LRREP=Y
12 K DIR,DIRUT
13CHOOSE ;CHOOSE RPT OR SPSHT TO PRINT
14 S LRLRDTX=1,LRY=1,LRNODE="LREPI"_$S(LRREP=1:"LOCALREP",1:"LOCALSPSHT"),LRNODE1=LRNODE
15 F S LRNODE=$O(^XTMP(LRNODE)) Q:LRNODE=""!(LRNODE'[LRNODE1) S LRLRDTX=$E(LRNODE,$S(LRREP=1:14,1:16),$S(LRREP=1:28,1:30)) D
16 .Q:LRLRDTX=""
17 .I '$D(^XTMP("LREPI"_$S(LRREP=1:"LOCALREP",1:"LOCALSPSHT")_LRLRDTX,"DONE")) Q
18 .S Y=LRLRDTX X ^DD("DD") S LRLRDT(LRLRDTX)=Y,LRLRDT(LRY)=LRLRDTX
19 .S LRTITLE=$G(^XTMP("LREPI"_$S(LRREP=1:"LOCALREP",1:"LOCALSPSHT")_LRLRDTX,"TITLE"))
20 .W !,LRY," ",LRLRDT(LRLRDTX)," ",LRTITLE
21 .S LRY=LRY+1
22 S LRY=LRY-1
23 I LRY=0,'$D(LRTITLE) W !,"No "_$S(LRREP=1:"report ",1:"spreadsheet ")_"is ready for printing." G RORS
24 S DIR(0)="NO^1:"_LRY
25 S DIR("A")="Choose the number for the "_$S(LRREP=1:"report",LRREP=2:"spreadsheet")_" you wish to print"
26 D ^DIR
27 G:$D(DIRUT) RORS
28 S LRY=Y,LRLRDT=LRLRDT(LRY)
29 K DIR,DIRUT
30 I LRREP=2 D D:'$D(LREND) PRIV D:'$D(LREND) READY D:'$D(LREND) SPSHT G EXIT
31 .W !!
32 .W !?5,"This option will print the selected fields."
33 .W !?5,"You will need to capture this printout in a text document."
34 .W !?5,"Using a text editor, remove any extraneous lines from the beginning"
35 .W !?5,"and the end of the file so that only the data to be imported remains."
36 .W !?5,"Save the edited file. Use this file in the import function of"
37 .W !?5,"your spreadsheet program."
38 I LRREP=1 D:'$D(LREND) PRIV D:'$D(LREND) REP G EXIT
39 W !!
40EXIT ;
41 D ^%ZISC
42 K D0,LRAUTO,LRBEG,LRDT,LREND,LRRNDT,LREPI,LRRPE,LRRPS,ZTSAVE
43 K ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT,POP,%ZIS
44 K LRLC,LRHDG,LRQUIT,LRHDGLC,LRPAGE,LRY,LRLRDT,LRDTHDG,LRLRDTX,LRNODE,LRNODE1,LRTITLE
45 K DIR,DTOUT,DUOUT,DIRUT,I,J,LRMSGLIN,LRREP,LRSPSHT,MSG,MSGLIN
46 Q
47 ;
48SPSHT ;
49 S %ZIS="Q" D ^%ZIS Q:POP I '$D(IO("Q")) U IO D PRTSP Q
50 S ZTRTN="PRTSP^LREPIRS2",ZTSAVE("LR*")="",ZTDESC="PRINT EPI LOCAL SPREADSHEET",ZTREQ="@" D ^%ZTLOAD
51 I $D(ZTSK)[0 W !!?5,"Report Cancelled."
52 E W !!?5,"The Task has been queued",!,"Task #",$G(ZTSK) H 5
53 D HOME^%ZIS G EXIT
54 Q
55PRTSP S MSG=0,LRSPSHT="",LRLC=0,LRPAGE=1,LRQUIT=0
56 F S MSG=$O(^XTMP("LREPILOCALSPSHT"_LRLRDT,MSG)) Q:'MSG S LRMSGLIN=^(MSG) D Q:LRQUIT
57 .W !,LRMSGLIN
58 .I $Y>(IOSL-6) D NPG
59 K MSGLIN,LRSEG
60 Q
61READY ;
62 K DIR S DIR(0)="Y",DIR("A")="Ready to Capture"
63 D ^DIR S:$D(DIRUT) LREND=1
64 S:'Y LREND=1
65 Q
66PRIV ;PRIVACY MESSAGE
67 W !!!,"This report will contain Confidential Information."
68 K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue/proceed"
69 S DIR("B")="NO"
70 D ^DIR S:$D(DIRUT) LREND=1
71 S:'Y LREND=1
72 Q
73REP ;
74 S %ZIS="Q" D ^%ZIS Q:POP I '$D(IO("Q")) U IO D PRT Q
75 S ZTRTN="PRT^LREPIRS2",ZTSAVE("LR*")="",ZTDESC="PRINT EPI LOCAL REPORT" D ^%ZTLOAD,HOME^%ZIS G EXIT
76 Q
77PRT ;Print report
78 S MSG=0,LRLC=0,LRPAGE=1,LRQUIT=0
79 W !,"***THIS REPORT CONTAINS CONFIDENTIAL INFORMATION.***"
80 D HDG
81 F S MSG=$O(^XTMP("LREPILOCALREP"_LRLRDT,MSG)) Q:'MSG S LRMSGLIN=^(MSG) D Q:LRQUIT
82 .W !,LRMSGLIN
83 .S LRLC=LRLC+1
84 .I $Y>(IOSL-6) D NPG
85 K MSGLIN,LRSEG
86 Q
87PAUSE ;
88 Q:$G(LREND)
89 K DIR S DIR(0)="E" D ^DIR
90 S:($D(DTOUT))!($D(DUOUT)) LRQUIT=1
91 Q
92NPG ;NEW PAGE
93 D:$E(IOST,1,2)="C-" PAUSE
94 Q:$G(LRQUIT)
95 W @IOF
96 D HDG
97 Q
98HDG ;
99 S LRHDGLC=""
100 F S LRHDGLC=$O(^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)) Q:LRHDGLC="" D
101 .S LRHDG=^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)
102 .W !,LRHDG
103 .I LRHDGLC=0 W " PAGE ",LRPAGE
104 .S LRLC=LRLC+1
105 S LRPAGE=LRPAGE+1
106 Q
107SAVHDG ;SAVE HEADING WHEN GENERATE REPORT
108 ;called from LREPIRS1
109 S Y=DT X ^DD("DD")
110 S SITE=$$SITE^VASITE
111 S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=" EMERGING PATHOGENS LOCAL REPORT "_Y
112 S LRHDGLC=LRHDGLC+1
113 S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=" FROM STATION "_$P(SITE,U,3)_" "_$P(SITE,U,2)
114 S LRHDGLC=LRHDGLC+1
115 S LRDTHDG=^TMP("HLS",$J,1)
116 S Y=$$CDT^LREPIRP2($P($P($P(LRDTHDG,HLFS,3),LRCS,2)," ",4))
117 S MSG=Y
118 S Y=$$CDT^LREPIRP2($P($P($P(LRDTHDG,HLFS,3),LRCS,2)," ",6))
119 S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=" PROCESSING PERIOD FROM "_MSG_" THROUGH "_Y
120 S LRHDGLC=LRHDGLC+1
121 S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)="Reported Local Pathogens:"
122 S LRI=0
123 F S LRI=$O(LREPI(LRI)) Q:LRI="" D
124 .S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=^(LRHDGLC)_$P(^LAB(69.5,LRI,0),U)_" " I $L(^(LRHDGLC))>60 D
125 ..S LRHDGLC=LRHDGLC+1
126 ..S:'($D(^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC))) ^(LRHDGLC)=$P(^LAB(69.5,LRI,0),U)_" "
127 ..E S ^(LRHDGLC)=^(LRHDGLC)_" "_$P(^LAB(69.5,LRI,0),U)
128 S LRHDGLC=LRHDGLC+1
129 S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=" ",LRHDGLC=LRHDGLC+1
130 S LRHDG=""
131 I $D(LRSEG("PID",1)) S LRHDG="Set Id"_$S(LRREP=1:" ",1:"|")
132 I $D(LRSEG("PID",2)) S LRHDG=LRHDG_"SSN"_$S(LRREP=1:" ",1:"|")
133 I $D(LRSEG("PID",3)) S LRHDG=LRHDG_"MPI"_$S(LRREP=1:$E(LRSP,1,13),1:"|")
134 I $D(LRSEG("PID",4)) S LRHDG=LRHDG_"Patient Name"_$S(LRREP=1:$E(LRSP,1,19),1:"|")
135 I $D(LRSEG("PID",5)) S LRHDG=LRHDG_"Birth Date"_$S(LRREP=1:" ",1:"|")
136 I $D(LRSEG("PID",6)) S LRHDG=LRHDG_"Sex"_$S(LRREP=1:" ",1:"|")
137 I $D(LRSEG("PID",7)) S LRHDG=LRHDG_"Race"_$S(LRREP=1:" ",1:"|")
138 I $D(LRSEG("PID",8)) S LRHDG=LRHDG_"Homeless"_$S(LRREP=1:" ",1:"|")
139 I $D(LRSEG("PID",9)) S LRHDG=LRHDG_"State"_$S(LRREP=1:$E(LRSP,1,11),1:"|")
140 I $D(LRSEG("PID",10)) S LRHDG=LRHDG_"Zip"_$S(LRREP=1:" ",1:"|")
141 I $D(LRSEG("PID",11)) S LRHDG=LRHDG_"County"_$S(LRREP=1:$E(LRSP,1,25),1:"|")
142 I $D(LRSEG("PID",12)) S LRHDG=LRHDG_"Ethnicity"_$S(LRREP=1:" ",1:"|")
143 I $D(LRSEG("PID",13)) S LRHDG=LRHDG_"POS"_$S(LRREP=1:" ",1:"|")
144 I LRHDG]"" S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=LRHDG S LRHDG="" S LRHDGLC=LRHDGLC+1
145 I $D(LRSEG("PV1",1)) S LRHDG=LRHDG_"Set Id"_$S(LRREP=1:" ",1:"|")
146 I $D(LRSEG("PV1",2)) S LRHDG=LRHDG_"Patient Class"_$S(LRREP=1:" ",1:"|")
147 I $D(LRSEG("PV1",3)) S LRHDG=LRHDG_"Hospital Location"_$S(LRREP=1:" ",1:"|")
148 I $D(LRSEG("PV1",4)) S LRHDG=LRHDG_"Discharge Disposition"_$S(LRREP=1:" ",1:"|")
149 I $D(LRSEG("PV1",5)) S LRHDG=LRHDG_"Facility"_$S(LRREP=1:" ",1:"|")
150 I $D(LRSEG("PV1",6)) S LRHDG=LRHDG_"Admit Date/Time"_$S(LRREP=1:" ",1:"|")
151 I $D(LRSEG("PV1",7)) S LRHDG=LRHDG_"Discharge Date/Time"_$S(LRREP=1:" ",1:"|")
152 I LRHDG]"" S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=LRHDG S LRHDG="" S LRHDGLC=LRHDGLC+1
153 I $D(LRSEG("DG1",1)) S LRHDG=LRHDG_"Set Id"_$S(LRREP=1:" ",1:"|")
154 I $D(LRSEG("DG1",2)) S LRHDG=LRHDG_"Diagnosis Code"_$S(LRREP=1:" ",1:"|")
155 I $D(LRSEG("DG1",3)) S LRHDG=LRHDG_"Diagnosis"_$S(LRREP=1:$E(LRSP,1,31),1:"|")
156 I $D(LRSEG("DG1",4)) S LRHDG=LRHDG_"Admission Date"_$S(LRREP=1:" ",1:"|")
157 I LRHDG]"" S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=LRHDG S LRHDG="" S LRHDGLC=LRHDGLC+1
158 I $D(LRSEG("NTE",1)) S LRHDG=LRHDG_"Set ID"_$S(LRREP=1:" ",1:"|")
159 I $D(LRSEG("NTE",2)) S LRHDG=LRHDG_"Comment"_$S(LRREP=1:" ",1:"|")
160 I LRHDG]"" S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=LRHDG S LRHDG="" S LRHDGLC=LRHDGLC+1
161 I $D(LRSEG("OBR",1)) S LRHDG=LRHDG_"Set ID"_$S(LRREP=1:" ",1:"|")
162 I $D(LRSEG("OBR",2)) S LRHDG=LRHDG_"Test Name"_$S(LRREP=1:$E(LRSP,1,12),1:"|")
163 I $D(LRSEG("OBR",3)) S LRHDG=LRHDG_"Accession Date"_$S(LRREP=1:" ",1:"|")
164 I $D(LRSEG("OBR",4)) S LRHDG=LRHDG_"Specimen"_$S(LRREP=1:$E(LRSP,1,13),1:"|")
165 I $D(LRSEG("OBR",5)) S LRHDG=LRHDG_"Accession Number"_$S(LRREP=1:" ",1:"|")
166 I LRHDG]"" S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=LRHDG_$S(LRREP=1:" ",1:"|")_"OBR SUBID" S LRHDG="" S LRHDGLC=LRHDGLC+1
167 I $D(LRSEG("OBX",1)) S LRHDG=LRHDG_"Set Id"_$S(LRREP=1:" ",1:"|")
168 I $D(LRSEG("OBX",2)) S LRHDG=LRHDG_"Value Type"_$S(LRREP=1:" ",1:"|")
169 I $D(LRSEG("OBX",3)) S LRHDG=LRHDG_"Test Name"_$S(LRREP=1:$E(LRSP,1,22),1:"|")
170 I $D(LRSEG("OBX",4)) S LRHDG=LRHDG_"LOINC Code"_$S(LRREP=1:" ",1:"|")
171 I $D(LRSEG("OBX",5)) S LRHDG=LRHDG_"LOINC Name"_$S(LRREP=1:" ",1:"|")
172 I $D(LRSEG("OBX",6)) S LRHDG=LRHDG_"Test Result"_$S(LRREP=1:" ",1:"|")
173 I $D(LRSEG("OBX",7)) S LRHDG=LRHDG_"Units"_$S(LRREP=1:" ",1:"|")
174 I $D(LRSEG("OBX",8)) S LRHDG=LRHDG_"Flags and Interp"_$S(LRREP=1:" ",1:"|")
175 I $D(LRSEG("OBX",9)) S LRHDG=LRHDG_"Verified Date/Time"_$S(LRREP=1:" ",1:"|")
176 I LRHDG]"" S ^XTMP("LREPILOCALREP"_LRLRDT,"HDG",LRHDGLC)=LRHDG_$S(LRREP=1:" ",1:"|")_"OBX SUBID" S LRHDG="" S LRHDGLC=LRHDGLC+1
177 Q
178DELETE ;Delete a report or spreadsheet
179 W !?5,"Delete a Local Report/Spreadsheet Option"
180DRORS ;REPORT OR SPREADSHEET
181 S DIR(0)="SO^1:REPORT;2:SPREADSHEET"
182 S DIR("A")="Which one do you wish to delete"
183 D ^DIR
184 G:$D(DIRUT) EXIT
185 S LRREP=Y
186 K DIR,DIRUT
187DCHOOSE ;CHOOSE WHICH REPORT/SPREADSHEET TO DELETE
188 S LRLRDTX=1,LRY=1,LRNODE="LREPI"_$S(LRREP=1:"LOCALREP",1:"LOCALSPSHT"),LRNODE1=LRNODE
189 F S LRNODE=$O(^XTMP(LRNODE)) Q:LRNODE=""!(LRNODE'[LRNODE1) S LRLRDTX=$E(LRNODE,$S(LRREP=1:14,1:16),$S(LRREP=1:28,1:30)) D
190 .Q:LRLRDTX=""
191 .I '$D(^XTMP("LREPI"_$S(LRREP=1:"LOCALREP",1:"LOCALSPSHT")_LRLRDTX,"DONE")) Q
192 .S Y=LRLRDTX X ^DD("DD") S LRLRDT(LRLRDTX)=Y,LRLRDT(LRY)=LRLRDTX
193 .S LRTITLE=$G(^XTMP("LREPI"_$S(LRREP=1:"LOCALREP",1:"LOCALSPSHT")_LRLRDTX,"TITLE"))
194 .W !,LRY," ",LRLRDT(LRLRDTX)," ",LRTITLE
195 .S LRY=LRY+1
196 S LRY=LRY-1
197 I LRY=0,'$D(LRTITLE) W !,"No "_$S(LRREP=1:"report ",1:"spreadsheet ")_"is ready for printing." G RORS
198 S DIR(0)="NO^1:"_LRY
199 S DIR("A")="Choose the number for the "_$S(LRREP=1:"report",LRREP=2:"spreadsheet")_" you wish to delete"
200 D ^DIR
201 G:$D(DIRUT) RORS
202 S LRY=Y,LRLRDT=LRLRDT(LRY)
203 K DIR,DIRUT
204 S LRY=Y
205 F I=1:1 Q:$P(LRY,",",I)="" S LRLRDT=LRLRDT($P(LRY,",",I)) D
206 .I LRREP=2 K ^XTMP("LREPILOCALSPSHT"_LRLRDT) W !,"Spreadsheet deleted."
207 .I LRREP=1 K ^XTMP("LREPILOCALREP"_LRLRDT) W !,"Report deleted."
208 G EXIT
Note: See TracBrowser for help on using the repository browser.