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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1DGPFHLU5 ;ALB/RPM - PRF HL7 ACK PROCESSING ; 6/21/06 10:18am
2 ;;5.3;Registration;**425,718,650**;Aug 13, 1993;Build 3
3 ;
4 Q
5 ;
6PROCERR(DGLIEN,DGACK,DGERR) ;process errors returned from ACK
7 ;
8 ; Input:
9 ; DGLIEN - IEN of PRF HL7 TRANSMISSION LOG (#26.17) file
10 ; DGACK - array of ACK parse data
11 ; DGERR - array of parsed errors (ex: DGERR(1)=error_code)
12 ;
13 ; Output: none
14 ;
15 N DGPFA ;assignment array
16 N DGPFAH ;assignment history array
17 N DGPFL ;HL7 transmission log array
18 N DGXMTXT ;mailman msg text array
19 ;
20 I +$G(DGLIEN),$D(DGACK),$D(DGERR) D
21 . ;
22 . ;retrieve the HL7 transmission log values
23 . Q:'$$GETLOG^DGPFHLL(DGLIEN,.DGPFL)
24 . ;
25 . ;retrieve assignment history values
26 . Q:'$$GETHIST^DGPFAAH(+$G(DGPFL("ASGNHIST")),.DGPFAH)
27 . ;
28 . ;retransmit and quit if dialog error code "Assignment not found"
29 . I $$FNDDIA(261102,.DGERR) D Q
30 . . ;transmit all assignment records to rejecting site
31 . . Q:'$$XMIT^DGPFLMT5(+$G(DGPFAH("ASSIGN")),$P($G(DGPFL("SITE")),U))
32 . . ;update HL7 transmission log status (RE-TRANSMITTED)
33 . . D STOSTAT^DGPFHLL(26.17,DGLIEN,"RT")
34 . ;
35 . ;retrieve assignment values
36 . Q:'$$GETASGN^DGPFAA(+$G(DGPFAH("ASSIGN")),.DGPFA)
37 . ;
38 . S DGXMTXT=$NA(^TMP("DGPFERR",$J))
39 . K @DGXMTXT
40 . ;
41 . ;create message text array
42 . D BLDMSG(.DGPFA,.DGACK,.DGERR,DGXMTXT)
43 . ;
44 . ;send the notification message
45 . D SEND(DGXMTXT)
46 . ;
47 . ;cleanup
48 . K @DGXMTXT
49 Q
50 ;
51BLDMSG(DGPFA,DGACK,DGERR,DGXMTXT) ;build MailMan message array
52 ;
53 ; Supported DBIA #2171: The supported DBIA is uses to access Kernel
54 ; APIs for retrieving Station numbers and names
55 ; from the INSTITUTION (#4) file.
56 ; Supported DBIA #2701: The supported DBIA is used to access MPI APIs
57 ; for retrieving an ICN for a given DFN.
58 ;
59 ; Input:
60 ; DGPFA - assignment data array
61 ; DGACK - array of ACK data
62 ; DGERR - array of parsed errors (ex: DGERR(1)=error_code)
63 ;
64 ; Output:
65 ; DGXMTXT - array of MailMan text lines
66 ;
67 N DGCNT ;error count
68 N DGCOD ;error code
69 N DGDEM ;patient demographics array
70 N DGDFN ;pointer to PATIENT (#2) file
71 N DGDLG ;DIALOG array
72 N DGFAC ;facility data array from XUAF4 call
73 N DGI ;generic counter
74 N DGICN ;integrated control number
75 N DGLIN ;line counter
76 N DGMAX ;maximum line length
77 N DGSITE ;results of VASITE call
78 N DGSNDSTA ;sending station number
79 N DGSNDNAM ;sending station name
80 N DGTBL ;error code table array
81 ;
82 S DGDFN=+$G(DGPFA("DFN"))
83 Q:(DGDFN'>0)
84 ;
85 ;retrieve patient demographics
86 Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM)
87 S DGICN=$$GETICN^MPIF001(DGDFN)
88 S DGICN=$S(+DGICN>0:DGICN,1:$P(DGICN,U,2))
89 ;
90 ;load error code table
91 D BLDVA086^DGPFHLU3(.DGTBL)
92 ;
93 S DGLIN=0
94 S DGMAX=65
95 S DGSITE=$$SITE^VASITE()
96 S DGSNDSTA=$G(DGACK("SNDFAC"))
97 D F4^XUAF4(DGSNDSTA,.DGFAC,"","")
98 S DGSNDNAM=$S(DGFAC>0:$G(DGFAC("NAME")),1:"")
99 ;
100 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
101 D ADDLINE("* * * * P R F H L 7 E R R O R E N C O U N T E R E D * * * *",0,DGMAX,.DGLIN,DGXMTXT)
102 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
103 D ADDLINE("A facility could not process the following Patient Record Flag assignment on "_$$FMTE^XLFDT($G(DGACK("MSGDTM")))_".",0,DGMAX,.DGLIN,DGXMTXT)
104 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
105 D ADDLINE("Message Control ID#: "_$G(DGACK("MSGID")),4,DGMAX,.DGLIN,DGXMTXT)
106 D ADDLINE("Receiving Facility name: "_DGSNDNAM_" ("_DGSNDSTA_")",0,DGMAX,.DGLIN,DGXMTXT)
107 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
108 D ADDLINE("Flag Name: "_$P($G(DGPFA("FLAG")),U,2),14,DGMAX,.DGLIN,DGXMTXT)
109 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
110 D ADDLINE("Patient Name: "_DGDEM("NAME"),11,DGMAX,.DGLIN,DGXMTXT)
111 D ADDLINE("Social Security #: "_DGDEM("SSN"),6,DGMAX,.DGLIN,DGXMTXT)
112 D ADDLINE("Date of Birth: "_$$FMTE^XLFDT(DGDEM("DOB"),"2D"),10,DGMAX,.DGLIN,DGXMTXT)
113 D ADDLINE("Integrated Control #: "_DGICN,3,DGMAX,.DGLIN,DGXMTXT)
114 D ADDLINE("Owning Site: "_$P($G(DGPFA("OWNER")),U,2)_" ("_$$STA^XUAF4($P($G(DGPFA("OWNER")),U))_")",12,DGMAX,.DGLIN,DGXMTXT)
115 D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
116 ;
117 ;loop through each error
118 S DGCNT=0
119 F S DGCNT=$O(DGERR(DGCNT)) Q:'DGCNT D
120 . K DGDLG
121 . S DGCOD=DGERR(DGCNT)
122 . ;
123 . ;assume numeric error code is a DIALOG
124 . I DGCOD?1N.N D BLD^DIALOG(DGCOD,"","","DGDLG","S")
125 . I $D(DGDLG) D FORMAT^DGPFLMT4(.DGDLG,DGMAX-12)
126 . ;
127 . ;if not a DIALOG, then is it a table entry?
128 . I '$D(DGDLG),DGCOD]"",$D(DGTBL(DGCOD,"DESC")) S DGDLG(1)=DGTBL(DGCOD,"DESC")
129 . ;
130 . ;not a DIALOG or table entry - then error is unknown
131 . I '$D(DGDLG) S DGDLG(1)="Unknown Error code: '"_DGCOD_"'"
132 . ;
133 . ;error header
134 . D ADDLINE("Reason#: "_DGCNT,0,DGMAX,.DGLIN,DGXMTXT)
135 . ;
136 . ;loop through error text array
137 . S DGI=0
138 . F S DGI=$O(DGDLG(DGI)) Q:'DGI D
139 . . D ADDLINE(DGDLG(DGI),12,DGMAX,.DGLIN,DGXMTXT)
140 . ;
141 . ;error separator
142 . D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
143 ;
144 Q
145 ;
146ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array
147 ;
148 ; Input:
149 ; DGTEXT - text string
150 ; DGINDENT - number of spaces to insert at start of line
151 ; DGMAXLEN - maximum desired line length (default: 60)
152 ; DGCNT - line number passed by reference
153 ;
154 ; Output:
155 ; DGXMTXT - array of text strings
156 ;
157 N DGAVAIL ;available space for text
158 N DGLINE ;truncated text
159 N DGLOC ;location of space character
160 N DGPAD ;space indent
161 ;
162 S DGTEXT=$G(DGTEXT)
163 S DGINDENT=+$G(DGINDENT)
164 S DGMAXLEN=+$G(DGMAXLEN)
165 S:'DGMAXLEN DGMAXLEN=60
166 I DGINDENT>(DGMAXLEN-1) S DGINDENT=0
167 S DGCNT=$G(DGCNT,0) ;default to 0
168 ;
169 S DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT)
170 ;
171 ;determine available space for text
172 S DGAVAIL=(DGMAXLEN-DGINDENT)
173 F D Q:('$L(DGTEXT))
174 . ;
175 . ;find potential line break
176 . S DGLOC=$L($E(DGTEXT,1,DGAVAIL)," ")
177 . ;
178 . ;break a line that is too long when it has potential line breaks
179 . I $L(DGTEXT)>DGAVAIL,DGLOC D
180 . . S DGLINE=$P(DGTEXT," ",1,$S(DGLOC>1:DGLOC-1,1:1))
181 . . S DGTEXT=$P(DGTEXT," ",$S(DGLOC>1:DGLOC,1:DGLOC+1),$L(DGTEXT," "))
182 . E D
183 . . S DGLINE=DGTEXT,DGTEXT=""
184 . ;
185 . S DGCNT=DGCNT+1
186 . S @DGXMTXT@(DGCNT)=DGPAD_DGLINE
187 Q
188 ;
189SEND(DGXMTXT) ;send the MailMan message
190 ;
191 ; Input:
192 ; DGXMTXT - name of message text array in closed format
193 ;
194 ; Output:
195 ; none
196 ;
197 N DIFROM ;protect FM package
198 N XMDUZ ;sender
199 N XMSUB ;message subject
200 N XMTEXT ;name of message text array in open format
201 N XMY ;recipient array
202 N XMZ ;returned message number
203 ;
204 S XMDUZ="Patient Record Flag Module"
205 S XMSUB="PRF MESSAGE TRANSMISSION ERROR"
206 S XMTEXT=$$OREF^DILF(DGXMTXT)
207 S XMY("G.DGPF HL7 TRANSMISSION ERRORS")=""
208 D ^XMD
209 Q
210 ;
211FNDDIA(DGDIA,DGERR) ;find dialog code
212 ;This function searches an array for a specific DIALOG (#.84) code.
213 ;
214 ; Input: (required)
215 ; DGDIA - dialog error code
216 ; DGERR - array of parsed errors (ex: DGERR(1)=error_code)
217 ;
218 ; Output:
219 ; Function value - 1 on success; 0 on failure
220 ;
221 N DGI ;generic counter
222 N DGRSLT ;function value
223 S (DGI,DGRSLT)=0
224 ;
225 I +$G(DGDIA),$D(DGERR) D
226 . F S DGI=$O(DGERR(DGI)) Q:'DGI D Q:DGRSLT
227 . . I $G(DGERR(DGI))=DGDIA S DGRSLT=1
228 ;
229 Q DGRSLT
Note: See TracBrowser for help on using the repository browser.