source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRWRKINC.m@ 724

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

initial load of WorldVistAEHR
File size: 8.3 KB
Line 
1LRWRKINC ;SLC/DCM/CJS-INCOMPLETE STATUS REPORT ;2/19/91 11:47
2 ;;5.2;LAB SERVICE;**153,201,221**;Sep 27, 1994
3EN ;
4 K ^TMP($J),^TMP("LR",$J),^TMP("LRWRKINC",$J)
5 K %ZIS,DIC
6 S Y=$$NOW^XLFDT D DD^LRX S LRDT=Y
7 S (LRCNT,LRCUTOFF,LREND,LREXD,LREXTST,LRNOCNTL,LREXNREQ)=0,LRSORTBY=1
8 S DIC="^LRO(68,",DIC(0)="AEMOQZ"
9 F D Q:$G(LRAA)<1!(LREND)
10 . N LAST,LRAD,LRAN,LRFAN,LRLAN,LRWDTL,LRSTAR,LRUSEAA,X,Y
11 . D ^DIC
12 . I $D(DUOUT) S LREND=1 Q
13 . S LRAA=+Y,LRAA(0)=$G(Y(0))
14 . I LRAA<1 Q
15 . D CHKAA^LRWRKIN1
16 . I LREND Q
17 . I '$L(LRUSEAA) D PHD Q:LREND
18 . S LRCNT=LRCNT+1,^TMP("LRWRKINC",$J,$P(LRAA(0),"^")_"^"_LRAA,LRCNT,0)=LRAA(0)
19 . I $L(LRUSEAA) D
20 . . N X
21 . . S X=$P($G(^LRO(68,LRUSEAA,0)),"^")_"^"_LRUSEAA
22 . . S ^TMP("LRWRKINC",$J,$P(LRAA(0),"^")_"^"_LRAA,LRCNT,1)=^TMP("LRWRKINC",$J,$P(LRUSEAA,"^",1,2),$P(LRUSEAA,"^",3),1)
23 . E S ^TMP("LRWRKINC",$J,$P(LRAA(0),"^")_"^"_LRAA,LRCNT,1)=$G(LRAD)_"^"_$G(LRFAN)_"^"_$G(LRLAN)_"^"_$G(LRSTAR)_"^"_$G(LAST)_"^"_$G(LRWDTL)
24 . W !
25 I LREND!('$D(^TMP("LRWRKINC",$J))) D LREND^LRWRKIN1 Q
26 K DIC
27 N DIR,DIRUT,DTOUT,DUOUT
28 I LRCNT>1 D
29 . S DIR(0)="SO^1:ACCESSION AREA;2:TEST NAME",DIR("A")="Sort Report By",DIR("B")=1
30 . S DIR("?",1)="ACCESSION AREA will separate tests by accession area, then by test name."
31 . S DIR("?")="TEST NAME will list tests alphabetically without regard to accession area."
32 . D ^DIR
33 . I $D(DIRUT) S LREND=1 Q
34 . S LRSORTBY=+Y
35 I LREND D LREND^LRWRKIN1 Q
36 S DIR(0)="YO",DIR("A")="Specify detailed sort criteria",DIR("B")="NO"
37 S DIR("?",1)="Answer 'YES' if you WANT to specify detailed criteria."
38 S DIR("?",2)="Examples are excluding controls, specifying a lab arrival cut-off time,"
39 S DIR("?",3)="selecting or excluding specific tests, or excluding non-required tests."
40 S DIR("?")="Answer 'NO' if you DO NOT want to specify detailed criteria."
41 D ^DIR
42 I $D(DIRUT) D LREND^LRWRKIN1 Q
43 I Y=1 D
44 . K DIR
45 . S DIR(0)="DO^::EXT",DIR("A")="Lab Arrival Cut-off"
46 . S DIR("?",1)="Entering a date/time will exclude uncollected specimens and"
47 . S DIR("?")="specimens with a lab arrival time after the time specified."
48 . D ^DIR
49 . I $D(DUOUT)!($D(DTOUT)) Q
50 . I Y>0 S LRCUTOFF=+Y
51 . K DIR
52 . S DIR(0)="YO",DIR("A")="Do you want to exclude controls",DIR("B")="YES"
53 . S DIR("?",1)="Answer 'NO' if you WANT accessions for LAB CONTROLS included on"
54 . S DIR("?")="the report. 'YES' if you DO NOT want accessions for LAB CONTROLS."
55 . D ^DIR
56 . I $D(DIRUT) Q
57 . S LRNOCNTL=+Y
58 . K DIR
59 . S DIR(0)="YO",DIR("A")="Do you want a specific test",DIR("B")="NO"
60 . D ^DIR
61 . I $D(DIRUT) Q
62 . I Y=1 D
63 . . N I,LRY
64 . . K DIR
65 . . S DIR(0)="YO",DIR("A")="Check tests on panels also",DIR("B")="YES"
66 . . S DIR("?",1)="If you select a panel test do you want to also check"
67 . . S DIR("?")="the tests that make up the panel for an incomplete status."
68 . . D ^DIR
69 . . I $D(DIRUT) Q
70 . . S LRY=+Y
71 . . N DIC
72 . . S DIC="^LAB(60,",DIC(0)="AEFOQZ"
73 . . F D Q:+Y<1
74 . . . N LRTEST,LRTSTS
75 . . . D ^DIC Q:+Y<1
76 . . . S ^TMP("LR",$J,"T",+Y)=Y(0)
77 . . . I LRY S LRTEST=+Y,LREXPD="D LREXPD^LRWRKINC" D ^LREXPD
78 . I $D(DIRUT) Q
79 . K DIR
80 . S DIR(0)="YO"
81 . S DIR("A")="Do you want to exclude a specific test",DIR("B")="NO"
82 . D ^DIR
83 . I $D(DIRUT) Q
84 . I Y=1 D
85 . . N DIC
86 . . S DIC="^LAB(60,",DIC(0)="AEFOQ",DIC("S")="I '$D(^TMP(""LR"",$J,""T"",Y))"
87 . . F D ^DIC Q:+Y<1 S LREXTST(+Y)="",LREXTST=1
88 . K DIR
89 . S DIR(0)="YO",DIR("A")="Exclude non-required tests",DIR("B")="YES"
90 . S DIR("?",1)="Answer 'NO' if you WANT incomplete non-required test included on"
91 . S DIR("?")="the report. 'YES' if you DO NOT want non-required tests."
92 . D ^DIR
93 . I $D(DIRUT) Q
94 . S LREXNREQ=+Y
95 I $D(DIRUT) D LREND^LRWRKIN1 Q
96 S DIR(0)="YO",DIR("A")="Do you want an extended display",DIR("B")="NO"
97 S DIR("?")="Extended display will show UID and other referral information"
98 D ^DIR
99 I $D(DIRUT) D LREND^LRWRKIN1 Q
100 S LREXD=+Y
101 S %ZIS="Q" D ^%ZIS
102 I POP D LREND^LRWRKIN1 Q
103 I $D(IO("Q")) D Q
104 . S ZTRTN="DQ^LRWRKINC",ZTDESC="Lab incomplete test list",ZTSAVE("LR*")=""
105 . S ZTSAVE("^TMP(""LRWRKINC"",$J,")=""
106 . I $D(^TMP("LR",$J,"T")) S ZTSAVE("^TMP(""LR"",$J,""T"",")=""
107 . D ^%ZTLOAD,^%ZISC
108 . W !,"Request ",$S($G(ZTSK):"Queued - Task #"_ZTSK,1:"NOT Queued")
109 . D LREND^LRWRKIN1
110 ;
111DQ ;
112 U IO
113 S (LRAA,LRINDEX,LRPAGE)=0,(LRX,LRY)=""
114 F S LRX=$O(^TMP("LRWRKINC",$J,LRX)) Q:LRX="" D
115 . N LRZ
116 . S LRZ=0
117 . F S LRZ=$O(^TMP("LRWRKINC",$J,LRX,LRZ)) Q:'LRZ D
118 . . N LRFAN,LRLAN,LRSTAR,LRLAST,LRY
119 . . F I=0,1 S LRZ(I)=$G(^TMP("LRWRKINC",$J,LRX,LRZ,I))
120 . . S LRFAN=$P(LRZ(1),"^",2),LRLAN=$P(LRZ(1),"^",3),LRSTAR=$P(LRZ(1),"^",4),LRLAST=$P(LRZ(1),"^",5)
121 . . I LRSTAR,LRLAST S LRY="From Date: "_$$FMTE^XLFDT(LRSTAR,"5DZ")_" To: "_$$FMTE^XLFDT(LRLAST,"5DZ")
122 . . E S LRY=" For Date: "_$$FMTE^XLFDT(LRLAST,"5DZ")_" From: "_LRFAN_" To: "_LRLAN
123 . . S LRINDEX=LRINDEX+1,LRNAME(LRINDEX)=$$LJ^XLFSTR($E($P(LRZ(0),"^"),1,20),22)_LRY
124 S LRINDEX=LRINDEX+1,LRNAME(LRINDEX)=$S(LRINDEX>1:"Sorted by "_$S(LRSORTBY=1:"Accession Area",1:"Test Name")_"; ",1:"")_"Controls Excluded: "_$S(LRNOCNTL:"YES",1:"NO")_"; Specific Tests: "_$S($D(^TMP("LR",$J,"T")):"YES",1:"NO")
125 S LRINDEX=LRINDEX+1,LRNAME(LRINDEX)="Exclude Specific Tests: "_$S(LREXTST:"YES",1:"NO")_"; Required Tests Only: "_$S(LREXNREQ:"YES",1:"NO")
126 I LRCUTOFF S LRINDEX=LRINDEX+1,LRNAME(LRINDEX)="For Tests Received Before: "_$$FMTE^XLFDT(LRCUTOFF,"5MZ")
127 D HED^LRWRKIN1 D URG^LRX
128 S LRX=""
129 F S LRX=$O(^TMP("LRWRKINC",$J,LRX)) Q:LRX="" D
130 . S LRZ=0
131 . F S LRZ=$O(^TMP("LRWRKINC",$J,LRX,LRZ)) Q:'LRZ D
132 . . I LRSORTBY=1 S LRAA("NAME")=$P(LRX,"^")
133 . . S X=^TMP("LRWRKINC",$J,LRX,LRZ,1)
134 . . S LRAA=$P(LRX,"^",2),LRAD=$P(X,"^"),LRFAN=$P(X,"^",2),LRLAN=$P(X,"^",3),LRSTAR=$P(X,"^",4),LAST=$P(X,"^",5),LRWDTL=$P(X,"^",6)
135 . . N LRX,LRZ
136 . . F S LRAD=$O(^LRO(68,LRAA,1,LRAD)) Q:LRAD<1!(LRAD>LAST) D
137 . . . I $G(LRSTAR) D AC Q
138 . . . S LRAN=LRFAN-1
139 . . . F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:'LRAN!(LRAN>LRLAN) D
140 . . . . S LREND=0
141 . . . . D TD Q:LREND
142 . . . . I 'LRVERVER D LST1^LRWRKIN1,TESTS
143 D X^LRWRKIN1
144 I LREND D LREND^LRWRKIN1 Q
145 D EQUALS^LRX D WAIT^LRWRKIN1:$E(IOST,1,2)="C-"
146 D LREND^LRWRKIN1
147 Q
148 ;
149TD ;
150 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LREND=1 Q
151 I LRNOCNTL,$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",2)=62.3 S LREND=1 Q
152 S LRVERVER=1,I=0
153 F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<.5 I $D(^(I,0)) S LRVERVER=(LRVERVER&$P(^(0),U,5))
154 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) S LREND=1
155 Q
156 ;
157TESTS Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))
158 N LRI
159 S LRI=0
160 F S LRI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI)) Q:LRI<.5 D
161 . N LR60,LRURG,LRTSTN
162 . S LRI(0)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI,0)),LRURG=+$P(LRI(0),U,2)
163 . S LR60=+LRI(0)
164 . I $D(^TMP("LR",$J,"T")),'$D(^TMP("LR",$J,"T",LR60)) Q ; Not specific test
165 . I LREXTST,$D(LREXTST(LR60)) Q ; Exclude specific test
166 . I $P(LRI(0),U,5) Q ; Complete date
167 . I LRCUTOFF,'LRDLA Q ; Uncollected
168 . I LRCUTOFF,LRCUTOFF<LRDLA Q ; After cut-off date/time
169 . S LR60(0)=$G(^LAB(60,LR60,0)) ; Get zeroth node from file #60
170 . I LREXNREQ,'$P(LR60(0),"^",17) Q ; Exclude non-required tests
171 . S LRTSTN=$P(LR60(0),U) ; Test name
172 . I $P(LR60(0),"^")="" S LRTSTN="MISSING FILE 60 - "_LR60
173 . I LRSORTBY=1 S LRTSTN=LRAA("NAME")_"^"_LRTSTN
174 . S Y=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
175 . S LRST=$S($L($P(LRI(0),U,3)):"Load/work list",$L($P(Y,U,3)):"In lab",1:"Not in lab")
176 . D REF
177 . S ^TMP($J,LRTSTN,LRURG,$P(LRACC," ",1)_"^"_+$P(LRDX,"^",3),LRAN)=LRST_U_SSN_U_PNM_U_$P(LRDX,U,7)_U_$P(LRDLA,"^",2)_U_LRMAN_U_LRACC
178 . I $G(LREXD) S ^TMP($J,LRTSTN,LRURG,$P(LRACC," ",1)_"^"_+$P(LRDX,"^",3),LRAN,.3)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
179 Q
180 ;
181REF ; if referred test, get referral status
182 N LREVNT,LRUID
183 S LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^"),LRMAN=$P(X,"^",10)
184 I LRMAN S LRMAN=$P($G(^LAHM(62.8,LRMAN,0)),"^")
185 S LREVNT=$$STATUS^LREVENT(LRUID,+X,LRMAN)
186 I LREVNT'="" S LRST=$P(LREVNT,"^")
187 Q
188 ;
189PHD ;
190 S LREND=0
191 I $P(LRAA(0),"^",3)="Y" D STAR^LRWU3
192 I $G(LRSTAR) Q
193 D ADATE^LRWU Q:LREND
194 S LAST=LRAD,LRAD=LRAD-1
195 D LRAN^LRWU3
196 Q
197 ;
198AC S LRTK=LRSTAR-.00001
199 F S LRTK=$O(^LRO(68,LRAA,1,LRAD,1,"E",LRTK)) Q:LRTK<1!(LAST>1&(LRTK\1>LAST)) D
200 . S LRAN=0
201 . F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,"E",LRTK,LRAN)) Q:'LRAN D
202 . . S LREND=0
203 . . I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LREND=1 Q
204 . . D TD Q:LREND
205 . . ;I LRUNC!('LRVERVER) D LST,TESTS
206 . . I 'LRVERVER D LST1^LRWRKIN1,TESTS
207 Q
208 ;
209% R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
210 Q
211 ;
212LREXPD ;Include panel test in list when selecting specific tests
213 I $G(S1(+$G(S1))) S ^TMP("LR",$J,"T",S1(S1))=^LAB(60,S1(S1),0)
214 Q
Note: See TracBrowser for help on using the repository browser.