source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SMP0.m@ 1328

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1LA7SMP0 ;DALOI/JMC - Shipping Manifest Print (Cont'd);11/25/96 14:39
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 ;
4HED ; Header
5 I $E(IOST,1,2)="C-" D TERM Q:$G(LA7EXIT)
6 I LA7PAGE W @IOF S $X=0
7 S LA7PAGE=LA7PAGE+1
8 I +LA7SMST'=4,IOM<132 D WARN
9 ;
10 W !,?1,"Shipping Manifest: ",$P(LA7SM,"^",2)
11 I +LA7SMST'=4,IOM'<132 D WARN
12 ;
13 W ?IOM-37," Page: ",LA7PAGE
14 W !,?11,"to Site: ",LA7TSITE
15 W ?IOM-40," Printed: ",LA7NOW
16 W !,?9,"from Site: ",LA7FSITE
17 ;
18 I +LA7SMST=4 W !,?6,"Date Shipped: ",$P(LA7SDT,"^",2)
19 E W !,?12,"Status: ",$P(LA7SMST,"^",2)
20 W ?IOM-41," Ship via: ",LA7SVIA
21 ;
22 ; Check if task has been asked to stop.
23 I $D(ZTQUEUED),$$S^%ZTLOAD D Q
24 . S (LA7EXIT,ZTSTOP)=1
25 . W !!,"*** Report requested to stop by TaskMan ***"
26 . W !,"*** Task #",$G(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($H)," ***"
27 ;
28 ; Print shipping receipt
29 I $P(LA7SMR,"^",2) D Q
30 . W !,LA7LINE
31 . I $P(LA7SMR,"^",2)=2 W !!,"Following Required Information and/or Test Codes Missing",!!
32 ;
33 W !,"Shipping Condition: ",$S(LA7SCOND:$$GET1^DIQ(62.93,LA7SCOND_",",.01),1:"None Specified")
34 W ?(IOM-42)," Container: ",$S(LA7SCONT:$$GET1^DIQ(62.91,LA7SCONT_",",.01),1:"None Specified")
35 ;
36 I $L($P(LA7SCFG(0),"^",13)) W !,?4,"Account Number: ",$P(LA7SCFG(0),"^",13)
37 ;
38 I LA7SBC D SBC1
39 W !!,?11,"Patient Name",?41,"Patient ID",?64,"Accession"
40 I IOM>131 W ?86,"Requested By"
41 W !,?11,"Date of Birth",?41,"Sex",?64,"Specimen UID"
42 I IOM>131 W ?86,"Collect Date/Time"
43 I IOM'>131 W !,?11,"Requested By",?41,"Collect Date/Time"
44 W !,LA7LINE
45 Q
46 ;
47 ;
48SH ; Subheader
49 W !,"Item: ",LA7ITEM
50 W ?11,PNM
51 ;I LRDPF=2,LA7ICN W ?41,LA7ICN
52 ;E W ?41,$S(LRDPF=2:SSN,1:SSN(2))
53 W ?41,$S(LRDPF=2:SSN,1:SSN(2))
54 W ?64,LA7ACC
55 I IOM>131 W ?86,$P(LA7PROV,"^",2)
56 W !
57 I LA7DC W "Cont'd"
58 W ?11,$$FMTE^XLFDT(DOB),?41,$S(SEX="M":"Male",SEX="F":"Female",SEX="":"Unknown",1:SEX),?64,LA7UID
59 I IOM'>131 W !,?11,$E($P(LA7PROV,"^",2),1,28),?41,$S(LA7CDT:$$FMTE^XLFDT(LA7CDT,"1M"),1:LA7CDT)
60 I IOM>131 W ?86,$S(LA7CDT:$$FMTE^XLFDT(LA7CDT,"1M"),1:LA7CDT)
61 W !
62 I +LA7SMST'=4 D
63 . D PROV(+LA7PROV)
64 . I $P($G(LA762801(0)),"^",6) D
65 . . S X=$$GET1^DIQ(62.91,$P(LA762801(0),"^",6),.01)
66 . . W !,?11,"Specimen Container: ",X
67 ;
68 ; Print collection sample if micro
69 I $G(LA7AA),$P($G(^LRO(68,LA7AA,0)),"^",2)="MI" W !,?11,"Collection sample: ",$P(LA762(0),"^")
70 ;
71 S LA7X=$G(^TMP("LA7SMRI",$J,LA7SCOND,LA7SCONT,LA7UID,1))
72 I $P(LA7X,"^") D
73 . W !,?11,"Patient Height: ",$P(LA7X,"^",2)," ",$$GET1^DIQ(64.061,+$P(LA7X,"^",3)_",",.01)
74 I $P(LA7X,"^",4) D
75 . I $P(LA7X,"^") W ?40
76 . E W !,?11
77 . W "Patient Weight: ",$P(LA7X,"^",5)," ",$$GET1^DIQ(64.061,+$P(LA7X,"^",6)_",",.01)
78 ;
79 S LA7X=$G(^TMP("LA7SMRI",$J,LA7SCOND,LA7SCONT,LA7UID,2))
80 I $P(LA7X,"^") D
81 . W !,?11,"Collection Volume: ",$P(LA7X,"^",2)," ",$$GET1^DIQ(64.061,+$P(LA7X,"^",3)_",",.01)
82 I $P(LA7X,"^",8) D
83 . I $P(LA7X,"^") W ?40
84 . E W !,?11
85 . W "Collection Weight: ",$P(LA7X,"^",9)," ",$$GET1^DIQ(64.061,+$P(LA7X,"^",10)_",",.01)
86 I $P(LA7X,"^",4) D
87 . W !,?11,"Collection End Date/Time: ",$$FMTE^XLFDT($P(LA7X,"^",5),"1M")
88 . W " (Duration: ",$P(LA7X,"^",6)," ",$$GET1^DIQ(64.061,+$P(LA7X,"^",7)_",",.01),")"
89 ;
90 I LA7SBC D SBC2
91 S LA7DC=0
92 Q
93 ;
94 ;
95WARN ; Write warning for work copy.
96 W ?$S(IOM<131:5,1:40),"*** DO NOT USE FOR SHIPPING DOCUMENT - WORK COPY ONLY ***"
97 Q
98 ;
99 ;
100SBC1 ; Site bar codes
101 ;
102 ; Print "SM" bar code
103 ; Calculate/append LPC to barcode.
104 I $G(LA7SM("BARCODE"))="" D
105 . N LA7X,X,Y
106 . I LA7SBC=1 D
107 . . S LA7X="STX^SITE^"_LA7FSITE(99)_"^"_$P($G(LA7SDT),"^")_"^"_$P(LA7SM,"^",2)_"^ETX"
108 . I LA7SBC=2 D
109 . .S LA7X="SITE^"_LA7FSITE(99)_"^"_$P($G(LA7SDT),"^")_"^"_$P(LA7SM,"^",2)_"^"
110 . S X=LA7X X ^%ZOSF("LPC") S LA7SM("LPC")=Y,LA7SM("BARCODE")=LA7X_Y
111 ;
112 W !,?18,"SM: ",$$BC128^LA7SBC(LA7SM("BARCODE"),1,60,"","",2),!
113 ;
114 Q
115 ;
116 ;
117SBC2 ; Patient bar codes
118 ;
119 N LA7SDATA
120 ;
121 ; Print "PD" bar code
122 I LA7SBC=1 D
123 . S LA7SDATA="STX^PD^"_SSN(2)_"^"_LA7FSITE(99)_"^"_LA7UID_"^"_$G(SEX)_"^"_LA7CDT_"^ETX"_$G(LA7SM("LPC"))
124 ;
125 I LA7SBC=2 D
126 . S LA7SDATA="PD^"_SSN(2)_"^"_LA7FSITE(99)_"^"_LA7UID_"^"_LA7CDT_"^"_$G(LA7SM("LPC"))
127 ;
128 W !!,?18,"PD: ",$$BC128^LA7SBC(LA7SDATA,1,60,"","",2),!
129 W !,?11,$E(LA7LINE,1,69)
130 ;
131 ; Print "PD1" bar code
132 I LA7SBC=1 D
133 . S LA7SDATA="STX^PD1^"_SSN(2)_"^"_PNM_"^"_DOB_"^ETX"_$G(LA7SM("LPC"))
134 I LA7SBC=2 D
135 . S LA7SDATA="PD1^"_SSN(2)_"^"_PNM_"^"_DOB_"^"_SEX_"^"_$G(LA7SM("LPC"))
136 ;
137 W !,?$S(IOM<131:18,1:50),"PD1: ",$$BC128^LA7SBC(LA7SDATA,1,60,"","",2),!
138 ;
139 Q
140 ;
141 ;
142CMT ; Print comments on manifest
143 ;
144 N LA7I
145 F LA7I=1:1:LA7CMT D Q:LA7EXIT
146 . I ($Y+4)>IOSL D Q:LA7EXIT
147 . . I LA7PAGE W ! D WARN
148 . . D HED
149 . W !,?11,LA7CMT(LA7I,0)
150 Q
151 ;
152 ;
153PTID ; Get/setup patient identifier information
154 ;
155 S DFN=+$P(^LR(LRDFN,0),U,3),LRDPF=+$P(^(0),U,2) D PT^LRX
156 ;
157 ; Integration control number (ICN) from MPI
158 S LA7ICN=""
159 S X="MPIF001" X ^%ZOSF("TEST")
160 I $T,LRDPF=2 D
161 . S LA7ICN=$$GETICN^MPIF001(DFN)
162 . I LA7ICN<1 S LA7ICN=""
163 Q
164 ;
165 ;
166PROV(LA7OP) ; Print ordering provider contact on working copy
167 ; Call with LA7OP = provider's file #200 ien
168 ;
169 N LRERR,X,Y
170 I LA7OP D GETS^DIQ(200,LA7OP_",",".132;.137;.138","E","LA7OP(LA7OP)","LRERR")
171 I '$D(LA7OP(LA7OP)) Q
172 S X="Requestor's "
173 I LA7OP(LA7OP,200,LA7OP_",",.132,"E")'="" D
174 . W !,?11,X,"Phone: ",LA7OP(LA7OP,200,LA7OP_",",.132,"E")
175 . S X=""
176 I LA7OP(LA7OP,200,LA7OP_",",.137,"E")'="" D
177 . S Y=0
178 . I X="" S Y=$L(LA7OP(LA7OP,200,LA7OP_",",.137,"E"))+$X+16
179 . I Y>IOM!(X'="") W !,?11
180 . E S X=" "_X
181 . W X,"Voice Pager: ",LA7OP(LA7OP,200,LA7OP_",",.137,"E")
182 . S X=""
183 I LA7OP(LA7OP,200,LA7OP_",",.138,"E")'="" D
184 . S Y=0
185 . I X="" S Y=$L(LA7OP(LA7OP,200,LA7OP_",",.138,"E"))+$X+18
186 . I Y>IOM!(X'="") W !,?11
187 . E S X=" "_X
188 . W X,"Digital Pager: ",LA7OP(LA7OP,200,LA7OP_",",.138,"E")
189 . S X=""
190 ;
191 I X="" W !
192 Q
193 ;
194 ;
195TERM ;
196 I 'LA7PAGE W @IOF S $X=0 Q
197 ;
198 N DIR,DIRUT,DTOUT,DUOUT,X,Y
199 S DIR(0)="E" D ^DIR S:$D(DIRUT) LA7EXIT=1
200 Q
201 ;
202 ;
203INIT ; Initialize variables
204 ;
205 S DT=$$DT^XLFDT
206 S LA7QUIT=0
207 ;
208 ; Select shipping configuration
209 S LA7SCFG=$$SSCFG^LA7SUTL(0)
210 I LA7SCFG<1 S LA7QUIT=1 Q
211 S LA7SCFG(0)=$G(^LAHM(62.9,+LA7SCFG,0))
212 Q
213 ;
214END ;
215 I $E(IOST,1,2)="C-",'$G(LA7EXIT) D TERM
216 I $E(IOST,1,2)="P-" W @IOF S IONOFF=""
217 I '$D(ZTQUEUED) D ^%ZISC
218 ;
219KILL ; Cleanup variables
220 K %,%DT,%ZIS,A,IO("Q"),AGE,DA,DFN,DIC,DIB,DIR,DIRUT,DTOUT,DUOUT,I,J,K,LAST,PNM,SEX,SSN,X,Y,Z
221 K LA7AA,LA7ACC,LA7AD,LA7AN,LA7CDT,LA7CHK,LA7CMT,LA7DC,LA7END,LA7ERR,LA7EV,LA7EXIT,LA7FSITE,LA7I,LA7ICN,LA7ITEM,LA7LINE,LA7NLT,LA7NLTN,LA7NOW,LA7PAGE,LA7PROV
222 K LA7QUIT,LA7ROOT,LA7SBC,LA7SCFG,LA7SCOND,LA7SCONT,LA7SDT,LA7SKIP,LA7SM,LA7SMR,LA7SMST,LA7SPEC,LA7SVIA,LA7TSITE,LA7UID,LA7X
223 K LA760,LA762801
224 K LRDFN,LRDPF,LRPRAC
225 K ^TMP("LA7ERR",$J),^TMP("LA7SM",$J),^TMP("LA7SMRI",$J)
226 D KVAR^LRX
227 ;
228 I $D(ZTQUEUED) S ZTREQ="@"
229 Q
Note: See TracBrowser for help on using the repository browser.