DGPFHLU6 ;ALB/RPM - PRF HL7 ORU~R01 UTILITIES ; 8/31/05 1:09pm
;;5.3;Registration;**425,554,1005,1028**;Aug 13, 1993;Build 4
;Call to $$GET^XPAR supported by ICR #2263
;
Q ;no direct entry
;
XMIT(DGPFHIEN,DGHLEID,DGFAC,DGHLROOT,DGHL,DGHC) ;transmit ORU messages
;This function loops through an array of treating facilities. For
;each treating facility: the HL7 logical link is determined, the ORU
;message contained in the DGHLROOT input parameter is transmitted and
;an entry is created in the PRF HL7 TRANSMISSION LOG (#26.17) file.
;
; Supported DBIA #2171: This supported DBIA is used to access the
; Kernel API to convert a station number
; to an INSTITUTION (#4) file IEN, and for
; Kernel API to check whether a station has
; to Cerner.
; Supported ICR #2263: This ICR permits the use of $$GET^XPAR to
; retrieve a parameter value.
;
; Input:
; DGPFHIEN - pointer to PRF ASSIGNMENT HISTORY (#26.14) file
; DGHLEID - event protocol ID
; DGFAC - treating facilities array
; DGHLROOT - name of array containing formatted ORU message
; DGHL - VistA HL7 environment array
;
; Output:
; Function value - returns 1 on sucess, 0 on failure
;
N DGHLLNK ;single logical link
N DGHLS ;name of HL7 "HLS" array
N DGI ;generic counter
N DGINST ;pointer to INSTITUTION (#4) file
N DGLOGERR ;error array from transmit log filer
N DGLINST ;pointer to INSTITUTION (#4) file for local site
N DGRSLT ;function value
N HLL ;logical links array
N DGHLRSLT ;message IEN on successful transmit
N DGSTAT ;station number
;
S DGHLS=$NA(^TMP("HLS",$J))
S DGLINST=$P($$SITE^VASITE(),U,1)
S DGRSLT=0
;
S DGI=0
F S DGI=$O(DGFAC(DGI)) Q:'DGI D
. N DGHLRSLT
. N DGLOGERR
. N DGSTAT
. ;
. ;convert the station number to INSTITUTION (#4) file IEN
. S DGSTAT=$P(DGFAC(DGI),U,1)
. S DGINST=+$$IEN^XUAF4($P(DGFAC(DGI),U,1))
. Q:('DGINST!(DGINST=DGLINST))
. ;
. ;must be a medical treating facility
. Q:'$$TF^XUAF4(DGINST)
. ;
. ;must not be 200CRNR - patch 1005
. Q:$$STA^XUAF4(DGINST)="200CRNR"
. ;
. ;get the HL7 LOGICAL LINK associated with the institution
. S DGHLLNK=$$GETLINK^DGPFHLUT(DGINST)
. ;
. Q:DGHLLNK=0 ;patch 1028 - Don't try to send if there is no link.
. ;
. ;copy formatted message to HL7 "HLS" array
. K @DGHLS
. M @DGHLS=@DGHLROOT
. ;
. ;build HLL logical link array
. S HLL("LINKS",1)="DGPF PRF ORU/R01 SUBSC"_U_DGHLLNK
. ;
. ;generate the message
. D GENERATE^HLMA(DGHLEID,"GM",1,.DGHLRSLT,"","")
. Q:$P(DGHLRSLT,U,2)]""
. ;
. ;store the message ID and destination site in the HL7 transmission log
. D STOXMIT^DGPFHLL(DGPFHIEN,$P(DGHLRSLT,U),DGINST,.DGLOGERR)
. Q:$D(DGLOGERR)
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
;
XMIT1(DGPFHIEN,DGHLEID,DGROOT,DGHL,DGSTAT) ;
; Input:
; DGPFHIEN - pointer to PRF ASSIGNMENT HISTORY (#26.14) file
; DGHLEID - event protocol ID
; DGHLROOT - name of array containing formatted ORU message
; DGHL - VistA HL7 environment array
; DGSTAT - station IEN
; Output:
; function value - 1 on success, 0 on failure
;
; Supported ICR #2171: This supported DBIA is used to access the
; Kernel API to convert a station number
; to an INSTITUTION (#4) file IEN, and for
; Kernel API to check whether a station has
; to Cerner.
; Supported ICR #2263: This ICR permits the use of $$GET^XPAR to
; retrieve a parameter value.
;
N DGHLS ;name of HL7 "HLS" array
N DGRSLT ;return value
N HLL ;HL7 links array
N DGINST ;pointer to INSTITUTION file
N DGLOGERRR ;logging error
N DGHLP ;HL7 "HLP" array
S DGINST=$$IEN^XUAF4("200CRNR") ;for logging purposes
S DGHLS=$NA(^TMP("HLS",$J))
K @DGHLS
M @DGHLS=@DGROOT ;copy message to "HLS" array
S DGRSLT=0
;set recipient to HC regional router
S HLL("LINKS",1)="DGPF PRF ORU/R01 SUBSC"_U_$$GET^XPAR("SYS","DG PRF REGIONAL ROUTER",1)
S $P(DGHLP("SUBSCRIBER"),U,5)="200CRNR"
D GENERATE^HLMA(DGHLEID,"GM",1,.DGHLRSLT,"",.DGHLP) ;send the message
Q:$P(DGHLRSLT,U,2)]"" DGRSLT
D STOXMIT^DGPFHLL(DGPFHIEN,$P(DGHLRSLT,U),DGINST,.DGLOGERR) ;log it
Q:$D(DGLOGERR) DGRSLT
S DGRSLT=1 ;success
Q DGRSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFHLU6 4517 printed Apr 09, 2024@21:46:49 Page 2
DGPFHLU6 ;ALB/RPM - PRF HL7 ORU~R01 UTILITIES ; 8/31/05 1:09pm
+1 ;;5.3;Registration;**425,554,1005,1028**;Aug 13, 1993;Build 4
+2 ;Call to $$GET^XPAR supported by ICR #2263
+3 ;
+4 ;no direct entry
QUIT
+5 ;
XMIT(DGPFHIEN,DGHLEID,DGFAC,DGHLROOT,DGHL,DGHC) ;transmit ORU messages
+1 ;This function loops through an array of treating facilities. For
+2 ;each treating facility: the HL7 logical link is determined, the ORU
+3 ;message contained in the DGHLROOT input parameter is transmitted and
+4 ;an entry is created in the PRF HL7 TRANSMISSION LOG (#26.17) file.
+5 ;
+6 ; Supported DBIA #2171: This supported DBIA is used to access the
+7 ; Kernel API to convert a station number
+8 ; to an INSTITUTION (#4) file IEN, and for
+9 ; Kernel API to check whether a station has
+10 ; to Cerner.
+11 ; Supported ICR #2263: This ICR permits the use of $$GET^XPAR to
+12 ; retrieve a parameter value.
+13 ;
+14 ; Input:
+15 ; DGPFHIEN - pointer to PRF ASSIGNMENT HISTORY (#26.14) file
+16 ; DGHLEID - event protocol ID
+17 ; DGFAC - treating facilities array
+18 ; DGHLROOT - name of array containing formatted ORU message
+19 ; DGHL - VistA HL7 environment array
+20 ;
+21 ; Output:
+22 ; Function value - returns 1 on sucess, 0 on failure
+23 ;
+24 ;single logical link
NEW DGHLLNK
+25 ;name of HL7 "HLS" array
NEW DGHLS
+26 ;generic counter
NEW DGI
+27 ;pointer to INSTITUTION (#4) file
NEW DGINST
+28 ;error array from transmit log filer
NEW DGLOGERR
+29 ;pointer to INSTITUTION (#4) file for local site
NEW DGLINST
+30 ;function value
NEW DGRSLT
+31 ;logical links array
NEW HLL
+32 ;message IEN on successful transmit
NEW DGHLRSLT
+33 ;station number
NEW DGSTAT
+34 ;
+35 SET DGHLS=$NAME(^TMP("HLS",$JOB))
+36 SET DGLINST=$PIECE($$SITE^VASITE(),U,1)
+37 SET DGRSLT=0
+38 ;
+39 SET DGI=0
+40 FOR
SET DGI=$ORDER(DGFAC(DGI))
if 'DGI
QUIT
Begin DoDot:1
+41 NEW DGHLRSLT
+42 NEW DGLOGERR
+43 NEW DGSTAT
+44 ;
+45 ;convert the station number to INSTITUTION (#4) file IEN
+46 SET DGSTAT=$PIECE(DGFAC(DGI),U,1)
+47 SET DGINST=+$$IEN^XUAF4($PIECE(DGFAC(DGI),U,1))
+48 if ('DGINST!(DGINST=DGLINST))
QUIT
+49 ;
+50 ;must be a medical treating facility
+51 if '$$TF^XUAF4(DGINST)
QUIT
+52 ;
+53 ;must not be 200CRNR - patch 1005
+54 if $$STA^XUAF4(DGINST)="200CRNR"
QUIT
+55 ;
+56 ;get the HL7 LOGICAL LINK associated with the institution
+57 SET DGHLLNK=$$GETLINK^DGPFHLUT(DGINST)
+58 ;
+59 ;patch 1028 - Don't try to send if there is no link.
if DGHLLNK=0
QUIT
+60 ;
+61 ;copy formatted message to HL7 "HLS" array
+62 KILL @DGHLS
+63 MERGE @DGHLS=@DGHLROOT
+64 ;
+65 ;build HLL logical link array
+66 SET HLL("LINKS",1)="DGPF PRF ORU/R01 SUBSC"_U_DGHLLNK
+67 ;
+68 ;generate the message
+69 DO GENERATE^HLMA(DGHLEID,"GM",1,.DGHLRSLT,"","")
+70 if $PIECE(DGHLRSLT,U,2)]""
QUIT
+71 ;
+72 ;store the message ID and destination site in the HL7 transmission log
+73 DO STOXMIT^DGPFHLL(DGPFHIEN,$PIECE(DGHLRSLT,U),DGINST,.DGLOGERR)
+74 if $DATA(DGLOGERR)
QUIT
+75 ;
+76 ;success
+77 SET DGRSLT=1
End DoDot:1
+78 ;
+79 QUIT DGRSLT
+80 ;
XMIT1(DGPFHIEN,DGHLEID,DGROOT,DGHL,DGSTAT) ;
+1 ; Input:
+2 ; DGPFHIEN - pointer to PRF ASSIGNMENT HISTORY (#26.14) file
+3 ; DGHLEID - event protocol ID
+4 ; DGHLROOT - name of array containing formatted ORU message
+5 ; DGHL - VistA HL7 environment array
+6 ; DGSTAT - station IEN
+7 ; Output:
+8 ; function value - 1 on success, 0 on failure
+9 ;
+10 ; Supported ICR #2171: This supported DBIA is used to access the
+11 ; Kernel API to convert a station number
+12 ; to an INSTITUTION (#4) file IEN, and for
+13 ; Kernel API to check whether a station has
+14 ; to Cerner.
+15 ; Supported ICR #2263: This ICR permits the use of $$GET^XPAR to
+16 ; retrieve a parameter value.
+17 ;
+18 ;name of HL7 "HLS" array
NEW DGHLS
+19 ;return value
NEW DGRSLT
+20 ;HL7 links array
NEW HLL
+21 ;pointer to INSTITUTION file
NEW DGINST
+22 ;logging error
NEW DGLOGERRR
+23 ;HL7 "HLP" array
NEW DGHLP
+24 ;for logging purposes
SET DGINST=$$IEN^XUAF4("200CRNR")
+25 SET DGHLS=$NAME(^TMP("HLS",$JOB))
+26 KILL @DGHLS
+27 ;copy message to "HLS" array
MERGE @DGHLS=@DGROOT
+28 SET DGRSLT=0
+29 ;set recipient to HC regional router
+30 SET HLL("LINKS",1)="DGPF PRF ORU/R01 SUBSC"_U_$$GET^XPAR("SYS","DG PRF REGIONAL ROUTER",1)
+31 SET $PIECE(DGHLP("SUBSCRIBER"),U,5)="200CRNR"
+32 ;send the message
DO GENERATE^HLMA(DGHLEID,"GM",1,.DGHLRSLT,"",.DGHLP)
+33 if $PIECE(DGHLRSLT,U,2)]""
QUIT DGRSLT
+34 ;log it
DO STOXMIT^DGPFHLL(DGPFHIEN,$PIECE(DGHLRSLT,U),DGINST,.DGLOGERR)
+35 if $DATA(DGLOGERR)
QUIT DGRSLT
+36 ;success
SET DGRSLT=1
+37 QUIT DGRSLT
