- 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 Feb 19, 2025@00:14:01 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