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

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

initial load of WorldVistAEHR

File size: 4.3 KB
RevLine 
[613]1DGQEACK ;ALB/JFP - Process VIC ACK message (Batch/Single) ; 09/01/96
2 ;;V5.3;REGISTRATION;**73**;DEC 11,1996
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine will process both single and batch acknowledgements
6 ; Format of HL7 message:
7 ;
8 ; -- Batch Single
9 ; BHS MSH
10 ; [MSH MSA
11 ; MSA]
12 ; BTS
13 ;Note: This code does not handle the optional ERR segment
14 ;
15 ;Input : All variables set by HL7 package
16 ;Output :
17 ;
18EN ; - entry point to process HL7 ACK message
19 ; -- Declare variables
20 N EXCARR,DGQESEG,BCID,MCID,HLMSG,ACKCODE
21 N REFFLG,DELFLG,DGQEND,J,I,X
22 N REASON,DGQEMSG,DONE
23 ;
24 ; -- define exception array
25 S EXCARR="^TMP(""DGQE-ACK"","_$J_",""EXC"")"
26 K @EXCARR
27 ;
28 I '$D(HL("FS")) S HL("FS")="^"
29 S HLFS=HL("FS")
30 S (HLMSG,DONE)=0
31BLD ; -- Builds HL7 message text for error processing
32 D BLDMSG
33START ; -- Get first segment
34 D NEXT Q:DONE
35 ; -- Check for header message (BHS or MSH)
36 I DGQESEG="MSH" D SINGLE Q
37 I DGQESEG="BHS" D BATCH Q
38 ; -- Wrong segment
39 S HLMSG="-1^Missing BHS or MSH segment on ACK, segment received was: "_DGQESEG
40 D NOTIFY(HLMSG)
41 Q
42 ;
43SINGLE ; -- Parse single ACK message
44 D NEXT Q:DONE
45 D MSA
46 ; -- Delete entry from 39.4, acknowledged
47 S:MCID'="" DELFLG=$$DEL^DGQEHL74(MCID)
48 K @EXCARR
49 Q
50 ;
51BATCH ; -- Parse batch ACK message
52 ; -- get batch control ID from BHS segment
53 S BCID=$P(DGQEND,HLFS,11)
54 ; -- get next segment
55 D NEXT Q:DONE
56 ; -- Check to see if all entries in batch successful
57 I DGQESEG="BTS" D DELACK Q
58 I DGQESEG'="MSH" D Q
59 .S HLMSG="-1^Missing MSH or BTS segment in processing ACK, segment received was: "_DGQESEG
60 .D NOTIFY(HLMSG)
61 .D DELACK
62 ; -- otherwise process exception batch
63 D EXC
64 ; -- Delete all transactions in batch
65 D DELACK
66 K @EXCARR
67 Q
68 ;
69EXC ; -- Processes of exceptions in batch ACK
70 D MSH Q:DONE
71 D NEXT Q:DONE
72 D MSA Q:DONE
73 ; -- Loop through remaining entries
74 F D NEXT D Q:DONE
75 .Q:DONE
76 .I DGQESEG="BTS" S DONE=1 Q
77 .D MSH Q:DONE
78 .D NEXT Q:DONE
79 .D MSA Q:DONE
80 Q
81 ;
82MSH ; -- Process MSH segment
83 I DGQESEG'="MSH" D Q
84 .S HLMSG="-1^Missing MSH segment on ACK, segment received was: "_DGQESEG
85 .D NOTIFY(HLMSG)
86 .S DONE=1
87 Q
88 ;
89MSA ; -- Process MSA segment
90 I DGQESEG'="MSA" D Q
91 .S HLMSG="-1^Missing MSA segment on ACK, segment received was: "_DGQESEG
92 .D NOTIFY(HLMSG)
93 .S DONE=1
94 ; -- Extract Segment MSA segment Data
95 S ACKCODE=$P(DGQEND,HLFS,1)
96 S MCID=$P(DGQEND,HLFS,2)
97 ; -- Check for error
98 I ACKCODE'="AA" D Q
99 .S @EXCARR@(MCID)=""
100 .S REASON="-1^"_$P(DGQEND,HLFS,3)
101 .S REFFLG=$$REJ^DGQEHL74(MCID,"1",REASON)
102 .D NOTIFY(REASON)
103 Q
104 ;
105DELACK ; -- Deletes all entries from 39.4, related to message ID
106 Q:BCID=""
107 N ID
108 S ID=BCID_"-0"
109 F S ID=$O(^VAT(39.4,"B",ID)) Q:$P(ID,"-")'=BCID D
110 .S:ID'="" DELFLG=$$DEL^DGQEHL74(ID)
111 Q
112 ;
113NEXT ; -- Gets the next HL7 segment to process
114 S (DGQESEG,DGQEND)=""
115 X HLNEXT
116 I HLQUIT'>0 S DONE=1 Q
117 S DGQEND=HLNODE
118 ; -- Check for segment lengths greater than 245
119 I $D(HLNODE(1)) D
120 .S J=0
121 .F S J=$O(HLNODE(J)) Q:'J S DGQEND=DGQEND_HLNODE(J)
122 ; -- Pull off segment
123 S DGQESEG=$E(DGQEND,1,3)
124 S DGQEND=$P(DGQEND,HLFS,2,9999)
125 Q
126 ;
127BLDMSG ; -- GET MESSAGE TEXT
128 F I=1:1 X HLNEXT Q:(HLQUIT'>0) D
129 .S DGQEMSG(I,1)=HLNODE
130 .; -- Check for segment lengths greater than 245
131 .S X=0 F S X=+$O(HLNODE(X)) Q:('X) S DGQEMSG(I,(X+1))=HLNODE(X)
132 Q
133 ;
134NOTIFY(REASON) ; -- Sends error bulletin on negative acknowledgment
135 ;Input: REASON - problem with acknowledgment
136 ; DGQEMSG() - Array containing HL7 message that was received
137 ;Output: None
138 ;
139 ; -- Check input, reason in piece 2
140 Q:'$D(REASON)
141 S REASON=$P($G(REASON),"^",2)
142 ; -- Declare variables
143 N MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ,LINE
144 ; -- Send message text
145 S MSGTXT(1)="Acknowledgment received from photo capture station"
146 S MSGTXT(2)="with the following problem:"
147 S MSGTXT(3)=" "
148 S MSGTXT(4)=" ** "_REASON
149 ; -- Check to see if hl7 message is available for display
150 N X,Y
151 I $D(DGQEMSG(1)) D
152 .S MSGTXT(5)=" "
153 .S MSGTXT(6)="The message received looks like this: "
154 .S MSGTXT(7)=" "
155 .S LINE=8,X=0
156 .F S X=+$O(DGQEMSG(X)) Q:('X) D
157 ..S Y=0
158 ..F S Y=+$O(DGQEMSG(X,Y)) Q:('Y) D
159 ...S MSGTXT(LINE)=DGQEMSG(X,Y)
160 ...S LINE=LINE+1
161 ; -- Send bulletin subject
162 S XMB(1)="** Problem with ACK for VIC **"
163 ; -- Deliver bulletin
164 S XMB="DGQE PHOTO CAPTURE"
165 S XMTEXT="MSGTXT("
166 D ^XMB
167 Q
168 ;
169END ; -- End of code
170 Q
Note: See TracBrowser for help on using the repository browser.