[628] | 1 | LA7VORM1 ;DALOI/DLR - LAB ORM (Order) message builder ; 12-12-96
|
---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,51,46,61,64**;Sep 27, 1994
|
---|
| 3 | ;
|
---|
| 4 | BUILD(LA7628) ;
|
---|
| 5 | ; Call with LA7628 = ien of entry in file #62.8 Shipping Manifest
|
---|
| 6 | ;
|
---|
| 7 | N LA7101,LA762801,LA7629,LA7NVAF,LA7PIDSN,LA7X,ECNT,GBL,SHP,SHPC,SITE,ORUID,NTST
|
---|
| 8 | ;
|
---|
| 9 | I $G(LA7628)<1!('$D(^LAHM(62.8,+$G(LA7628),0))) D Q
|
---|
| 10 | . ; Need to add error logging for manifest not found.
|
---|
| 11 | . D EXIT
|
---|
| 12 | ;
|
---|
| 13 | S GBL="^TMP(""HLS"","_$J_")",ECNT=1
|
---|
| 14 | S LA7628(0)=$G(^LAHM(62.8,LA7628,0))
|
---|
| 15 | S LA7629=$P(LA7628(0),U,2)
|
---|
| 16 | S LA7629(0)=$G(^LAHM(62.9,LA7629,0))
|
---|
| 17 | S LA76248=+$P(LA7629(0),"^",7)
|
---|
| 18 | S LA76248(0)=$G(^LAHM(62.48,LA76248,0))
|
---|
| 19 | I '$P(LA76248(0),"^",3) D EXIT Q ; not active
|
---|
| 20 | ;
|
---|
| 21 | S LA7V("INST")=$P(LA7629(0),U,11)
|
---|
| 22 | Q:LA7V("INST")=$P(LA7629(0),U,6) ;Same system shipment
|
---|
| 23 | ;
|
---|
| 24 | S LA7NVAF=$$NVAF^LA7VHLU2(+LA7V("INST")),SITE=""
|
---|
| 25 | I LA7NVAF=0 S SITE=$$GET1^DIQ(4,+$P(LA7629(0),U,11)_",",99)
|
---|
| 26 | I LA7NVAF=1 S SITE=$$ID^XUAF4("DMIS",+$P(LA7629(0),U,11))
|
---|
| 27 | S LA7V("NON")=$P(LA7629(0),U,12)
|
---|
| 28 | I LA7V("NON")'="" S SITE=LA7V("NON")
|
---|
| 29 | ;
|
---|
| 30 | S LA7X=$$NVAF^LA7VHLU2(+$P(LA7629(0),U,2))
|
---|
| 31 | I LA7X=0 S LA7V("CLNT")=$$GET1^DIQ(4,+$P(LA7629(0),U,2)_",",99)
|
---|
| 32 | I LA7X=1 S LA7V("CLNT")=$$ID^XUAF4("DMIS",+$P(LA7629(0),U,2))
|
---|
| 33 | S $P(LA7V("CLNT"),U,2)=$$GET1^DIQ(4,+$P(LA7629(0),U,2)_",",.01)
|
---|
| 34 | ;
|
---|
| 35 | S LA7X=$$NVAF^LA7VHLU2(+$P(LA7629(0),U,3))
|
---|
| 36 | I LA7X=0 S LA7V("HOST")=$$GET1^DIQ(4,+$P(LA7629(0),U,3)_",",99)
|
---|
| 37 | I LA7X=1 S LA7V("HOST")=$$ID^XUAF4("DMIS",+$P(LA7629(0),U,3))
|
---|
| 38 | S $P(LA7V("HOST"),U,2)=$$GET1^DIQ(4,+$P(LA7629(0),U,3)_",",.01)
|
---|
| 39 | ;
|
---|
| 40 | ; Assuming the receiving institution is the primary site (site with the computer system)
|
---|
| 41 | ;
|
---|
| 42 | ; Sort tests by patient,UID,test - only need to build one PID, PV1 per patient
|
---|
| 43 | ; ^TMP("LA7628",$J, LRDFN, accession UID, ien of shipping manifest specimen entry)
|
---|
| 44 | K ^TMP("LA7628",$J)
|
---|
| 45 | S LA762801=0
|
---|
| 46 | F S LA762801=$O(^LAHM(62.8,LA7628,10,LA762801)) Q:'LA762801 D
|
---|
| 47 | . S X(0)=$G(^LAHM(62.8,LA7628,10,LA762801,0))
|
---|
| 48 | . I $P(X(0),"^",8)=0 Q ; Removed from manifest
|
---|
| 49 | . I $P(X(0),"^"),$L($P(X(0),"^",5)) S ^TMP("LA7628",$J,+$P(X(0),"^"),$P(X(0),"^",5),LA762801)=""
|
---|
| 50 | K LA762801
|
---|
| 51 | ;
|
---|
| 52 | ; Nothing to send
|
---|
| 53 | I '$D(^TMP("LA7628",$J)) D EXIT Q
|
---|
| 54 | ;
|
---|
| 55 | ; Set flag = 0 (multiple PID's/message - build one message)
|
---|
| 56 | ; 1 (one PID/message - build multiple messages)
|
---|
| 57 | ; 2 (one ORC/message - build multiple messages)
|
---|
| 58 | S LA7SMSG=+$P(LA76248(0),"^",8)
|
---|
| 59 | ;
|
---|
| 60 | I LA7SMSG=0 D Q:$G(HL)
|
---|
| 61 | . D STARTMSG
|
---|
| 62 | . I $G(HL) D EXIT
|
---|
| 63 | ;
|
---|
| 64 | S (LRDFN,LRI,LA7PIDSN)=0
|
---|
| 65 | F S LRDFN=$O(^TMP("LA7628",$J,LRDFN)) Q:'LRDFN D Q:$G(HL)
|
---|
| 66 | . N LA7PID,LA7PV1
|
---|
| 67 | . I LA7SMSG=1 D STARTMSG Q:$G(HL)
|
---|
| 68 | . I LA7SMSG<2 D PID,PV1
|
---|
| 69 | . S LA7UID=""
|
---|
| 70 | . F S LA7UID=$O(^TMP("LA7628",$J,LRDFN,LA7UID)) Q:LA7UID="" D
|
---|
| 71 | . . N LA76802,LA7ORC,X
|
---|
| 72 | . . S X=$Q(^LRO(68,"C",LA7UID))
|
---|
| 73 | . . I $QS(X,3)'=LA7UID Q
|
---|
| 74 | . . S LRAA=$QS(X,4),LRAD=$QS(X,5),LRAN=$QS(X,6)
|
---|
| 75 | . . F I=0,.3,3 S LA76802(I)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,I))
|
---|
| 76 | . . S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
|
---|
| 77 | . . S LA76802(5)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,I,0))
|
---|
| 78 | . . I LA7SMSG=2 D STARTMSG Q:$G(HL) D PID,PV1
|
---|
| 79 | . . S (LA7OBRSN,LA762801)=0
|
---|
| 80 | . . F S LA762801=$O(^TMP("LA7628",$J,LRDFN,LA7UID,LA762801)) Q:'LA762801 D
|
---|
| 81 | . . . N LA7OBR,I
|
---|
| 82 | . . . F I=0,.1,1,2,5 S LA762801(I)=$G(^LAHM(62.8,LA7628,10,LA762801,I))
|
---|
| 83 | . . . I $$CHKTST^LA7SMU(LA7628,LA762801)'=0 Q ;deleted accession
|
---|
| 84 | . . . D ORC,OBR^LA7VORM3,OBX^LA7VORM3
|
---|
| 85 | . . I LA7SMSG=2 D BLG,SENDMSG
|
---|
| 86 | . I LA7SMSG<2 D BLG
|
---|
| 87 | . I LA7SMSG=1 D SENDMSG
|
---|
| 88 | ;
|
---|
| 89 | I LA7SMSG=0 D SENDMSG
|
---|
| 90 | ;
|
---|
| 91 | ;
|
---|
| 92 | EXIT ;
|
---|
| 93 | K @GBL,^TMP("LA7628",$J)
|
---|
| 94 | K DIC,DFN,EID,HL,HLCOMP,HLFS,HLQ,HLSUB,INT
|
---|
| 95 | K LA760,LA7628,LA762801,LA7629
|
---|
| 96 | K LA7ECH,LA7FS,LA7MID,LA7V,LA7HDR,LA7OBRSN,LA7OBXSN,LA7VIEN,LAEVNT
|
---|
| 97 | K LRAA,LRACC,LRAD,LRAN,LRDFN,LRI
|
---|
| 98 | K LTST,NLT,NLTIEN,PCNT,RUID,SNIEN,TIEN,X,Y,LA
|
---|
| 99 | D KVAR^LRX
|
---|
| 100 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 101 | Q
|
---|
| 102 | ;
|
---|
| 103 | ;
|
---|
| 104 | STARTMSG ; Create/initialize HL message
|
---|
| 105 | ;
|
---|
| 106 | K @GBL
|
---|
| 107 | S (LA76249,LA7PIDSN)=0
|
---|
| 108 | D STARTMSG^LA7VHLU("LA7V Order to "_SITE,.LA76249)
|
---|
| 109 | Q
|
---|
| 110 | ;
|
---|
| 111 | ;
|
---|
| 112 | SENDMSG ; File HL7 message with HL and LAB packages.
|
---|
| 113 | ;
|
---|
| 114 | N LA7DATA,LA7ID
|
---|
| 115 | S LA7ID="LA7V HOST "_SITE_"-O-"_$P($G(LA7628(0)),"^")
|
---|
| 116 | ; If no message to send then quit
|
---|
| 117 | I '$D(^TMP("HLS",$J)) D Q
|
---|
| 118 | . N FDA,LA7ER
|
---|
| 119 | . I $G(LA76248) S FDA(1,62.49,LA76249_",",.5)=LA76248
|
---|
| 120 | . S FDA(1,62.49,LA76249_",",1)="O"
|
---|
| 121 | . S FDA(1,62.49,LA76249_",",2)="E"
|
---|
| 122 | . S FDA(1,62.49,LA76249_",",5)=LA7ID
|
---|
| 123 | . D FILE^DIE("","FDA(1)","LA7ER(1)")
|
---|
| 124 | . D CLEAN^DILF
|
---|
| 125 | . L -^LAHM(62.49,LA76249)
|
---|
| 126 | ;
|
---|
| 127 | D GEN^LA7VHLU
|
---|
| 128 | S LA7DATA="SM06"_"^"_$$NOW^XLFDT
|
---|
| 129 | D SEUP^LA7SMU($P(LA7628(0),"^"),"1",LA7DATA)
|
---|
| 130 | D UPDT6249
|
---|
| 131 | ; Unlock entry
|
---|
| 132 | L -^LAHM(62.49,LA76249)
|
---|
| 133 | Q
|
---|
| 134 | ;
|
---|
| 135 | ;
|
---|
| 136 | UPDT6249 ; update entry in 62.49
|
---|
| 137 | ;
|
---|
| 138 | N FDA,LA7ER
|
---|
| 139 | ;
|
---|
| 140 | I $G(LA76248) S FDA(1,62.49,LA76249_",",.5)=LA76248
|
---|
| 141 | S FDA(1,62.49,LA76249_",",1)="O"
|
---|
| 142 | I $P(^LAHM(62.49,LA76249,0),"^",3)'="E" D
|
---|
| 143 | . I $G(HL("APAT"))="AL" S FDA(1,62.49,LA76249_",",2)="A"
|
---|
| 144 | . E S FDA(1,62.49,LA76249_",",2)="X"
|
---|
| 145 | . I $G(LA7ERR) S FDA(1,62.49,LA76249_",",2)="E"
|
---|
| 146 | S FDA(1,62.49,LA76249_",",5)=LA7ID
|
---|
| 147 | I $G(HL("SAN"))'="" S FDA(1,62.49,LA76249_",",102)=HL("SAN")
|
---|
| 148 | I $G(HL("SAF"))'="" S FDA(1,62.49,LA76249_",",103)=HL("SAF")
|
---|
| 149 | I $G(HL("MTN"))'="" S FDA(1,62.49,LA76249_",",108)=HL("MTN")
|
---|
| 150 | I $G(HL("PID"))'="" S FDA(1,62.49,LA76249_",",110)=HL("PID")
|
---|
| 151 | I $G(HL("VER"))'="" S FDA(1,62.49,LA76249_",",111)=HL("VER")
|
---|
| 152 | I $P($G(LA7MID),"^")'="" S FDA(1,62.49,LA76249_",",109)=$P(LA7MID,"^")
|
---|
| 153 | I $P($G(LA7MID),"^",2) D
|
---|
| 154 | . S FDA(1,62.49,LA76249_",",160)=$P(LA7MID,"^",2)
|
---|
| 155 | . S FDA(1,62.49,LA76249_",",161)=$P(LA7MID,"^",3)
|
---|
| 156 | D FILE^DIE("","FDA(1)","LA7ER(1)")
|
---|
| 157 | D CLEAN^DILF
|
---|
| 158 | Q
|
---|
| 159 | ;
|
---|
| 160 | ;
|
---|
| 161 | PID ; Patient identification
|
---|
| 162 | S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
|
---|
| 163 | D DEM^LRX
|
---|
| 164 | D PID^LA7VPID(LRDFN,"",.LA7PID,.LA7PIDSN,.HL,"")
|
---|
| 165 | ; DoD/CHCS facilities only use 1st repetition of PID-3.
|
---|
| 166 | I LA7NVAF=1 D
|
---|
| 167 | . S X=$P(LA7PID(0),LA7FS,4),X=$P(X,$E(LA7ECH,2))
|
---|
| 168 | . S $P(LA7PID(0),LA7FS,4)=X
|
---|
| 169 | D FILESEG^LA7VHLU(GBL,.LA7PID)
|
---|
| 170 | D FILE6249^LA7VHLU(LA76249,.LA7PID)
|
---|
| 171 | Q
|
---|
| 172 | ;
|
---|
| 173 | ;
|
---|
| 174 | PV1 ; Location information
|
---|
| 175 | ; DoD/CHCS facilities do not use PV1 segment
|
---|
| 176 | I LA7NVAF=1 Q
|
---|
| 177 | ;
|
---|
| 178 | D PV1^LA7VPID(LRDFN,.LA7PV1,LA7FS,LA7ECH)
|
---|
| 179 | D FILESEG^LA7VHLU(GBL,.LA7PV1)
|
---|
| 180 | D FILE6249^LA7VHLU(LA76249,.LA7PV1)
|
---|
| 181 | Q
|
---|
| 182 | ;
|
---|
| 183 | ;
|
---|
| 184 | ORC ;Order Control
|
---|
| 185 | ;
|
---|
| 186 | N ORC,LA7DATA,LA7DUR,LA7DURU,LA76205,LA762801,LA7X
|
---|
| 187 | ;
|
---|
| 188 | S ORC(0)="ORC"
|
---|
| 189 | S ORC(1)=$$ORC1^LA7VORC("NW")
|
---|
| 190 | ;
|
---|
| 191 | ; Place order number - accession UID
|
---|
| 192 | S ORC(2)=$$ORC2^LA7VORC($P(LA76802(.3),"^"),LA7FS,LA7ECH)
|
---|
| 193 | ;
|
---|
| 194 | ; Placer group number - shipping manifest invoice #
|
---|
| 195 | S ORC(4)=$$ORC4^LA7VORC($P(LA7628(0),"^"),LA7FS,LA7ECH)
|
---|
| 196 | ;
|
---|
| 197 | ; Quantity/Timing
|
---|
| 198 | S (LA76205,LA7DUR,LA7DURU)=""
|
---|
| 199 | S LA762801=0
|
---|
| 200 | F S LA762801=$O(^TMP("LA7628",$J,LRDFN,LA7UID,LA762801)) Q:'LA762801 D
|
---|
| 201 | . N I,LA760
|
---|
| 202 | . ; Test duration
|
---|
| 203 | . F I=0,2 S LA762801(I)=$G(^LAHM(62.8,LA7628,10,LA762801,I))
|
---|
| 204 | . I $P(LA762801(2),"^",4) D
|
---|
| 205 | . . S LA7DUR=$P(LA762801(2),"^",6) ; collection duration
|
---|
| 206 | . . S LA7DURU=$P(LA762801(2),"^",7) ; duration units
|
---|
| 207 | . ; Test urgency - find highest urgency on accession
|
---|
| 208 | . S LA760=+$P(LA762801(0),"^",2)
|
---|
| 209 | . S X=+$$GET1^DIQ(68.04,LA760_","_LRAN_","_LRAD_","_LRAA_",",1,"I")
|
---|
| 210 | . I 'LA76205 S LA76205=X
|
---|
| 211 | . I LA76205,X<LA76205 S LA76205=X
|
---|
| 212 | S ORC(7)=$$ORC7^LA7VORC(LA7DUR,LA7DURU,LA76205,LA7FS,LA7ECH)
|
---|
| 213 | ;
|
---|
| 214 | ; Order Date/Time - if no order date/time then try draw time
|
---|
| 215 | I $P(LA76802(0),"^",4) S ORC(9)=$$ORC9^LA7VORC($P(LA76802(0),"^",4))
|
---|
| 216 | I '$P(LA76802(0),"^",4),$P(LA76802(3),"^") S ORC(9)=$$ORC9^LA7VORC($P(LA76802(3),"^"))
|
---|
| 217 | ;
|
---|
| 218 | ; Ordering provider
|
---|
| 219 | S LA7X=$$FNDOLOC^LA7VHLU2(LA7UID)
|
---|
| 220 | S ORC(12)=$$ORC12^LA7VORC($P(LA76802(0),"^",8),$P(LA7X,"^",3),LA7FS,LA7ECH)
|
---|
| 221 | ;
|
---|
| 222 | ; Entering organization - VA facility
|
---|
| 223 | S ORC(17)=$$ORC17^LA7VORC($P($G(LA7629(0)),U,2),LA7FS,LA7ECH)
|
---|
| 224 | ;
|
---|
| 225 | D BUILDSEG^LA7VHLU(.ORC,.LA7DATA,LA7FS)
|
---|
| 226 | D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
---|
| 227 | D FILE6249^LA7VHLU(LA76249,.LA7DATA)
|
---|
| 228 | Q
|
---|
| 229 | ;
|
---|
| 230 | ;
|
---|
| 231 | BLG ; Billing segment
|
---|
| 232 | ;
|
---|
| 233 | N LA7BLG
|
---|
| 234 | ;
|
---|
| 235 | I $P(LA7629(0),U,13)="" Q
|
---|
| 236 | S LA7BLG(0)=$$BLG^LA7VHLU($P(LA7629(0),"^",13),"CO",LA7FS,LA7ECH)
|
---|
| 237 | D FILESEG^LA7VHLU(GBL,.LA7BLG)
|
---|
| 238 | D FILE6249^LA7VHLU(LA76249,.LA7BLG)
|
---|
| 239 | Q
|
---|