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

DGPFHLS.m

Go to the documentation of this file.
  1. DGPFHLS ;ALB/RPM - PRF HL7 SEND DRIVERS ; Sep 11, 2023@13:22:21
  1. ;;5.3;Registration;**425,650,1005,1028,1037,1091**;Aug 13, 1993;Build 28
  1. ;
  1. ; Reference to SAVEHL7^EHMHL7 supported by ICR #7424
  1. ;
  1. SNDORU(DGPFIEN,DGPFHARR,DGFAC) ;Send ORU Message Types (ORU~R01)
  1. ;This function builds and transmits a single ORU message to all sites
  1. ;in the associated patient's TREATING FACILITY LIST (#391.91) file.
  1. ;The optional input parameter DGFAC overrides selection of sites
  1. ;from the TREATING FACILITY LIST file.
  1. ;
  1. ; Supported DBIA #2990: This supported DBIA is used to access the
  1. ; Registration API to generate a list of
  1. ; treating facilities for a given patient.
  1. ; Supported by ICR #2263 This ICR permits use of $$GET^XPAR().
  1. ; Input:
  1. ; DGPFIEN - (required) IEN of assignment in PRF ASSIGNMENT (#26.13)
  1. ; file to transmit
  1. ; DGPFHARR - (optional) array of assignment history IENs from the
  1. ; PRF ASSIGNMENT HISTORY (#26.14) file to
  1. ; include in ORU.
  1. ; format: DGPFHARR(assignment_date_time)=IEN
  1. ; assignment_date_time in FM format
  1. ; [default = $$GETLAST^DGPFAAH(DGPFIEN)]
  1. ; DGFAC - (optional) array of message destination facilities
  1. ; passed by reference
  1. ; format: DGFAC(#)=station#
  1. ;
  1. ; Output:
  1. ; Function value - 1 on success, 0 on failure
  1. ;
  1. N DGHLEID ;event protocol ID
  1. N DGHL ;VistA HL7 environment array
  1. N DGHLROOT ;message array location
  1. N DGPFA ;assignment data array
  1. N DGPFAH ;assignment history data array
  1. N DGPFHIEN ;assignment history IEN
  1. N DGRSLT ;function value
  1. N DGI ;counter
  1. N DGCRNR ;flag indicating that a converted facility was found
  1. N DGSTAT,DGSTAT2 ;status retuned when sending message
  1. ;
  1. S DGRSLT=0
  1. S DGHLROOT=$NA(^TMP("PRFORU",$J))
  1. K @DGHLROOT
  1. ;
  1. I +$G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
  1. . ;
  1. . ;retrieve assignment record
  1. . Q:'$$GETASGN^DGPFAA(DGPFIEN,.DGPFA)
  1. . ;
  1. . ;set up default history IEN array
  1. . I '$O(DGPFHARR(0)) D
  1. . . N DGPFAH
  1. . . S DGPFHIEN=$$GETLAST^DGPFAAH(DGPFIEN)
  1. . . Q:'$$GETHIST^DGPFAAH(DGPFHIEN,.DGPFAH)
  1. . . S DGPFHARR(+$G(DGPFAH("ASSIGNDT")))=DGPFHIEN
  1. . Q:'$O(DGPFHARR(0))
  1. . ;
  1. . ;retrieve treating facilities when no destination is provided
  1. . ;I $G(DGFAC(1))'>0 D TFL^VAFCTFU1(.DGFAC,+$G(DGPFA("DFN")))
  1. . I $G(DGFAC(1))'>0 D BLDTFL2^DGPFUT2(+$G(DGPFA("DFN")),.DGFAC)
  1. . Q:$G(DGFAC(1))'>0
  1. . ;
  1. . ;initialize VistA HL7 environment
  1. . S DGHLEID=$$INIT^DGPFHLUT("DGPF PRF ORU/R01 EVENT",.DGHL)
  1. . Q:'DGHLEID
  1. . ;
  1. . ;build ORU segments array
  1. . S DGPFHIEN=$$BLDORU^DGPFHLU(.DGPFA,.DGPFHARR,.DGHL,DGHLROOT)
  1. . Q:'DGPFHIEN
  1. . ;
  1. . ;transmit and log messages
  1. . S DGSTAT=0,DGSTAT2=0
  1. . S DGSTAT=$$XMIT^DGPFHLU6(DGPFHIEN,DGHLEID,.DGFAC,DGHLROOT,.DGHL)
  1. . ;
  1. . ;Should a copy be sent to the regional HC router?
  1. . S DGCRNR=$$CERNER2(DGPFIEN)
  1. . D:DGCRNR
  1. . . S DGSTAT2=$$XMIT1^DGPFHLU6(DGPFHIEN,DGHLEID,DGHLROOT,.DGHL)
  1. . . ;
  1. . . ; Save HL7 message to EHRM HL7 Message file (#1609) - p1091
  1. . . ;
  1. . . N RTNVALUE K ^TMP("EHMHL7",$J) M ^TMP("EHMHL7",$J)=@DGHLROOT ;
  1. . . S RTNVALUE=$$SAVEHL7X^EHMHL7("EHMHL7","PRF","VISTA-"_$$STA^XUAF4($$KSP^XUPARAM("INST")),"200CRNR",DGHL("FS"),$E(DGHL("ECH"),1),$E(DGHL("ECH"),2)) ;
  1. . . K ^TMP("EHMHL7",$J) ;
  1. . ;
  1. . Q:'$G(DGSTAT)
  1. . I DGCRNR,'$G(DGSTAT2) Q
  1. . ;success
  1. . S DGRSLT=1
  1. ;
  1. ;cleanup
  1. K @DGHLROOT
  1. Q DGRSLT
  1. ;
  1. SNDACK(DGACKTYP,DGMIEN,DGHL,DGSEGERR,DGSTOERR) ;Send ACK Message Type (ACK~R01)
  1. ;This procedure assumes the the VistA HL7 environment is providing the
  1. ;environment variables and will produce a fatal error if they are
  1. ;missing.
  1. ;
  1. ; Input:
  1. ; DGACKTYP - (required) ACK message type ("AA","AE")
  1. ; DGMIEN - (required) IEN of message entry in file #773
  1. ; DGHL - (required) HL7 environment array
  1. ; DGSEGERR - (optional) Errors found during parsing
  1. ; DGSTOERR - (optional) Errors during data storage
  1. ;
  1. ; Output:
  1. ; none
  1. ;
  1. N DGHLROOT
  1. N DGHLERR
  1. ;
  1. Q:($G(DGACKTYP)']"")
  1. Q:('+$G(DGMIEN))
  1. ;
  1. S DGHLROOT=$NA(^TMP("HLA",$J))
  1. K @DGHLROOT
  1. ;
  1. ;build ACK segments array
  1. I $$BLDACK^DGPFHLU4(DGACKTYP,DGHLROOT,.DGHL,.DGSEGERR,.DGSTOERR) D
  1. . ;send MailMan message on AE or AR
  1. . D SNDMAIL(DGMIEN,.DGHL,$NA(^TMP("HLA",$J)))
  1. . ;generate the message
  1. . D GENACK^HLMA1(DGHL("EID"),DGMIEN,DGHL("EIDS"),"GM",1,.DGHLERR)
  1. ;
  1. ;cleanup
  1. K @DGHLROOT
  1. Q
  1. ;
  1. SNDQRY(DGDFN,DGMODE,DGFAC) ;Send QRY Message Types (QRY~R02)
  1. ;This function transmits a PRF Query (QRY~R02) HL7 message to a given
  1. ;patient's treating facility.
  1. ;
  1. ; Input:
  1. ; DGDFN - (required) pointer to patient in PATIENT (#2) file
  1. ; DGMODE - (optional) type of HL7 connection to use ("1" - direct
  1. ; connection, "2" - deferred connection [default],
  1. ; "3" - direct connection/display mode)
  1. ; DGFAC - (optional) station number of query destination.
  1. ; [default - most recent unqueried treating facility]
  1. ;
  1. ; Output:
  1. ; Function value - 1 on success, 0 on failure
  1. ;
  1. N DGEVNT
  1. N DGHLROOT
  1. N DGHLLNK
  1. N DGHL
  1. N DGICN
  1. N DGLSQ
  1. N DGMSG
  1. N DGMSGID
  1. N DGNXTF
  1. N DGRSLT
  1. N HLL
  1. N DGHLEID
  1. N DGHLRSLT
  1. N DGHLP
  1. ;
  1. ;the following HL* variables are created by DIRECT^HLMA
  1. N HL,HLCS,HLDOM,HLECH,HLFS,HLINST,HLINSTN
  1. N HLMTIEN,HLNEXT,HLNODE,HLPARAM,HLPROD,HLQ
  1. N HLQUIT
  1. ;
  1. S DGMODE=+$G(DGMODE)
  1. S DGFAC=$G(DGFAC)
  1. S DGRSLT=0
  1. S DGHLROOT=$NA(^TMP("HLS",$J))
  1. K @DGHLROOT
  1. ;
  1. I +$G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
  1. . ;
  1. . ;ICN must be national
  1. . Q:'$$MPIOK^DGPFUT(DGDFN,.DGICN)
  1. . ;
  1. . ;find event, get last site queried and next treating facility
  1. . S DGEVNT=$$FNDEVNT^DGPFHLL1(DGDFN)
  1. . I 'DGEVNT,DGMODE'=3 D ;no event and not display? create it!
  1. . . D STOEVNT^DGPFHLL1(DGDFN)
  1. . . S DGEVNT=$$FNDEVNT^DGPFHLL1(DGDFN)
  1. . S DGLSQ=$$GETLSQ^DGPFHLL(DGEVNT)
  1. . S DGNXTF=$$GETNXTF^DGPFUT(DGDFN,DGLSQ)
  1. . ;
  1. . ;determine treating facility institution number to query
  1. . S DGFAC=$S(DGFAC]"":$$IEN^XUAF4(DGFAC),DGNXTF:DGNXTF,DGLSQ&('DGNXTF):$$GETNXTF^DGPFUT(DGDFN),1:0)
  1. . ;
  1. . ;mark query event COMPLETE and return SUCCESS when no non-local
  1. . ;treating facilities are found and no previous queries have been run.
  1. . I DGFAC'>0,'DGLSQ D
  1. . . D STOEVNT^DGPFHLL1(DGDFN,"C")
  1. . . S DGRSLT=1
  1. . Q:(DGFAC'>0)
  1. . ;
  1. . ;retrieve treating facility HL Logical Link and build HLL array
  1. . S DGHLLNK=$$GETLINK^DGPFHLUT(DGFAC)
  1. . Q:(DGHLLNK=0)
  1. . S HLL("LINKS",1)="DGPF PRF ORF/R04 SUBSC"_U_DGHLLNK
  1. . ;S:$$CERNER(DGDFN) HLL("LINKS",1)="DGPF PRF ORF/R04 SUBSC"_U_"VACRNR"
  1. . ;
  1. . ;initialize VistA HL7 environment
  1. . S DGHLEID=$$INIT^DGPFHLUT("DGPF PRF QRY/R02 EVENT",.DGHL)
  1. . Q:'DGHLEID
  1. . ;
  1. . ;build QRY segments array
  1. . Q:'$$BLDQRY^DGPFHLQ(DGDFN,DGICN,DGHLROOT,.DGHL)
  1. . ;
  1. . ;display busy message to interactive users when direct-connect
  1. . I DGMODE=1!(DGMODE=3),$E($G(IOST),1,2)="C-" D
  1. . . S DGMSG(1)="Attempting to connect to "_$P($$NS^XUAF4(DGFAC),U)
  1. . . S DGMSG(2)="to search for Patient Record Flag Assignments."
  1. . . S DGMSG(3)="This request may take some time, please be patient ..."
  1. . . D EN^DDIOL(.DGMSG)
  1. . ;
  1. . ;generate HL7 message
  1. . I DGMODE=1!(DGMODE=3) D ;generate direct-connect HL7 message
  1. . . S $P(DGHLP("SUBSCRIBER"),U,5)=$$STA^XUAF4(DGFAC)
  1. . . D DIRECT^HLMA(DGHLEID,"GM",1,.DGHLRSLT,"",.DGHLP)
  1. . . ;The DIRECT^HLMA API contains a bug that causes the message ID
  1. . . ;returned to be based on the HL7 MESSAGE TEXT (#772) file IEN and
  1. . . ;not the HL7 MESSAGE ADMINISTRATION (#773) file IEN. Therefore,
  1. . . ;the following call to $$CONVMID is required to convert the
  1. . . ;message ID to the value stored in file #773.
  1. . . S DGMSGID=$$CONVMID^DGPFHLUT($P(DGHLRSLT,U))
  1. . . I DGMODE=1,DGMSGID>0 D STOQXMIT^DGPFHLL(DGEVNT,DGMSGID,DGFAC)
  1. . . I HLMTIEN,DGMODE'=3 D RCV^DGPFHLR
  1. . . I DGMODE=3 D DISPLAY^DGPFHLUQ(HLMTIEN,DGHLRSLT)
  1. . . ;success
  1. . . I '+$P(DGHLRSLT,U,2) S DGRSLT=1
  1. . ;
  1. . E D ;generate deferred HL7 message
  1. . . S $P(DGHLP("SUBSCRIBER"),U,5)=$$STA^XUAF4(DGFAC)
  1. . . D GENERATE^HLMA(DGHLEID,"GM",1,.DGHLRSLT,"",.DGHLP)
  1. . . I $P(DGHLRSLT,U)>0 D STOQXMIT^DGPFHLL(DGEVNT,$P(DGHLRSLT,U),DGFAC)
  1. . . ;success
  1. . . I '+$P(DGHLRSLT,U,2) S DGRSLT=1
  1. ;
  1. ;cleanup
  1. K @DGHLROOT
  1. Q DGRSLT
  1. ;
  1. SNDORF(DGQRY,DGMIEN,DGHL,DGDFN,DGSEGERR,DGQRYERR) ;Send ORF Message Type (ORF~R04)
  1. ;This procedure assumes the the VistA HL7 environment is providing the
  1. ;environment variables and will produce a fatal error if they are
  1. ;missing.
  1. ;
  1. ; Input:
  1. ; DGQRY - (required) Array of QRY parsing results
  1. ; DGMIEN - (required) IEN of message entry in file #773
  1. ; DGHL - (required) HL7 environment array
  1. ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
  1. ; DGSEGERR - (optional) Errors found during parsing
  1. ; DGQRYERR - (optional) Errors found during query
  1. ;
  1. ; Output:
  1. ; none
  1. ;
  1. N DGHLROOT
  1. N DGHLERR
  1. ;
  1. Q:('$D(DGQRY))
  1. Q:('+$G(DGMIEN))
  1. ;
  1. S DGHLROOT=$NA(^TMP("HLA",$J))
  1. K @DGHLROOT
  1. ;
  1. ;build ORF segments array
  1. I $$BLDORF^DGPFHLQ(DGHLROOT,.DGHL,DGDFN,.DGQRY,.DGSEGERR,.DGQRYERR) D
  1. . ;send MailMan message on AE or AR
  1. . D SNDMAIL(DGMIEN,.DGHL,$NA(^TMP("HLA",$J)))
  1. . ;generate the message
  1. . D GENACK^HLMA1(DGHL("EID"),DGMIEN,DGHL("EIDS"),"GM",1,.DGHLERR)
  1. ;
  1. ;cleanup
  1. K @DGHLROOT
  1. Q
  1. ;
  1. ;patch 1005
  1. CERNER(DGDFN) ;
  1. ;Is this a Cerner patient (i.e., is 200CRNR in the TFL)?
  1. ;input variables
  1. ;DGDFN - pointer to PATIENT (#2) file
  1. ;return value:
  1. ; 1 - yes, 0 - no
  1. ;
  1. N DGRES,DGOUT,DGSITE,DGKEY,DGI
  1. S DGRES=0
  1. S DGSITE=$P($$SITE^VASITE,U,3)
  1. S DGKEY=DGDFN_U_"PI"_U_"USVHA"_U_DGSITE
  1. D TFL^VAFCTFU2(.DGOUT,DGKEY)
  1. S DGI=0
  1. F S DGI=$O(DGOUT(DGI)) Q:DGI="" D
  1. .I $P(DGOUT(DGI),U,4)="200CRNR",$P(DGOUT(DGI),U,2)="PI" S DGRES=1
  1. Q DGRES
  1. ;
  1. CERNER2(DGIEN) ;
  1. ;This is a convenience routine that accepts a patient record flag
  1. ;assignment as input parameter.
  1. ;input variables:
  1. ;DGIEN - pointer to PRF ASSIGNMENT (#26.13) file
  1. ;return value:
  1. ; 1 - yes, 0 - no
  1. ;
  1. N DGDFN,DGPFA
  1. D GETASGN^DGPFAA(DGIEN,.DGPFA)
  1. S DGDFN=$P(DGPFA("DFN"),U)
  1. Q $$CERNER(DGDFN)
  1. ;
  1. SNDMAIL(DGMIEN,DGHL,DGROOT) ;
  1. ;This entry point sends a MailMan message reporting that an AE or
  1. ;AR was generated.
  1. ;input variables:
  1. ;DGMIEN (required) - IEN of offending message in file #773
  1. ;DGHL (required) - The "HL" array
  1. ;DGROOT (required) - root for the application ack passed to GENACK^HLMA1
  1. ;
  1. ;call to $$PROD^XUPROD supported by ICR #4440
  1. ;
  1. N XMDUZ,XMSUB,XMTEXT,XMY,XMZ ;MailMan variables
  1. N DGTXT,DGSTAT,DGMSA,DGTYP,DGFS,DGI,DGMID
  1. S DGFS=DGHL("FS")
  1. S DGMSA=$G(@DGROOT@(1))
  1. S DGTYP=$P(DGMSA,DGFS,2)
  1. S DGMID=$P(DGMSA,DGFS,3)
  1. Q:DGTYP="AA" ;Don't send mail messages for succesful AAs.
  1. S DGSTAT=$P($$SITE^VASITE,U,3)
  1. S XMDUZ="PRF Error Processor"
  1. S XMSUB="PRF Application Error (station #"_DGSTAT_")"
  1. S XMSUB=XMSUB_" ["_$S($$PROD^XUPROD:"P",1:"T")_"]" ;production or test?
  1. S XMY("G.DGPF APPLICATION ERRORS")=""
  1. S XMTEXT="DGTXT("
  1. S DGTXT(1)="An error occurred in message #"_DGMIEN
  1. S DGTXT(2)="Original MID: "_DGMID
  1. S DGTXT(3)=""
  1. S DGTXT(4)="MESSAGE TEXT (ACK):"
  1. S DGI="" F S DGI=$O(@DGROOT@(DGI)) Q:DGI="" D
  1. . S DGTXT(DGI+4)=$G(@DGROOT@(DGI))
  1. D ^XMD
  1. Q