source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQEHLR.m@ 1073

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1DGQEHLR ;ALB/RPM - VIC REPLACEMENT HL7 RECEIVE DRIVER ; 10/6/03
2 ;;5.3;Registration;**571**;Aug 13, 1993
3 ;
4RCV ;
5 N DGCNT
6 N DGMSGTYP
7 N DGSEG
8 N DGSEGCNT
9 N DGWRK
10 ;
11 S DGWRK=$NA(^TMP("DGPFHL7",$J))
12 K @DGWRK
13 ;
14 ;load work global with segments
15 F DGSEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
16 . S DGCNT=0
17 . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE
18 . F S DGCNT=$O(HLNODE(DGCNT)) Q:'DGCNT D
19 . . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT)
20 ;
21 ;get message type from first segment
22 I $$NXTSEG^DGQEHLUT(DGWRK,0,HL("FS"),.DGSEG),$G(DGSEG("TYPE"))="MSH" D
23 . S DGMSGTYP=$P(DGSEG(9),$E(HL("ECH"),1),1)
24 . I DGMSGTYP=HL("MTN") D RCVORR(DGWRK,.HL)
25 ;
26 ;cleanup
27 K @DGWRK
28 Q
29 ;
30RCVORR(DGWRK,DGHL) ;process a single ORR~O02 message
31 ;
32 ; Input:
33 ; DGWRK - temporary segment work array
34 ; DGHL - VistA HL7 environment array
35 ;
36 ; Output:
37 ; none
38 ;
39 N DGORR
40 N DGLIEN
41 N DGSTAT
42 ;
43 D PARSORR(DGWRK,.DGHL,.DGORR)
44 ;
45 I +$G(DGORR("MSGID")),$G(DGORR("ACKCODE"))]"" D
46 . S DGLIEN=$$FINDMID^DGQEHLL(DGORR("MSGID"))
47 . Q:'DGLIEN
48 . ;
49 . I DGORR("ACKCODE")="AA" S DGSTAT="A"
50 . E D
51 . . S DGSTAT="RJ"
52 . . ;send bulletin indicating failed NCMD update
53 . . D SENDBULL(DGLIEN,.DGORR)
54 . ;
55 . ;remove "H"old event entry from VIC HL7 TRANSMISSION LOG (#39.6) file
56 . D STOACK^DGQEHLL(DGLIEN,DGSTAT)
57 ;
58 Q
59 ;
60PARSORR(DGWRK,DGHL,DGORR) ;Parse ORR Message/Segments
61 ;
62 ; Input:
63 ; DGWRK - Closed root work global reference
64 ; DGHL - HL7 environment array
65 ;
66 ; Output:
67 ; DGORR - array of ACK results
68 ;
69 N DGFS
70 N DGCS
71 N DGRS
72 N DGSS
73 N DGCURLIN
74 ;
75 S DGFS=DGHL("FS")
76 S DGCS=$E(DGHL("ECH"),1)
77 S DGRS=$E(DGHL("ECH"),2)
78 S DGSS=$E(DGHL("ECH"),4)
79 S DGCURLIN=0
80 ;
81 ;loop through the message segments and retrieve the field data
82 F D Q:'DGCURLIN
83 . N DGSEG
84 . S DGCURLIN=$$NXTSEG^DGQEHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)
85 . Q:'DGCURLIN
86 . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGORR)")
87 Q
88 ;
89MSH(DGSEG,DGCS,DGRS,DGSS,DGORR) ;
90 ;
91 ; Input:
92 ; DGSEG - MSH segment field array
93 ; DGCS - HL7 component separator
94 ; DGRS - HL7 repetition separator
95 ; DGSS - HL7 sub-component separator
96 ;
97 ; Output:
98 ; DGORR - array of ACK results
99 ; "SNDFAC" - sending facility
100 ; "RCVFAC" - receiving facility
101 ; "MSGDTM" - message creation date/time in FileMan format
102 ;
103 S DGORR("SNDFAC")=$P($G(DGSEG(4)),DGCS,1)
104 S DGORR("RCVFAC")=$P($G(DGSEG(6)),DGCS,1)
105 S DGORR("MSGDTM")=$$HL7TFM^XLFDT($G(DGSEG(7)))
106 Q
107 ;
108MSA(DGSEG,DGCS,DGRS,DGSS,DGORR) ;
109 ;
110 ; Input:
111 ; DGSEG - MSH segment field array
112 ; DGCS - HL7 component separator
113 ; DGRS - HL7 repetition separator
114 ; DGSS - HL7 sub-component separator
115 ;
116 ; Output:
117 ; DGORR - array of ACK results
118 ; "ACKCODE" - Acknowledgment code
119 ; "MSGID" - Message Control ID of the message being ACK'ed
120 ; "ERR",# - Error field defined on failure
121 ;
122 N DGCNT
123 ;
124 S DGORR("ACKCODE")=$G(DGSEG(1))
125 S DGORR("MSGID")=$G(DGSEG(2))
126 I DGORR("ACKCODE")'="AA",$G(DGSEG(6))]"" D
127 . S DGCNT=$O(DGORR("ERR",""),-1),DGCNT=DGCNT+1
128 . S DGORR("ERR",DGCNT)=$P(DGSEG(6),DGCS,1)
129 Q
130 ;
131SENDBULL(DGLIEN,DGORR) ;build and send error bulletin
132 ;
133 ; Input:
134 ; DGLIEN - IEN of VIC HL7 TRANSMISSION LOG (#39.7)
135 ; DGORR - array of parsed ACK results
136 ; "SNDFAC" - sending facility
137 ; "RCVFAC" - receiving facility
138 ; "MSGDTM" - message creation date/time in FileMan format
139 ; "ACKCODE" - Acknowledgment code
140 ; "MSGID" - Message Control ID of the message being ACK'ed
141 ; "ERR",# - Error field defined on failure
142 ;
143 ; Output:
144 ; none
145 ;
146 N XMB ;name of bulletin and parameter array
147 N XMDUZ ;sending user
148 N XMSUB ;bulletin subject
149 N XMTEXT ;additional text for rejection reasons
150 N DGLOG ;VIC HL7 TRANSMISSION LOG data array
151 N DGREQ ;VIC REQUEST data array
152 ;
153 I +$G(DGLIEN) D
154 . ;
155 . ;retrieve HL7 LOG data
156 . Q:'$$GETLOG^DGQEHLL(DGLIEN,.DGLOG)
157 . ;
158 . ;retrieve VIC REQUEST data
159 . Q:'$$GETREQ^DGQEREQ($G(DGLOG("REQIEN")),.DGREQ)
160 . ;
161 . ;load bulletin params
162 . S XMB(1)=$$FMTE^XLFDT($$NOW^XLFDT())
163 . S XMB(2)=$G(DGREQ("NAME"))
164 . S XMB(3)=$G(DGREQ("CARDID"))
165 . S XMB(4)=$S($G(DGREQ("CPRSTAT"))="P":"Release and print previously held VIC request",1:"Cancel VIC request")
166 . S XMB(5)=$G(DGLOG("HLMID"))
167 . S XMB(6)=$$FMTE^XLFDT($G(DGLOG("XMITDT")))
168 . I $D(DGORR("ERR")) D
169 . . S XMTEXT=$NA(^TMP("DGQEBULL",$J))
170 . . K @XMTEXT
171 . . S @XMTEXT@(1)=" "
172 . . S @XMTEXT@(2)=" Reason(s) for rejection:"
173 . . S DGCNT=0
174 . . F S DGCNT=$O(DGORR("ERR",DGCNT)) Q:'DGCNT D
175 . . . S @XMTEXT@(DGCNT+2)=" #"_DGCNT_":"_" "_DGORR("ERR",DGCNT)
176 . ;
177 . S XMB="DGQE HL7ERR"
178 . S XMDUZ="VIC NCMD HL7 INTERFACE MODULE"
179 . S XMSUB="VIC HL7 ERROR"
180 . D ^XMB
181 . I $G(XMTEXT)]"" K @XMTEXT
182 Q
Note: See TracBrowser for help on using the repository browser.