source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VMSG.m@ 868

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1LA7VMSG ;DALOI/JMC - LAB ORU (Observation Result) message builder ; 12-12-96
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,50,56,46,64**;Sep 27, 1994
3 ;
4ORU ; Bleed the ORU (Observation Result) message queue
5 ; Tasked by LRCAPV2
6 ;
7 N LA7MTYP
8 S LA7MTYP="ORU"
9 D START^LA7VMSG1
10 ;
11 Q
12 ;
13ORR ; Bleed the ORR (Order Response) message queue
14 ; Called by LRWLST12
15 ;
16 N LA7MTYP
17 S LA7MTYP="ORR"
18 ;D START^LA7VMSG1
19 ;
20 Q
21 ;
22 ;
23SET(LRUID,SITE,RUID,SITEN,ORD,LRNLT,LRIDT,LRSS,LRDFN,ORDT,LA7VCH,LA7MTYP) ; adds entries to LA7V QUEUE file
24 ; Called by LA7SRR, LRVER3, LRWLST12
25 ; variable list
26 ; LRUID - Host Unique ID from the local ACCESSION file (#68)
27 ; SITE - remote sites IEN in INSTITUTION file (#4)
28 ; RUID - Remote sites Unique ID from ACCESSION file (#68)
29 ; SITEN - Primary site number of remote site ($$SITE^VASITE)
30 ; ORD - Free text ordered test name from WKLD CODE file (#64)
31 ; LRNLT - National Laboratory test code from WKLD CODE file (#64)
32 ; LRIDT - Inverse date/time (accession date/time)
33 ; LRSS - test subscript defined in LABORATORY TEST file (#60)
34 ; LRDFN - IEN in LAB DATA file (#63)
35 ; ORDT - Order date
36 ; LA7VCH (Optional) - array of Chemistry results
37 ; ex. glucose LA7VCH(2)=LR NODE
38 ; LA7VCH(2,1)="C" (corrected results)
39 ; LA7MTYP (Optional) - Message Type (ORU or ORR) defaults to ORU
40 ;
41 N FDA,LA76248,LA76249,LA7DT,LA7FACID,LA7ERR,LA7RSITE,LA7Y,PORD,PORT,RSITE
42 ;
43 S LA7ERR=0
44 I $G(LA7MTYP)="" S LA7MTYP="ORU"
45 ; Currently not building ORR when accessioning - JMC/7/11/00
46 I LA7MTYP="ORR" Q
47 ;
48 ; Retrieve facility id (VA=station number, DoD=DMIS code, other=local site assigned id)
49 S LA7FACID=$$RETFACID^LA7VHLU2(SITEN,2,1),LA76248=0
50 S LA7RSITE="LA7V COLLECTION "_LA7FACID
51 S LA76248=$O(^LAHM(62.48,"B",LA7RSITE,0))
52 ; No entry in 62.48 - *** Need to add error logging ****
53 I 'LA76248 Q
54 I '$P(^LAHM(62.48,LA76248,0),"^",3) Q ; not active
55 ;
56 ; Create new outgoing entry in 62.49
57 S LA76249=$$INIT6249^LA7VHLU
58 I LA76249<1 D Q
59 . ; Log entry creation error
60 ;
61 ; Check/validate parameters before storing
62 ; If error store but flag entry with error status.
63 D CHKACC
64 ;
65 ; File data
66 S FDA(1,62.49,LA76249_",",1)="O"
67 S FDA(1,62.49,LA76249_",",.5)=LA76248
68 S FDA(1,62.49,LA76249_",",2)=$S(LA7ERR:"E",1:"P")
69 S FDA(1,62.49,LA76249_",",5)=LA7RSITE_"-O-"_RUID
70 S FDA(1,62.49,LA76249_",",108)=LA7MTYP
71 S FDA(1,62.49,LA76249_",",151)=LRUID
72 S FDA(1,62.49,LA76249_",",152)=SITEN
73 S FDA(1,62.49,LA76249_",",153)=RUID
74 S FDA(1,62.49,LA76249_",",154)=ORD
75 S FDA(1,62.49,LA76249_",",155)=LRNLT
76 S FDA(1,62.49,LA76249_",",156)=LRIDT
77 S FDA(1,62.49,LA76249_",",157)=LRSS
78 S FDA(1,62.49,LA76249_",",158)=LRDFN
79 S FDA(1,62.49,LA76249_",",159)=ORDT
80 ;
81 D FILE^DIE("","FDA(1)","LA7ERR(1)")
82 D CLEAN^DILF
83 ;
84 ; Add test to order
85 S LA7Y=0
86 F S LA7Y=$O(LA7VCH(LA7Y)) Q:'LA7Y D
87 . N FDAIEN
88 . S FDA(2,62.49162,"+2,"_LA76249_",",.01)=LA7Y
89 . I $G(LA7VCH(LA7Y,1))="C" S FDA(2,62.49162,"+2,"_LA76249_",",.02)="C"
90 . S FDAIEN(1)=LA76249
91 . D UPDATE^DIE("","FDA(2)","FDAIEN","LA7ERR(2)")
92 . D CLEAN^DILF
93 ;
94 ; Release lock on entry.
95 L -^LAHM(62.49,LA76249)
96 Q
97 ;
98 ;
99CHKACC ; Check/validate parameters passed in before storing in file #62.49
100 ;
101 N I,LA763,LA768,LA7AA,LA7AD,LA7AN
102 ;
103 I $G(LRUID)="",$G(RUID)="" Q
104 I LRUID'="",'$D(^LRO(68,"C",LRUID)) D
105 . S LRUID=$G(RUID)
106 . I LRUID'="",'$D(^LRO(68,"C",LRUID)) S LRUID=""
107 I LRUID="" Q
108 ;
109 S I=$Q(^LRO(68,"C",LRUID)),(LA7AA,LA7AD,LA7AN)=0
110 I I'="",$QS(I,3)=LRUID S LA7AA=$QS(I,4),LA7AD=$QS(I,5),LA7AN=$QS(I,6)
111 F I=0,.2,.3,3 S LA768(I)=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,I))
112 ;
113 F I=0,"ORU" S LA763(I)=$G(^LR(LRDFN,LRSS,LRIDT,I))
114 ;
115 ; Mismatch on subscript with file #68
116 I LRSS'=$P(^LRO(68,LA7AA,0),"^",2) S LA7ERR=40 D CREATE^LA7LOG(LA7ERR)
117 ;
118 ; Mismatch on LRDFN with file #68
119 I LRDFN'=$P(LA768(0),"^") S LA7ERR=41 D CREATE^LA7LOG(LA7ERR)
120 ;
121 ; Mismatch on specimen inverse d/t with file #68
122 I LRIDT'=$P(LA768(3),"^",5) S LA7ERR=42 D CREATE^LA7LOG(LA7ERR)
123 ;
124 ; Mismatch on remote UID with file #68
125 I $G(RUID)'="",RUID'=$P(LA768(.3),"^",5) S LA7ERR=43 D CREATE^LA7LOG(LA7ERR)
126 ;
127 ; Mismatch on remote UID with file #63
128 I $G(RUID)'="",$P(LA763("ORU"),"^",5)'="",RUID'=$P(LA763("ORU"),"^",5) S LA7ERR=44 D CREATE^LA7LOG(LA7ERR)
129 ;
130 ; Mismatch on UID between file #63 and file #68
131 I $P(LA768(.3),"^")'="",$P(LA763("ORU"),"^")'="",$P(LA768(.3),"^")'=$P(LA763("ORU"),"^") S LA7ERR=45 D CREATE^LA7LOG(LA7ERR)
132 ;
133 Q
134 ;
135 ;
136ACK ; ACKnowledgment message processor
137 ;
138 G ACK^LA7VHL
139 Q
140 ;
141 ;
142TRIGGER(LRAA,LRAD,LRAN,LRTS) ; Call with LRTS by reference
143 ; LRTS array contains a list of verified test.
144 ; Sets the queue for out going messages. ^LAHM(62.49
145 ;
146 N ERR,LRDFN,LREND,LRIDT,LRNIEN,LRNLT,LRNLTN,LRODT,LRSS,LRTSX
147 N LRORU3,LRX
148 S LRDFN=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),LRODT=+$P(^(0),U,4)
149 S LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5)
150 S LRSS=$P($G(^LRO(68,LRAA,0)),U,2)
151 S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
152 Q:'$P($G(LRORU3),U,2)!('LRIDT)
153 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))#2
154 ;
155 S LRX=0 F S LRX=$O(LRTS(LRX)) Q:'LRX D
156 . S LRNLT=+$G(^LAB(60,+LRTS(LRX),64)) Q:'LRNLT
157 . Q:'$D(^LAM(LRNLT,0))#2
158 . S LRNLTN=$P(^LAM(LRNLT,0),U),LRNLT=$P(^(0),U,2)
159 . Q:'LRNLT
160 . D SET($P(LRORU3,U,4),$P(LRORU3,U,2),$P(LRORU3,U,5),$P(LRORU3,U,3),LRNLTN,LRNLT,LRIDT,LRSS,LRDFN,LRODT,"","ORU")
161 Q
Note: See TracBrowser for help on using the repository browser.