source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SM.m@ 1540

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1LA7SM ;DALOI/JMC - Shipping Manifest Options ;5/5/97 14:39
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46**;Sep 27, 1994
3 ;
4CLSHIP ; Close/ship a shipping manifest
5 D INIT
6 I LA7QUIT D CLEANUP Q
7 S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
8 I LA7SM<0 D Q
9 . D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
10 . D CLEANUP
11 D LOCKSM
12 I LA7QUIT D Q
13 . D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
14 . D UNLOCKSM,CLEANUP
15 S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
16 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
17 I $P(LA7SM(0),"^",3)=1 D
18 . S DIR(0)="SO^1:Close manifest;2:Ship manifest"
19 . S DIR("A")="Select action to perform",DIR("B")=1
20 I $P(LA7SM(0),"^",3)=3 D
21 . S DIR(0)="YO"
22 . S DIR("A")="Do you want to ship this manifest",DIR("B")="NO"
23 D ^DIR
24 I $D(DIRUT) D UNLOCKSM,CLEANUP Q
25 S LA7ST=+Y
26 I $P(LA7SM(0),"^",3)=3,LA7ST S LA7ST=2
27 I $P(LA7SM(0),"^",3)=1 D SMSUP^LA7SMU(LA7SM,3,"SM04") ; Close manifest
28 I LA7ST=2 D SHIP^LA7SM1 ; Ask for shipping date/time
29 I 'LA7QUIT!$D(LA7ERR) S LA7CHK=0 D ASK^LA7SMP(LA7SM) ; Ask if want to print manifest.
30 D UNLOCKSM,CLEANUP
31 Q
32 ;
33SMET ; Edit a test on a shipping manifest
34 ; Used to add/remove a test.
35 D INIT
36 I LA7QUIT D CLEANUP Q
37 S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"0,1,3")
38 I LA7SM<0 D Q
39 . D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
40 . D CLEANUP
41 D LOCKSM
42 I LA7QUIT D Q
43 . D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
44 . D UNLOCKSM,CLEANUP
45 S LA7SM(0)=$G(^LAHM(62.8,LA7SM,0))
46 S DIR(0)="SO^1:Add test to manifest;2:Remove test from manifest"
47 S DIR("A")="Select action to perform",DIR("B")=1
48 D ^DIR
49 I $D(DIRUT) D CLEANUP Q
50 S LA7ACTON=+Y
51 I LA7ACTON=1 F D ADDTEST Q:LA7QUIT
52 I LA7ACTON=2 F D REMVTST Q:LA7QUIT
53 I LA7QUIT,$L($P(LA7QUIT,"^",2)) D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
54 E D ASK^LA7SMP(LA7SM)
55 D CLEANUP
56 Q
57 ;
58 ;
59ADDTEST ; Add individual test to an existing manifest
60 ;
61 N LA760,LA7AA,LA7AD,LA7AN,LA7BY,LA7DIV,LA7I,LA7UID,LA7X
62 ;
63 D SEL
64 I LA7QUIT Q
65 ;
66 S DIC="^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,",DIC(0)="AEMQ",DIC("A")="Select TEST to Add: "
67 S DA=LA7AN,DA(1)=LA7AD,DA(2)=LA7AA
68 D ^DIC
69 I Y<1 D Q
70 . S LA7QUIT=1
71 . I $D(DUOUT) S $P(LA7QUIT,"^",2)="User aborted"
72 . I $D(DTOUT) S $P(LA7QUIT,"^",2)="User timeout"
73 S LA760=+Y
74 ;
75 ; Test's zeroth node.
76 S LA760(0)=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0))
77 ;
78 ; Test completed - skip
79 I $P(LA760(0),"^",5) S LA7QUIT="1^Test already completed" Q
80 ;
81 ; Test urgency
82 S LA76205=+$P(LA760(0),"^",2)
83 I LA76205>49 S LA76205=$S(LA76205=50:9,1:LA76205-50)
84 ;
85 ; Don't build controls
86 I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",2)=62.3 S LA7QUIT="1^Cannot select controls" Q
87 ;
88 S LA7I=0
89 F S LA7I=$O(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I)) Q:'LA7I D Q:LA7QUIT
90 . N X
91 . S X(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
92 . I $P(X(0),"^",2)=LA760,$P(X(0),"^",8)'=0 S LA7QUIT="1^Test already on shipping manifest"
93 I LA7QUIT Q
94 ;
95 ; Build TMP global with test profile
96 D SCBLD^LA7SM1(+LA7SCFG)
97 ;
98 ; Accession's division
99 S LA7DIV=+$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.4)),"^")
100 ;
101 ; Check if test eligible for manifest
102 D SCHK^LA7SM1
103 I 'LA7FLAG S LA7QUIT="1^Test not selectable for this configuration" Q
104 D LOCK68^LA7SMB
105 S LA7I=0
106 F S LA7I=$O(LA7X(LA7I)) Q:'LA7I D ADD^LA7SMB
107 D UNLOCK68^LA7SMB
108 Q
109 ;
110 ;
111REMVTST ; Remove a test from manifest - actually flags test as "removed".
112 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LA7I,LA7TCNT,LA7Y,LA760,X,Y
113 D SEL
114 I LA7QUIT Q
115 S (LA7I,LA7TCNT)=0
116 F S LA7I=$O(^LAHM(62.8,+LA7SM,10,"UID",LA7UID,LA7I)) Q:'LA7I D
117 . S LA7I(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
118 . I $P(LA7I(0),"^",8)=0 Q ; Previously "removed".
119 . I $P(LA7I(0),"^",8),$P(LA7I(0),"^",8)'=1 S LA7QUIT="1^Accession not pending shipment" Q
120 . S LA7TCNT=LA7TCNT+1,LA760(LA7TCNT)=LA7I_"^"_LA7I(0)
121 I 'LA7TCNT,'LA7QUIT S LA7QUIT="1^Accession is not on this shipping manifest"
122 I LA7QUIT Q
123 S LA7I=0
124 F S LA7I=$O(LA760(LA7I)) Q:'LA7I D EN^DDIOL(LA7I_" "_$P($G(^LAB(60,+$P(LA760(LA7I),"^",3),0)),"^"),"","!?5")
125 S DIR(0)="LO^1:"_LA7TCNT,DIR("A")="Select test(s) to remove"
126 D ^DIR
127 I $D(DIRUT) S LA7QUIT=1 Q
128 M LA7YARRY=Y
129 S LA7Y=""
130 F S LA7Y=$O(LA7YARRY(LA7Y)) Q:LA7Y="" D
131 . F LA7I=1:1 Q:'$P(LA7YARRY(LA7Y),",",LA7I) D
132 . . S LA7X=$P(LA7YARRY(LA7Y),",",LA7I)
133 . . N FDA,LA7628,LA768,LA7DATA
134 . . S LA762801=+(LA760(LA7X))_","_+LA7SM_","
135 . . S FDA(62.8,62.801,LA762801,.08)=0
136 . . D FILE^DIE("","FDA(62.8)","LA7DIE(2)") ; "Remove" test from shipping manifest
137 . . ; Update event file
138 . . S LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA760(LA7X),"^",3)_"^"_$P(LA7SM,"^",2)
139 . . D SEUP^LA7SMU(LA7UID,2,LA7DATA)
140 . . ; Update accession
141 . . D ACCSUP^LA7SMU(LA7UID,$P(LA760(LA7X),"^",3),"@")
142 Q
143 ;
144 ;
145CANC ; Cancel a shipping manifest
146 D INIT
147 I LA7QUIT D CLEANUP Q
148 S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"1,3")
149 I LA7SM<0 D Q
150 . D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
151 . D CLEANUP
152 D LOCKSM
153 I LA7QUIT D Q
154 . D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
155 . D UNLOCKSM,CLEANUP
156 S LA7SM(0)=$G(^LAHM(62.8,LA7SM,0))
157 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
158 S DIR(0)="YO"
159 S DIR("A")="Do you want to cancel this manifest",DIR("B")="NO"
160 D ^DIR
161 I $D(DIRUT) D UNLOCKSM,CLEANUP Q
162 S LA7ST=+Y
163 I LA7ST=1 D
164 . S LA7I=0
165 . F S LA7I=$O(^LAHM(62.8,+LA7SM,10,LA7I)) Q:'LA7I D
166 . . S LA7I(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
167 . . I $P(LA7I(0),"^",8)=0 Q ; Previously "removed".
168 . . ; "Remove" test from shipping manifest
169 . . S LA762801=LA7I_","_+LA7SM_","
170 . . S FDA(62.8,62.801,LA762801,.08)=0
171 . . D FILE^DIE("","FDA(62.8)","LA7DIE(2)")
172 . . ; Update event file
173 . . S LA7DATA="SM51^"_$$NOW^XLFDT_"^"_$P(LA7I(0),"^",2)_"^"_$P(LA7SM,"^",2)
174 . . D SEUP^LA7SMU($P(LA7I(0),"^",5),2,LA7DATA)
175 . . ; Update accession
176 . . D ACCSUP^LA7SMU($P(LA7I(0),"^",5),$P(LA7I(0),"^",2),"@")
177 . D SMSUP^LA7SMU(LA7SM,0,"SM00") ; Cancel manifest
178 D UNLOCKSM,CLEANUP
179 Q
180 ;
181 ;
182SEL ; Select accession
183 ;
184 N LRAA,LRACC,LRAD,LRAN,X
185 ;
186 ; Select by accession, ^LRWU4 needs variable LRACC.
187 S LRACC=""
188 D ^LRWU4
189 I $D(DUOUT) S LA7QUIT="1^User aborted" Q
190 I $D(DTOUT) S LA7QUIT="1^User timeout" Q
191 I (LRAA*LRAD*LRAN)<1 S LA7QUIT="1" Q
192 ;
193 S LA7AA=LRAA,LA7AD=LRAD,LA7AN=LRAN
194 ;
195 S LA7UID=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.3)),"^")
196 I LA7UID="" S LA7QUIT="2^Database error - accession missing UID" Q
197 ;
198 ; Specimen type
199 S LA76805=0
200 S X=+$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,0))
201 I X S LA76805=+$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,5,X,0))
202 Q
203 ;
204 ;
205INIT ; Initialize variables
206 S DT=$$DT^XLFDT
207 S LA7QUIT=0
208 S LA7SCFG=$$SSCFG^LA7SUTL(1) ; Select shipping configuration
209 I LA7SCFG<1 S LA7QUIT=1 Q
210 S LA7SCFG(0)=$G(^LAHM(62.9,+LA7SCFG,0))
211 K ^TMP("LA7ERR",$J)
212 Q
213 ;
214 ;
215LOCKSM ; Lock entry in file 62.8
216 L +^LAHM(62.8,+LA7SM):1 ; Set lock.
217 I '$T S LA7QUIT="1^Someone else is editing this shipping manifest"
218 Q
219 ;
220 ;
221UNLOCKSM ; Unlock entry in file 62.8
222 L -^LAHM(62.8,+LA7SM) ; Release lock.
223 Q
224 ;
225 ;
226CLEANUP ; Cleanup variables
227 I $D(ZTQUEUED) S ZTREQ="@"
228 K DA,DIC,DIR,DIRUT,DTOUT,DUOUT,X,Y
229 K LA7AA,LA7ACTON,LA7AD,LA7AN,LA7EV,LA7FLAG,LA7I,LA7QUIT,LA7SCFG,LA7SDT,LA7SM,LA7ST,LA7UID,LA7X,LA7YARRY
230 K LA760,LA76205,LA762801,LA76805
231 K ^TMP("LA7ERR",$J)
232 Q
Note: See TracBrowser for help on using the repository browser.