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

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1DGPFHLU4 ;ALB/RPM - PRF HL7 ACK PROCESSING ; 3/04/03
2 ;;5.3;Registration;**425**;Aug 13, 1993
3 ;
4BLDACK(DGACK,DGROOT,DGHL,DGSEGERR,DGSTOERR) ;Build ACK Message/Segments
5 ;
6 ; Input:
7 ; DGACK - (required) Acknowledment code
8 ; DGROOT - (required) Segment array name
9 ; DGHL - (required) HL7 environment array
10 ; DGSEGERR - (optional) defined only if errors during parsing
11 ; DGSTOERR - (optional) defined only if errors during filing
12 ;
13 ; Output:
14 ; Function Value - 1 on success, 0 on failure
15 ; ^TMP("HLA",$J) - Array of ACK segments
16 ;
17 N DGCNT ;segment counter
18 N DGMSA ;formatted MSA segment
19 N DGRSLT ;function value
20 ;
21 S DGRSLT=0
22 I $G(DGACK)]"",$G(DGROOT)]"" D
23 . S DGCNT=0
24 . ;
25 . ;build MSA segment
26 . S DGMSA=$$MSA^DGPFHLU3(DGACK,DGHL("MID"),.DGSTOERR,"1,2",.DGHL)
27 . Q:(DGMSA="")
28 . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGMSA
29 . ;
30 . ;build ERR segments
31 . Q:($D(DGSEGERR)&('$$BLDERR(DGROOT,.DGSEGERR,.DGHL,.DGCNT)))
32 . ;
33 . ;success
34 . S DGRSLT=1
35 Q DGRSLT
36 ;
37PARSACK(DGWRK,DGHL,DGACK,DGMSG) ;Parse ACK Message/Segments
38 ;
39 ; Input:
40 ; DGWRK - Closed root work global reference
41 ; DGHL - HL7 environment array
42 ;
43 ; Output:
44 ; DGACK - array of ACK results
45 ; DGMSG - undefined on success, array of MailMan text on failure
46 ;
47 N DGFS
48 N DGCS
49 N DGRS
50 N DGSS
51 N DGCURLIN
52 ;
53 S DGFS=DGHL("FS")
54 S DGCS=$E(DGHL("ECH"),1)
55 S DGRS=$E(DGHL("ECH"),2)
56 S DGSS=$E(DGHL("ECH"),4)
57 S DGCURLIN=0
58 ;
59 ;loop through the message segments and retrieve the field data
60 F D Q:'DGCURLIN
61 . N DGSEG
62 . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)
63 . Q:'DGCURLIN
64 . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGACK,.DGMSG)")
65 Q
66 ;
67MSH(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ;
68 ;
69 ; Input:
70 ; DGSEG - MSH segment field array
71 ; DGCS - HL7 component separator
72 ; DGRS - HL7 repetition separator
73 ; DGSS - HL7 sub-component separator
74 ;
75 ; Output:
76 ; DGACK - array of ACK results
77 ; "SNDFAC" - sending facility
78 ; "RCVFAC" - receiving facility
79 ; "MSGDTM" - message creation date/time in FileMan format
80 ; DGERR - undefined on success, error array on failure
81 ;
82 S DGACK("SNDFAC")=$P($G(DGSEG(4)),DGCS,1)
83 S DGACK("RCVFAC")=$P($G(DGSEG(6)),DGCS,1)
84 S DGACK("MSGDTM")=$$HL7TFM^XLFDT($G(DGSEG(7)))
85 Q
86 ;
87MSA(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ;
88 ;
89 ; Input:
90 ; DGSEG - MSH segment field array
91 ; DGCS - HL7 component separator
92 ; DGRS - HL7 repetition separator
93 ; DGSS - HL7 sub-component separator
94 ;
95 ; Output:
96 ; DGACK - array of ACK results
97 ; "ACKCODE" - Acknowledgment code
98 ; "MSGID" - Message Control ID of the message being ACK'ed
99 ; DGERR - undefined on success, error array on failure
100 ;
101 N DGCNT
102 ;
103 S DGACK("ACKCODE")=$G(DGSEG(1))
104 S DGACK("MSGID")=$G(DGSEG(2))
105 I DGACK("ACKCODE")'="AA",$G(DGSEG(6))]"" D
106 . S DGCNT=$O(DGERR(""),-1),DGCNT=DGCNT+1
107 . S DGERR(DGCNT)=$P(DGSEG(6),DGCS,1)
108 Q
109 ;
110ERR(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ;
111 ;
112 ; Input:
113 ; DGSEG - MSH segment field array
114 ; DGCS - HL7 component separator
115 ; DGRS - HL7 repetition separator
116 ; DGSS - HL7 sub-component separator
117 ;
118 ; Output:
119 ; DGACK - array of ACK results
120 ; DGERR - undefined on success, error array on failure
121 ;
122 N DGCNT
123 N DGCOD
124 ;
125 I $G(DGSEG(1))]"" D
126 . S DGCOD=$P($P(DGSEG(1),DGCS,4),DGSS,1)
127 . I DGCOD]"" D
128 . . S DGCNT=$O(DGERR(""),-1),DGCNT=DGCNT+1
129 . . S DGERR(DGCNT)=DGCOD
130 Q
131 ;
132BLDERR(DGROOT,DGSEGERR,DGHL,DGCNT) ;build all ERR segments
133 ;This function builds a formatted ERR segment for each entry in the
134 ;segment error array (DGSEGERR).
135 ;
136 ; Input:
137 ; DGROOT - (required) Closed root array or global name for segment
138 ; storage
139 ; DGSEGERR - (required) Array of segment errors
140 ; Format: DGSEGERR(segment name,sequence,field)=error code
141 ; DGHL - (required) VistA HL7 environment array
142 ; DGCNT - (optional) Previous segment # in DGROOT
143 ;
144 ; Output:
145 ; Function Value - 1 on success, 0 on failure
146 ;
147 N DGCOD ;error code
148 N DGERR ;formatted ERR segment
149 N DGPOS ;field positions containing error
150 N DGSEG ;segment name containing error
151 N DGSEQ ;sequence of segment containing error
152 N DGRSLT ;function value
153 ;
154 S DGRSLT=0
155 I $G(DGROOT)]"",$D(DGSEGERR) D
156 . S DGCNT=$G(DGCNT,0)
157 . S DGSEG=""
158 . F S DGSEG=$O(DGSEGERR(DGSEG)) Q:(DGSEG="") D Q:(DGERR="")
159 . . S DGSEQ=0
160 . . F S DGSEQ=$O(DGSEGERR(DGSEG,DGSEQ)) Q:'DGSEQ D Q:(DGERR="")
161 . . . S DGPOS=0
162 . . . F S DGPOS=$O(DGSEGERR(DGSEG,DGSEQ,DGPOS)) Q:'DGPOS D Q:(DGERR="")
163 . . . . S DGCOD=DGSEGERR(DGSEG,DGSEQ,DGPOS)
164 . . . . S DGERR=$$ERR^DGPFHLU3(DGSEG,DGSEQ,DGPOS,DGCOD,"1",.DGHL)
165 . . . . Q:(DGERR="")
166 . . . . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGERR
167 . Q:(DGERR="")
168 . S DGRSLT=1
169 Q DGRSLT
Note: See TracBrowser for help on using the repository browser.