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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1DGPFHLL ;ALB/RPM - PRF HL7 TRANSMISSION LOG API'S ; 3/6/03
2 ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
3 ;
4 Q
5 ;
6GETLOG(DGLIEN,DGPFL) ;retrieve a transmission log record
7 ;
8 ; Input:
9 ; DGLIEN - IEN for PRF HL7 TRANSMISSION LOG (#26.17) file
10 ;
11 ; Output:
12 ; Function value - 1 on success, 0 on failure
13 ; DGPFL - array of transmission data fields
14 ; Subscript Field#
15 ; ---------- ------
16 ; "MSGID" .01
17 ; "ASGNHIST" .02
18 ; "TRANSDT" .03
19 ; "MSGSTAT" .04
20 ; "SITE" .05
21 ; "ACKDT" .06
22 ; "ERROR",n .07
23 ;
24 N DGIENS ;IEN string
25 N DGFLDS ;results array
26 N DGECNT ;error counter
27 N DGERR ;error arrary
28 N DGRSLT ;function value
29 ;
30 S DGRSLT=0
31 I $G(DGLIEN)>0,$D(^DGPF(26.17,DGLIEN)) D
32 . S DGIENS=DGLIEN_","
33 . D GETS^DIQ(26.17,DGIENS,"**","IEZ","DGFLDS","DGERR")
34 . Q:$D(DGERR)
35 . S DGRSLT=1
36 . S DGPFL("MSGID")=$G(DGFLDS(26.17,DGIENS,.01,"I"))_U_$G(DGFLDS(26.17,DGIENS,.01,"E"))
37 . S DGPFL("ASGNHIST")=$G(DGFLDS(26.17,DGIENS,.02,"I"))_U_$G(DGFLDS(26.17,DGIENS,.02,"E"))
38 . S DGPFL("TRANSDT")=$G(DGFLDS(26.17,DGIENS,.03,"I"))_U_$G(DGFLDS(26.17,DGIENS,.03,"E"))
39 . S DGPFL("MSGSTAT")=$G(DGFLDS(26.17,DGIENS,.04,"I"))_U_$G(DGFLDS(26.17,DGIENS,.04,"E"))
40 . S DGPFL("SITE")=$G(DGFLDS(26.17,DGIENS,.05,"I"))_U_$G(DGFLDS(26.17,DGIENS,.05,"E"))
41 . S DGPFL("ACKDT")=$G(DGFLDS(26.17,DGIENS,.06,"I"))_U_$G(DGFLDS(26.17,DGIENS,.06,"E"))
42 . ;
43 . ;build error code array
44 . S DGIENS="",DGECNT=0
45 . F S DGIENS=$O(DGFLDS(26.1707,DGIENS)) Q:DGIENS="" D:$G(DGFLDS(26.1707,DGIENS,.01,"E"))]""
46 . . S DGECNT=DGECNT+1
47 . . S DGPFL("ERROR",DGECNT)=DGFLDS(26.1707,DGIENS,.01,"E")
48 ;
49 Q DGRSLT
50 ;
51GETQLOG(DGLIEN,DGPFL) ;retrieve a query log record
52 ;
53 ; Input:
54 ; DGLIEN - IEN for PRF HL7 QUERY LOG (#26.19) file
55 ;
56 ; Output:
57 ; Function value - 1 on success, 0 on failure
58 ; DGPFL - array of transmission data fields
59 ; Subscript Field#
60 ; --------- ------
61 ; "MSGID" .01
62 ; "EVNT" .02
63 ; "TRANSDT" .03
64 ; "MSGSTAT" .04
65 ; "SITE" .05
66 ; "ACKDT" .06
67 ; "ERROR",n .07
68 ;
69 N DGIENS ;IEN string
70 N DGFLDS ;results array
71 N DGECNT ;error counter
72 N DGERR ;error arrary
73 N DGRSLT ;function value
74 ;
75 S DGRSLT=0
76 I $G(DGLIEN)>0,$D(^DGPF(26.19,DGLIEN)) D
77 . S DGIENS=DGLIEN_","
78 . D GETS^DIQ(26.19,DGIENS,"**","IEZ","DGFLDS","DGERR")
79 . Q:$D(DGERR)
80 . S DGRSLT=1
81 . S DGPFL("MSGID")=$G(DGFLDS(26.19,DGIENS,.01,"I"))_U_$G(DGFLDS(26.19,DGIENS,.01,"E"))
82 . S DGPFL("EVNT")=$G(DGFLDS(26.19,DGIENS,.02,"I"))_U_$G(DGFLDS(26.19,DGIENS,.02,"E"))
83 . S DGPFL("TRANSDT")=$G(DGFLDS(26.19,DGIENS,.03,"I"))_U_$G(DGFLDS(26.19,DGIENS,.03,"E"))
84 . S DGPFL("MSGSTAT")=$G(DGFLDS(26.19,DGIENS,.04,"I"))_U_$G(DGFLDS(26.19,DGIENS,.04,"E"))
85 . S DGPFL("SITE")=$G(DGFLDS(26.19,DGIENS,.05,"I"))_U_$G(DGFLDS(26.19,DGIENS,.05,"E"))
86 . S DGPFL("ACKDT")=$G(DGFLDS(26.19,DGIENS,.06,"I"))_U_$G(DGFLDS(26.19,DGIENS,.06,"E"))
87 . ;
88 . ;build error code array
89 . S DGIENS="",DGECNT=0
90 . F S DGIENS=$O(DGFLDS(26.1907,DGIENS)) Q:DGIENS="" D:$G(DGFLDS(26.1907,DGIENS,.01,"E"))]""
91 . . S DGECNT=DGECNT+1
92 . . S DGPFL("ERROR",DGECNT)=DGFLDS(26.1907,DGIENS,.01,"E")
93 ;
94 Q DGRSLT
95 ;
96FNDLOG(DGFILE,DGMSGID) ;find and return the record number from a given HL7
97 ; LOG file for a given HL7 Message ID
98 ;
99 ; Input:
100 ; DGFILE - file number of HL7 log file
101 ; DGMSGID - HL7 Message ID
102 ;
103 ; Output:
104 ; Function value - IEN of HL7 LOG file on success, 0 on failure
105 ;
106 N DGIEN ;function value
107 ;
108 I +$G(DGFILE),+$G(DGMSGID) D
109 . S DGIEN=$O(^DGPF(DGFILE,"B",DGMSGID,0))
110 Q $S($G(DGIEN)>0:DGIEN,1:0)
111 ;
112STOXMIT(DGHIEN,DGMSGID,DGINST,DGERR) ;store the transmission log data
113 ;
114 ; Input:
115 ; DGHIEN - pointer to PRF ASSIGNMENT HISTORY (#26.14) file
116 ; DGMSGID - message ID from VistA HL7
117 ; DGINST - pointer to the INSTITUTION (#4) file
118 ;
119 ; Output:
120 ; DGERR - undefined on success, error message on failure
121 ;
122 N DGFDA ;fda array
123 N DGFDAIEN ;UPDATE^DIE ien result
124 ;
125 I +$G(DGHIEN),$D(^DGPF(26.14,DGHIEN)),$D(DGMSGID),+$G(DGINST),$D(^DIC(4,DGINST)) D
126 . Q:$$FNDLOG^DGPFHLL(26.17,DGMSGID)
127 . S DGFDA(26.17,"+1,",.01)=DGMSGID
128 . S DGFDA(26.17,"+1,",.02)=DGHIEN
129 . S DGFDA(26.17,"+1,",.03)=$$NOW^XLFDT()
130 . S DGFDA(26.17,"+1,",.04)="T"
131 . S DGFDA(26.17,"+1,",.05)=DGINST
132 . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
133 Q
134 ;
135STOQXMIT(DGEVNT,DGMSGID,DGINST,DGERR) ;store the query log data
136 ;
137 ; Input:
138 ; DGEVNT - pointer to PRF event in PRF HL7 EVENT (#26.21) file
139 ; DGMSGID - message ID from VistA HL7
140 ; DGINST - pointer to the INSTITUTION (#4) file
141 ;
142 ; Output:
143 ; DGERR - undefined on success, error message on failure
144 ;
145 N DGFDA ;fda array
146 N DGFDAIEN ;UPDATE^DIE ien result
147 ;
148 I +$G(DGEVNT),$D(DGMSGID),+$G(DGINST),$D(^DIC(4,DGINST)) D
149 . Q:$$FNDLOG^DGPFHLL(26.19,DGMSGID)
150 . S DGFDA(26.19,"+1,",.01)=DGMSGID
151 . S DGFDA(26.19,"+1,",.02)=DGEVNT
152 . S DGFDA(26.19,"+1,",.03)=$$NOW^XLFDT()
153 . S DGFDA(26.19,"+1,",.04)="T"
154 . S DGFDA(26.19,"+1,",.05)=DGINST
155 . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
156 Q
157 ;
158STOSTAT(DGFILE,DGLIEN,DGSTAT,DGEARR) ;update the HL7 transmission status
159 ;
160 ; Input:
161 ; DGFILE - file number of HL7 LOG file
162 ; DGLIEN - IEN of selected HL7 LOG file
163 ; DGSTAT - internal Status value
164 ; DGEARR - (optional) array of error message codes
165 ; format: DGEARR(n)=error code
166 ;
167 ; Output:
168 ; none
169 ;
170 N DGERR ;filer errors
171 N DGFDA ;fda array
172 N DGI ;generic index
173 N DGLIENS ;iens string
174 ;
175 I $G(DGFILE)]"",+$G(DGLIEN),$D(^DGPF(DGFILE,DGLIEN)),$G(DGSTAT)]"" D
176 . Q:'$$TESTVAL^DGPFUT(DGFILE,.04,DGSTAT)
177 . S DGLIENS=DGLIEN_","
178 . S DGFDA(DGFILE,DGLIENS,.04)=DGSTAT
179 . S DGFDA(DGFILE,DGLIENS,.06)=$$NOW^XLFDT()
180 . S DGI=0
181 . F S DGI=$O(DGEARR(DGI)) Q:'DGI I DGEARR(DGI)]"" D
182 . . S DGFDA(DGFILE_"07","+"_DGI_","_DGLIEN_",",.01)=DGEARR(DGI)
183 . D UPDATE^DIE("","DGFDA","","DGERR")
184 Q
185 ;
186GETLSQ(DGEVNT) ;get last site queried
187 ;
188 ; Input:
189 ; DGEVNT - pointer to PRF HL7 EVENT (#26.21) file
190 ;
191 ; Output:
192 ; Function value - last site queried as pointer to INSTITUTION (#4)
193 ; file on success; 0 on failure
194 ;
195 N DGARR ;array of query sites sorted by date
196 N DGLIEN ;pointer to PRF HL7 QUERY LOG (#26.19)
197 N DGLOG ;query log data array
198 ;
199 S DGLIEN=0
200 S DGEVNT=+$G(DGEVNT)
201 F S DGLIEN=$O(^DGPF(26.19,"C",DGEVNT,DGLIEN)) Q:'DGLIEN D
202 . K DGLOG
203 . Q:'$$GETQLOG(DGLIEN,.DGLOG)
204 . I +$G(DGLOG("TRANSDT"))>0,+$G(DGLOG("SITE"))>0 S DGARR(+$G(DGLOG("TRANSDT")))=+$G(DGLOG("SITE"))
205 Q +$G(DGARR(+$O(DGARR(""),-1)))
206 ;
207PRGQLOG(DGEVNT) ;purge PRF Query Log entries
208 ;This procedure purges non-Accepted entries in the PRF HL7 QUERY LOG
209 ;(#26.19) file for a given PRF HL7 EVENT.
210 ;
211 ; Input:
212 ; DGEVNT - pointer to PRF HL7 EVENT (#26.21) file
213 ;
214 ; Output: none
215 ;
216 N DGERR ;FM error array
217 N DGFDA ;FM FDA array
218 N DGLIEN ;PRF HL7 QUERY LOG (#26.19) file IEN
219 N DGSTAT ;transmission status
220 ;
221 S DGEVNT=+$G(DGEVNT)
222 S DGLIEN=0
223 ;
224 F S DGLIEN=$O(^DGPF(26.19,"C",DGEVNT,DGLIEN)) Q:'DGLIEN D
225 . K DGFDA,DGERR
226 . S DGSTAT=$$GET1^DIQ(26.19,DGLIEN_",",.04,"I","","DGERR")
227 . ;
228 . Q:$E(DGSTAT)="A" ;don't purge "A" or "AN" status entries
229 . ;
230 . S DGFDA(26.19,DGLIEN_",",.01)="@"
231 . D FILE^DIE("","DGFDA","DGERR")
232 ;
233 Q
Note: See TracBrowser for help on using the repository browser.