Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPFHLU5

DGPFHLU5.m

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