230 lines
6.9 KiB
Mathematica
230 lines
6.9 KiB
Mathematica
DGPFHLU5 ;ALB/RPM - PRF HL7 ACK PROCESSING ; 6/21/06 10:18am
|
|
;;5.3;Registration;**425,718,650**;Aug 13, 1993;Build 3
|
|
;
|
|
Q
|
|
;
|
|
PROCERR(DGLIEN,DGACK,DGERR) ;process errors returned from ACK
|
|
;
|
|
; Input:
|
|
; DGLIEN - IEN of PRF HL7 TRANSMISSION LOG (#26.17) file
|
|
; DGACK - array of ACK parse data
|
|
; DGERR - array of parsed errors (ex: DGERR(1)=error_code)
|
|
;
|
|
; Output: none
|
|
;
|
|
N DGPFA ;assignment array
|
|
N DGPFAH ;assignment history array
|
|
N DGPFL ;HL7 transmission log array
|
|
N DGXMTXT ;mailman msg text array
|
|
;
|
|
I +$G(DGLIEN),$D(DGACK),$D(DGERR) D
|
|
. ;
|
|
. ;retrieve the HL7 transmission log values
|
|
. Q:'$$GETLOG^DGPFHLL(DGLIEN,.DGPFL)
|
|
. ;
|
|
. ;retrieve assignment history values
|
|
. Q:'$$GETHIST^DGPFAAH(+$G(DGPFL("ASGNHIST")),.DGPFAH)
|
|
. ;
|
|
. ;retransmit and quit if dialog error code "Assignment not found"
|
|
. I $$FNDDIA(261102,.DGERR) D Q
|
|
. . ;transmit all assignment records to rejecting site
|
|
. . Q:'$$XMIT^DGPFLMT5(+$G(DGPFAH("ASSIGN")),$P($G(DGPFL("SITE")),U))
|
|
. . ;update HL7 transmission log status (RE-TRANSMITTED)
|
|
. . D STOSTAT^DGPFHLL(26.17,DGLIEN,"RT")
|
|
. ;
|
|
. ;retrieve assignment values
|
|
. Q:'$$GETASGN^DGPFAA(+$G(DGPFAH("ASSIGN")),.DGPFA)
|
|
. ;
|
|
. S DGXMTXT=$NA(^TMP("DGPFERR",$J))
|
|
. K @DGXMTXT
|
|
. ;
|
|
. ;create message text array
|
|
. D BLDMSG(.DGPFA,.DGACK,.DGERR,DGXMTXT)
|
|
. ;
|
|
. ;send the notification message
|
|
. D SEND(DGXMTXT)
|
|
. ;
|
|
. ;cleanup
|
|
. K @DGXMTXT
|
|
Q
|
|
;
|
|
BLDMSG(DGPFA,DGACK,DGERR,DGXMTXT) ;build MailMan message array
|
|
;
|
|
; Supported DBIA #2171: The supported DBIA is uses to access Kernel
|
|
; APIs for retrieving Station numbers and names
|
|
; from the INSTITUTION (#4) file.
|
|
; Supported DBIA #2701: The supported DBIA is used to access MPI APIs
|
|
; for retrieving an ICN for a given DFN.
|
|
;
|
|
; Input:
|
|
; DGPFA - assignment data array
|
|
; DGACK - array of ACK data
|
|
; DGERR - array of parsed errors (ex: DGERR(1)=error_code)
|
|
;
|
|
; Output:
|
|
; DGXMTXT - array of MailMan text lines
|
|
;
|
|
N DGCNT ;error count
|
|
N DGCOD ;error code
|
|
N DGDEM ;patient demographics array
|
|
N DGDFN ;pointer to PATIENT (#2) file
|
|
N DGDLG ;DIALOG array
|
|
N DGFAC ;facility data array from XUAF4 call
|
|
N DGI ;generic counter
|
|
N DGICN ;integrated control number
|
|
N DGLIN ;line counter
|
|
N DGMAX ;maximum line length
|
|
N DGSITE ;results of VASITE call
|
|
N DGSNDSTA ;sending station number
|
|
N DGSNDNAM ;sending station name
|
|
N DGTBL ;error code table array
|
|
;
|
|
S DGDFN=+$G(DGPFA("DFN"))
|
|
Q:(DGDFN'>0)
|
|
;
|
|
;retrieve patient demographics
|
|
Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM)
|
|
S DGICN=$$GETICN^MPIF001(DGDFN)
|
|
S DGICN=$S(+DGICN>0:DGICN,1:$P(DGICN,U,2))
|
|
;
|
|
;load error code table
|
|
D BLDVA086^DGPFHLU3(.DGTBL)
|
|
;
|
|
S DGLIN=0
|
|
S DGMAX=65
|
|
S DGSITE=$$SITE^VASITE()
|
|
S DGSNDSTA=$G(DGACK("SNDFAC"))
|
|
D F4^XUAF4(DGSNDSTA,.DGFAC,"","")
|
|
S DGSNDNAM=$S(DGFAC>0:$G(DGFAC("NAME")),1:"")
|
|
;
|
|
D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
|
|
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)
|
|
D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("A facility could not process the following Patient Record Flag assignment on "_$$FMTE^XLFDT($G(DGACK("MSGDTM")))_".",0,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("Message Control ID#: "_$G(DGACK("MSGID")),4,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("Receiving Facility name: "_DGSNDNAM_" ("_DGSNDSTA_")",0,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("Flag Name: "_$P($G(DGPFA("FLAG")),U,2),14,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("Patient Name: "_DGDEM("NAME"),11,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("Social Security #: "_DGDEM("SSN"),6,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("Date of Birth: "_$$FMTE^XLFDT(DGDEM("DOB"),"2D"),10,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("Integrated Control #: "_DGICN,3,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("Owning Site: "_$P($G(DGPFA("OWNER")),U,2)_" ("_$$STA^XUAF4($P($G(DGPFA("OWNER")),U))_")",12,DGMAX,.DGLIN,DGXMTXT)
|
|
D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
|
|
;
|
|
;loop through each error
|
|
S DGCNT=0
|
|
F S DGCNT=$O(DGERR(DGCNT)) Q:'DGCNT D
|
|
. K DGDLG
|
|
. S DGCOD=DGERR(DGCNT)
|
|
. ;
|
|
. ;assume numeric error code is a DIALOG
|
|
. I DGCOD?1N.N D BLD^DIALOG(DGCOD,"","","DGDLG","S")
|
|
. I $D(DGDLG) D FORMAT^DGPFLMT4(.DGDLG,DGMAX-12)
|
|
. ;
|
|
. ;if not a DIALOG, then is it a table entry?
|
|
. I '$D(DGDLG),DGCOD]"",$D(DGTBL(DGCOD,"DESC")) S DGDLG(1)=DGTBL(DGCOD,"DESC")
|
|
. ;
|
|
. ;not a DIALOG or table entry - then error is unknown
|
|
. I '$D(DGDLG) S DGDLG(1)="Unknown Error code: '"_DGCOD_"'"
|
|
. ;
|
|
. ;error header
|
|
. D ADDLINE("Reason#: "_DGCNT,0,DGMAX,.DGLIN,DGXMTXT)
|
|
. ;
|
|
. ;loop through error text array
|
|
. S DGI=0
|
|
. F S DGI=$O(DGDLG(DGI)) Q:'DGI D
|
|
. . D ADDLINE(DGDLG(DGI),12,DGMAX,.DGLIN,DGXMTXT)
|
|
. ;
|
|
. ;error separator
|
|
. D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT)
|
|
;
|
|
Q
|
|
;
|
|
ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array
|
|
;
|
|
; Input:
|
|
; DGTEXT - text string
|
|
; DGINDENT - number of spaces to insert at start of line
|
|
; DGMAXLEN - maximum desired line length (default: 60)
|
|
; DGCNT - line number passed by reference
|
|
;
|
|
; Output:
|
|
; DGXMTXT - array of text strings
|
|
;
|
|
N DGAVAIL ;available space for text
|
|
N DGLINE ;truncated text
|
|
N DGLOC ;location of space character
|
|
N DGPAD ;space indent
|
|
;
|
|
S DGTEXT=$G(DGTEXT)
|
|
S DGINDENT=+$G(DGINDENT)
|
|
S DGMAXLEN=+$G(DGMAXLEN)
|
|
S:'DGMAXLEN DGMAXLEN=60
|
|
I DGINDENT>(DGMAXLEN-1) S DGINDENT=0
|
|
S DGCNT=$G(DGCNT,0) ;default to 0
|
|
;
|
|
S DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT)
|
|
;
|
|
;determine available space for text
|
|
S DGAVAIL=(DGMAXLEN-DGINDENT)
|
|
F D Q:('$L(DGTEXT))
|
|
. ;
|
|
. ;find potential line break
|
|
. S DGLOC=$L($E(DGTEXT,1,DGAVAIL)," ")
|
|
. ;
|
|
. ;break a line that is too long when it has potential line breaks
|
|
. I $L(DGTEXT)>DGAVAIL,DGLOC D
|
|
. . S DGLINE=$P(DGTEXT," ",1,$S(DGLOC>1:DGLOC-1,1:1))
|
|
. . S DGTEXT=$P(DGTEXT," ",$S(DGLOC>1:DGLOC,1:DGLOC+1),$L(DGTEXT," "))
|
|
. E D
|
|
. . S DGLINE=DGTEXT,DGTEXT=""
|
|
. ;
|
|
. S DGCNT=DGCNT+1
|
|
. S @DGXMTXT@(DGCNT)=DGPAD_DGLINE
|
|
Q
|
|
;
|
|
SEND(DGXMTXT) ;send the MailMan message
|
|
;
|
|
; Input:
|
|
; DGXMTXT - name of message text array in closed format
|
|
;
|
|
; Output:
|
|
; none
|
|
;
|
|
N DIFROM ;protect FM package
|
|
N XMDUZ ;sender
|
|
N XMSUB ;message subject
|
|
N XMTEXT ;name of message text array in open format
|
|
N XMY ;recipient array
|
|
N XMZ ;returned message number
|
|
;
|
|
S XMDUZ="Patient Record Flag Module"
|
|
S XMSUB="PRF MESSAGE TRANSMISSION ERROR"
|
|
S XMTEXT=$$OREF^DILF(DGXMTXT)
|
|
S XMY("G.DGPF HL7 TRANSMISSION ERRORS")=""
|
|
D ^XMD
|
|
Q
|
|
;
|
|
FNDDIA(DGDIA,DGERR) ;find dialog code
|
|
;This function searches an array for a specific DIALOG (#.84) code.
|
|
;
|
|
; Input: (required)
|
|
; DGDIA - dialog error code
|
|
; DGERR - array of parsed errors (ex: DGERR(1)=error_code)
|
|
;
|
|
; Output:
|
|
; Function value - 1 on success; 0 on failure
|
|
;
|
|
N DGI ;generic counter
|
|
N DGRSLT ;function value
|
|
S (DGI,DGRSLT)=0
|
|
;
|
|
I +$G(DGDIA),$D(DGERR) D
|
|
. F S DGI=$O(DGERR(DGI)) Q:'DGI D Q:DGRSLT
|
|
. . I $G(DGERR(DGI))=DGDIA S DGRSLT=1
|
|
;
|
|
Q DGRSLT
|