source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LREPIRS.m@ 792

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

initial load of FOIAVistA 6/30/08 version

File size: 5.3 KB
Line 
1LREPIRS ;DALOI/CKA - EPI-LOCAL REPORT/SPREADSHEET ; 5/14/03
2 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994
3 ; Reference to ^ORD(101 supported by IA #872
4 ;USED TO PRINT REPORT OR SPREADSHEET
5 D NOW^%DTC
6 S LRLRDT=% ;Set LRLRDT- local report date time=now
7 S LRRTYPE=1,LRPROT=0
8 S LRPROT=$O(^ORD(101,"B","LREPI",LRPROT))
9 W @IOF,?(IOM/2-15),"Laboratory Generate Local Report/Spreadsheet option"
10CRI K LRCYCLE,LREPI S LRMSG="Pathogens" D ALL G:$D(DIRUT) EXIT
11 K DIR,DIRUT,DTOUT,DUOUT,DIROUT
12 I +LRALL D PICKALL G DATE
13 S LRMSG="Local Pathogens" D ALL G:$D(DIRUT) CRI
14 K DIR,DIRUT,DTOUT,DUOUT,DIROUT
15 I +LRALL D LOCALL G DATE
16 I +LRALL'>0 D
17 .W @IOF
18 .F Q:$D(DIRUT) D
19 ..S DIR(0)="PAO^69.5:EMZ",DIR("A")="Select Pathogens: "
20 ..S DIR("S")="D CHKL^LREPIRM I LROK I $P(^(0),U,7)=LRPROT"
21 ..D ^DIR
22 ..Q:$D(DIRUT)
23 ..S LREPI(+Y)=""
24 G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) CRI
25 I '$D(LREPI) W !,"Sorry No Pathogens Selected" G EXIT
26DATE ;Select Search Date
27 K DIR,DIRUT
28 S DIR("A")="Select Start Date: "
29 S DIR(0)="DOA^:"_DT D ^DIR
30 G:$D(DIRUT) CRI
31 S LRRPS=Y
32 K DIR,DIRUT
33 S DIR("A")="Select End Date: "
34 S DIR(0)="DOA^:"_DT D ^DIR
35 G:$D(DIRUT) DATE
36 S LRRPE=Y
37RORS ;REPORT OR SPREADSHEET
38 K DIR,DIRUT
39 S DIR(0)="SO^1:REPORT;2:SPREADSHEET"
40 D ^DIR
41 G:$D(DIRUT) DATE
42 S LRREP=Y
43 W !!
44 I LRREP=1,$D(^XTMP("LREPILOCALREP"_LRLRDT)) D G EXIT
45 .W !,"Data already exists for this date and time. Please try again later."
46 I LRREP=2,$D(^XTMP("LREPILOCALSPSHT"_LRLRDT)) D G EXIT
47 .W !,"Data already exists for this date and time. Please try again later."
48 D SEG G:$D(DIRUT) RORS
49TITLE K DIR,DIRUT
50 S DIR(0)="F^3:30",DIR("A")="DOCUMENT TITLE"
51 D ^DIR
52 G:$D(DIRUT) RORS
53 S ^XTMP("LREPI"_$S(LRREP=1:"LOCALREP",1:"LOCALSPSHT")_LRLRDT,"TITLE")=Y
54 D TASK,HOME^%ZIS
55EXIT ;
56 K D0,J,LRALL,LRAUTO,LRBEG,LRCYCLE,LRDT,LREND,LREPI,LRMSG,LROK,LROVR
57 K LRDUZ,LRRNDT,LRRPE,LRREP,LRRPS,LRRTYPE,LRY,ZTSAVE
58 K ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT
59 K LRLC,LRHDG,LRPROT,LRLRDT
60 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LRSEG
61 K ^TMP($J)
62 Q
63 ;
64TASK ;LETS TASK THIS JOB
65 Q:'$D(LREPI)
66 W !!
67 S LRDUZ=DUZ
68 K ZTSAVE
69 S ZTSAVE("LRRTYPE")="" S:LRRTYPE=0 ZTDTH=DT
70 S ZTSAVE("LR*")=""
71 S ZTIO="",ZTRTN="EN^LREPI",ZTDESC="Laboratory EPI local spreadsheet/report-generate"
72 D ^%ZTLOAD
73 I '$D(ZTQUEUED)&($D(ZTSK)) W @IOF,!!,"The Task has been queued",!,"Task # ",$G(ZTSK) H 5
74 Q
75PICKALL ;SELECT ALL ASSOCIATED PARAMETERS
76 S Y=0 F S Y=$O(^LAB(69.5,Y)) Q:+Y'>0 D CHK S:LROK LREPI(Y)=""
77 Q
78LOCALL ;SELECT ALL LOCAL PATHOGENS
79 S Y=99 F S Y=$O(^LAB(69.5,Y)) Q:Y'>0 D CHK S:LROK LREPI(Y)=""
80 Q
81CHK ;CHECK TO SEE IF ITS OK
82 S:'$D(LRCYCLE) LRCYCLE=$P(^LAB(69.5,Y,0),U,5)
83 S LROK=1
84 S:($P(^LAB(69.5,Y,0),U,2)="1") LROK=0 Q
85 S:$P(^LAB(69.5,Y,0),U,7)="" LROK=0 Q
86 S:'$D(^ORD(101,$P(^LAB(69.5,Y,0),U,7),0)) LROK=0 Q
87 S:$P(^LAB(69.5,Y,0),U,5)=LRCYCLE LROK=0 Q
88 Q
89ALL K DIR,DIRUT
90 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Include All "_LRMSG
91 S DIR("?")="Enter (Y)es or return to individually select pathogens."
92 D ^DIR
93 S LRALL=+Y
94 Q
95SEG ;CHOOSE SEGMENTS FOR SPREADSHEET
96 W !,"Choose the segments to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")
97 W !,"1-PID"
98 W !,"2-PV1"
99 W !,"3-DG1"
100 W !,"4-NTE"
101 W !,"5-OBR"
102 W !,"6-OBX"
103 K DIR,DIRUT
104 S DIR(0)="L^1:6"
105 D ^DIR
106 Q:$D(DIRUT)
107 S LRY=Y
108 I LRY[1 S LRSEG("PID")=1 D
109 .W !!
110 .W !,"Choose the fields from the PID segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")
111 .W !,"1-Set Id"
112 .W !,"2-SSN"
113 .W !,"3-MPI"
114 .W !,"4-Patient Name"
115 .W !,"5-Date of Birth"
116 .W !,"6-Sex"
117 .W !,"7-Race"
118 .W !,"8-Homeless"
119 .W !,"9-State"
120 .W !,"10-Zip Code"
121 .W !,"11-County"
122 .W !,"12-Ethnicity"
123 .W !,"13-Period of Service"
124 .K DIR,DIRUT
125 .S DIR(0)="L^1:13"
126 .D ^DIR
127 .Q:$D(DIRUT)
128 .F I=1:1:13 I Y[I S LRSEG("PID",I)=""
129 I LRY[2 S LRSEG("PV1")=1 D
130 .W !,"Choose the fields from the PV1 segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")
131 .W !,"1-Set Id"
132 .W !,"2-Patient Class"
133 .W !,"3-Hospital Location"
134 .W !,"4-Discharge Disposition"
135 .W !,"5-Facility"
136 .W !,"6-Admit Date/Time"
137 .W !,"7-Discharge Date/Time"
138 .K DIR,DIRUT
139 .S DIR(0)="L^1:7"
140 .D ^DIR
141 .Q:$D(DIRUT)
142 .F I=1:1:7 I Y[I S LRSEG("PV1",I)=""
143 I LRY[3 S LRSEG("DG1")=1 D
144 .W !,"Choose the fields from the DG1 segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")
145 .W !,"1-Set Id"
146 .W !,"2-Diagnosis Code"
147 .W !,"3-Diagnosis"
148 .W !,"4-Admission Date"
149 .K DIR,DIRUT
150 .S DIR(0)="L^1:4"
151 .D ^DIR
152 .Q:$D(DIRUT)
153 .F I=1:1:4 I Y[I S LRSEG("DG1",I)=""
154 I LRY[4 S LRSEG("NTE")=1 D
155 .W !,"Choose the fields from the NTE segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")
156 .W !,"1-Set Id"
157 .W !,"2-Comment"
158 .K DIR,DIRUT
159 .S DIR(0)="L^1:2"
160 .D ^DIR
161 .Q:$D(DIRUT)
162 .F I=1:1:2 I Y[I S LRSEG("NTE",I)=""
163 I LRY[5 S LRSEG("OBR")=1 D
164 .W !,"Choose the fields from the OBR segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")
165 .W !,"1-Set Id"
166 .W !,"2-Test Name"
167 .W !,"3-Accession Date"
168 .W !,"4-Specimen"
169 .W !,"5-Accession Number"
170 .K DIR,DIRUT
171 .S DIR(0)="L^1:5"
172 .D ^DIR
173 .Q:$D(DIRUT)
174 .F I=1:1:5 I Y[I S LRSEG("OBR",I)=""
175 I LRY[6 S LRSEG("OBX")=1 D
176 .W !,"Choose the fields from the OBX segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")
177 .W !,"1-Set Id"
178 .W !,"2-Value Type"
179 .W !,"3-Test Name"
180 .W !,"4-LOINC Code"
181 .W !,"5-LOINC Name"
182 .W !,"6-Test Result"
183 .W !,"7-Units"
184 .W !,"8-Abnormal Flags"
185 .W !,"9-Verified Date/Time"
186 .K DIR,DIRUT
187 .S DIR(0)="L^1:9"
188 .D ^DIR
189 .Q:$D(DIRUT)
190 .F I=1:1:10 I Y[I S LRSEG("OBX",I)=""
191 Q
Note: See TracBrowser for help on using the repository browser.