source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SM1.m@ 1458

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1LA7SM1 ;DALOI/JMC - Shipping Manifest Options ;5/5/97 14:39
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,46,61**;Sep 27, 1994
3 ;
4RETRANS ; Retransmit a shipping manifest.
5 ;
6 D INIT^LA7SM
7 I LA7QUIT D CLEANUP^LA7SM Q
8 ;
9 I '$P($G(^LAHM(62.9,+LA7SCFG,0)),"^",7) D Q
10 . N MSG
11 . S MSG="This shipping configuration "_$P(LA7SCFG,"^",2)_" is not setup for electronic transmission."
12 . D EN^DDIOL(MSG,"","!?5")
13 . D CLEANUP^LA7SM
14 ;
15 S LA7SM=$$SELSM^LA7SMU(+LA7SCFG,"4")
16 I LA7SM<0 D Q
17 . D EN^DDIOL($P(LA7SM,"^",2),"","!?5")
18 . D CLEANUP^LA7SM
19 ;
20 I LA7QUIT D Q
21 . D EN^DDIOL($P(LA7QUIT,"^",2),"","!?5")
22 . D CLEANUP^LA7SM
23 ;
24 S LA7SM(0)=$G(^LAHM(62.8,+LA7SM,0))
25 ;
26 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
27 ;
28 S DIR(0)="YO"
29 S DIR("A")="Sure you want to retransmit this manifest",DIR("B")="NO"
30 D ^DIR
31 I $D(DIRUT) D CLEANUP^LA7SM Q
32 ;
33 ; Do tasking of transmission
34 I Y D TASKSM
35 D CLEANUP^LA7SM
36 ;
37 Q
38 ;
39 ;
40SHIP ; Ship a manifest
41 ; Used to flag shipping manifest for shipping
42 ; If electronically connected -> transmit shipping manifest in HL7 message.
43 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LA7I,LA7TCNT,X,Y
44 ;
45 S (LA7I,LA7TCNT)=0
46 F S LA7I=$O(^LAHM(62.8,+LA7SM,10,LA7I)) Q:'LA7I D
47 . I $$CHKTST^LA7SMU(+LA7SM,LA7I) Q
48 . I $P($G(^LAHM(62.8,+LA7SM,10,LA7I,0)),"^",8)'=1 Q
49 . S LA7TCNT=LA7TCNT+1 ; Test ready to ship.
50 . D CHKREQI^LA7SM2(+LA7SM,LA7I)
51 ;
52 I 'LA7TCNT D Q
53 . S LA7QUIT=1
54 . D EN^DDIOL("No tests on shipping manifest - Shipping Aborted","","!?5")
55 ;
56 I $G(LA7ERR) D Q
57 . S LA7QUIT=1
58 . D EN^DDIOL("Print shipping manifest for complete listing of errors","","!!?5")
59 . D EN^DDIOL("The following errors were found - Shipping Aborted","","!?5")
60 . S LA7X=""
61 . F S LA7X=$O(LA7ERR(LA7X)) Q:LA7X="" D EN^DDIOL(LA7ERR(LA7X),"","!?5")
62 . D EN^DDIOL("","","!")
63 ;
64 S DIR(0)="D^::EFRX",DIR("A")="Enter Manifest Shipping Date",DIR("B")="NOW"
65 D ^DIR
66 I $D(DIRUT) S LA7QUIT=1 Q
67 S LA7SDT=Y
68 D SMSUP^LA7SMU(LA7SM,4,"SM05^"_LA7SDT)
69 ;
70 K LA7I
71 S LA7I=0
72 F S LA7I=$O(^LAHM(62.8,+LA7SM,10,LA7I)) Q:'LA7I D
73 . S LA7I(0)=$G(^LAHM(62.8,+LA7SM,10,LA7I,0))
74 . I $P(LA7I(0),"^",8)'=1 Q ; Not "pending shipment".
75 . ; Change status to "shipped".
76 . S LA762801=LA7I_","_+LA7SM_","
77 . S FDA(62.8,62.801,LA762801,.08)=2
78 . D FILE^DIE("","FDA(62.8)","LA7DIE(2)")
79 . ; Update event file
80 . S LA7DATA="SM53^"_$$NOW^XLFDT_"^"_$P(LA7I(0),"^",2)_"^"_$P(LA7SM,"^",2)
81 . D SEUP^LA7SMU($P(LA7I(0),"^",5),2,LA7DATA)
82 ;
83 ; Do tasking of transmission
84 I $P($G(^LAHM(62.9,+LA7SCFG,0)),"^",7) D TASKSM
85 ;
86 Q
87 ;
88 ;
89SCBLD(LA7SCFG) ; Build test profile for a configuration
90 ; Call with LA7SCFG = ien of shipping configuration in file #62.9
91 N I,X
92 ;
93 K ^TMP("LA7SMB",$J)
94 ;
95 S X=0
96 F S X=$O(^LAHM(62.9,LA7SCFG,60,X)) Q:'X D
97 . F I=0,1,2,5 S X(I)=$G(^LAHM(62.9,LA7SCFG,60,X,I))
98 . ; No accession area - skip
99 . I '$P(X(0),"^",2) Q
100 . ; TMP("LA7SMB",$J,accession area,file 60 test,entry #,specimen,urgency,division, node)
101 . ; specimen=0 if any specimen, urgency=0 if any urgency, division=0 if any division
102 . F I=0,1,2,5 S ^TMP("LA7SMB",$J,$P(X(0),"^",2),+X(0),X,+$P(X(0),"^",3),+$P(X(0),"^",4),+$P(X(0),"^",10),I)=X(I)
103 Q
104 ;
105 ;
106SCHK ; Check shipping configuration for test eligible to add.
107 ; Called by LA7SM, LA7SMB
108 ;
109 N LA7I,LA7J,LA7K,LA7L,LA7M
110 ;
111 K LA7X
112 ;
113 ; Flag to determine if accession/test should be added to manifest.
114 S LA7FLAG=0
115 ;
116 ; Quit if this asscession area/test not defined for configuration.
117 I '$D(^TMP("LA7SMB",$J,LA7AA,LA760)) Q
118 ;
119 S LA7I=0
120 F S LA7I=$O(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I)) Q:'LA7I D
121 . S LA7FLAG=0
122 . D CHKMASK Q:'LA7FLAG
123 . F LA7J=0,1,2,5 S LA7X(LA7I,LA7J)=$G(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA7K,LA7L,LA7M,LA7J))
124 ;
125 I $D(LA7X) S LA7FLAG=1
126 ;
127 Q
128 ;
129 ;
130CHKMASK ; Check pattern mask for tests that match on specimen, urgency and division.
131 ;
132 ; Specimen, urgency, and division match
133 I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA76805,LA76205,LA7DIV)) S LA7FLAG=1,LA7K=LA76805,LA7L=LA76205,LA7M=LA7DIV Q
134 ;
135 ; Specimen and urgency match; any division
136 I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA76805,LA76205,0)) S LA7FLAG=1,LA7K=LA76805,LA7L=LA76205,LA7M=0 Q
137 ;
138 ; Specimen and division match; any urgency
139 I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA76805,0,LA7DIV)) S LA7FLAG=1,LA7K=LA76805,LA7L=0,LA7M=LA7DIV Q
140 ;
141 ; Specimen match; any urgency/division
142 I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,LA76805,0,0)) S LA7FLAG=1,LA7K=LA76805,LA7L=0,LA7M=0 Q
143 ;
144 ; Any specimen; urgency and division match
145 I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,0,LA76205,LA7DIV)) S LA7FLAG=1,LA7K=0,LA7L=LA76205,LA7M=LA7DIV Q
146 ;
147 ; Any specimen and division; urgency match
148 I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,0,LA76205,0)) S LA7FLAG=1,LA7K=0,LA7L=LA76205,LA7M=0 Q
149 ;
150 ; Any specimen and urgency; division match
151 I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,0,0,LA7DIV)) S LA7FLAG=1,(LA7K,LA7L)=0,LA7M=LA7DIV Q
152 ;
153 ; Any specimen, urgency or division
154 I $D(^TMP("LA7SMB",$J,LA7AA,LA760,LA7I,0,0,0)) S LA7FLAG=1,(LA7K,LA7L,LA7M)=0 Q
155 ;
156 Q
157 ;
158 ;
159TASKSM ; Task electronic transmission of manifest
160 ;
161 N MSG,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
162 ;
163 S ZTRTN="BUILD^LA7VORM1("""_+$P(LA7SM,"^")_""")",ZTDESC="E-Transmission of Lab Shipping Manifest"
164 S ZTSAVE("LA7SM")="",ZTIO="",ZTDTH=$$NOW^XLFDT
165 D ^%ZTLOAD
166 ;
167 S MSG="Electronic Transmission of Shipping Manifest "_$S($G(ZTSK):"queued as task# "_ZTSK,1:"NOT queued!")
168 D EN^DDIOL(MSG,"","!?5")
169 ;
170 Q
Note: See TracBrowser for help on using the repository browser.