DGROHLS ;DJH/AMA - ROM HL7 SEND DRIVERS ; 27 Apr 2004 5:16 PM
;;5.3;Registration;**533,572**;Aug 13, 1993
;
SNDACK(DGACKTYP,DGMIEN,DGHL,DGSEGERR,DGSTOERR) ;Send ACK Message Type (ACK~R01)
;This procedure assumes that the VistA HL7 environment is providing the
;environment variables and will produce a fatal error if they are missing.
;
; Input:
; DGACKTYP - (required) ACK message type ("AA","AE")
; DGMIEN - (required) IEN of message entry in file #773
; DGHL - (required) HL7 environment array
; DGSEGERR - (optional) Errors found during parsing
; DGSTOERR - (optional) Errors during data storage
;
; Output:
; none
;
N DGHLROOT,DGHLERR
;
Q:($G(DGACKTYP)']"")
Q:('+$G(DGMIEN))
;
S DGHLROOT=$NA(^TMP("HLA",$J))
K @DGHLROOT
;
;build ACK segments array
I $$BLDACK^DGROHLU4(DGACKTYP,DGHLROOT,.DGHL,.DGSEGERR,.DGSTOERR) D
. ;
. ;generate the message
. D GENACK^HLMA1(DGHL("EID"),DGMIEN,DGHL("EIDS"),"GM",1,.DGHLERR)
;
;cleanup
K @DGHLROOT
Q
;
SNDQRY(DGDFN) ;Send QRY Message Types (QRY~R02)
;
; Input:
; DGDFN - (required) pointer to patient in PATIENT (#2) file
;
; Output:
; Function value - 1 on success, 0 on failure
;
; Use of the API $$GET^XUESSO1() supported by DBIA # 4342
;
N DGLST,DGHLROOT,DGHLLNK,DGHL,DGUSER,DGICN,DGMSG,DGRSLT,HLL,HLEID,HLRSLT
;
;the following HL* variables are created by DIRECT^HLMA
N HL,HLCS,HLDOM,HLECH,HLFS,HLINST,HLINSTN,HLQ,ACKCODE
N HLMTIEN,HLNEXT,HLNODE,HLPARAM,HLPROD,HLQUIT
;
S DGRSLT=0
S DGHLROOT=$NA(^TMP("HLS",$J))
K @DGHLROOT
;
I +$G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
. ;
. ;ICN must be national and LST must not be local site
. Q:'$$MPIOK^DGROUT(DGDFN,.DGICN,.DGLST)
. ;
. ;retrieve LST's HL Logical Link and build HLL array
. S DGHLLNK=$$GETLINK^DGROHLUT(DGLST)
. Q:(DGHLLNK=0)
. S HLL("LINKS",1)="DGRO ROM ORF/R04 SUBSC"_U_DGHLLNK
. ;
. ;initialize VistA HL7 environment
. S HLEID=$$INIT^DGROHLUT("DGRO ROM QRY/R02 EVENT",.DGHL)
. Q:'HLEID
. ;
. ;retrieve user info ;DG*5.3*572
. S DGUSER=$$GET^XUESSO1()
. I +DGUSER<0 D Q
. . ;display error message to interactive users
. . S DGMSG(1)=" "
. . S DGMSG(2)="The query to the LST has been terminated due to insufficient user data"
. . D EN^DDIOL(.DGMSG)
. S DGUSER=$P(DGUSER,U,1,2)_U_$P(DGUSER,U,5,6)
. S DGUSER=$TR(DGUSER,U,"~")
. ;
. ;build QRY segments array
. Q:'$$BLDQRY^DGROHLQ(DGDFN,DGICN,DGHLROOT,.DGHL,DGUSER)
. ;
. ;display busy message to interactive users
. S DGMSG(1)=" "
. S DGMSG(2)="Attempting to connect to the Last Site of Treatment ("_$G(DGLST)_") to search for Patient"
. S DGMSG(3)="Demographic Data. This request may take some time, please be patient ..."
. D EN^DDIOL(.DGMSG)
. ;
. ;generate HL7 message
. D DIRECT^HLMA(HLEID,"GM",1,.HLRSLT,"","")
. Q:$P(HLRSLT,U,2)]""
. I HLMTIEN N DGROVRCK S DGROVRCK=1 D RCV^DGROHLR
. I ($D(DGROVRCK)),(DGROVRCK=0) K DGROVRCK QUIT
. Q:$G(ACKCODE)
. ;success
. S DGRSLT=1
;
;cleanup
K @DGHLROOT
Q DGRSLT
;
SNDORF(DGQRY,DGMIEN,DGHL,DGDFN,DGSEGERR,DGQRYERR) ;Send ORF Message Type (ORF~R04)
;This procedure assumes the the VistA HL7 environment is providing the
;environment variables and will produce a fatal error if they are
;missing. (Called from RCVQRY^DGROHLR)
;
; Input:
; DGQRY - (required) Array of QRY parsing results
; DGMIEN - (required) IEN of message entry in file #773
; DGHL - (required) HL7 environment array
; DGDFN - (required) Pointer to patient in PATIENT (#2) file
; DGSEGERR - (optional) Errors found during parsing
; DGQRYERR - (optional) Errors found during query
;
; Output:
; none
;
N DGHLROOT
N DGHLERR
;
Q:('$D(DGQRY))
Q:('+$G(DGMIEN))
Q:($TR(DGQRY("USER"),"~",U)']"")
;
S DGHLROOT=$NA(^TMP("HLA",$J)) K @DGHLROOT
;
;build ORF segments array
I $$BLDORF^DGROHLQ(DGHLROOT,.DGHL,DGDFN,.DGQRY,.DGSEGERR,.DGQRYERR) D
. ;
. ;generate the message
. D GENACK^HLMA1(DGHL("EID"),DGMIEN,DGHL("EIDS"),"GM",1,.DGHLERR)
;
;cleanup
K @DGHLROOT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGROHLS 4147 printed Sep 23, 2025@20:31:10 Page 2
DGROHLS ;DJH/AMA - ROM HL7 SEND DRIVERS ; 27 Apr 2004 5:16 PM
+1 ;;5.3;Registration;**533,572**;Aug 13, 1993
+2 ;
SNDACK(DGACKTYP,DGMIEN,DGHL,DGSEGERR,DGSTOERR) ;Send ACK Message Type (ACK~R01)
+1 ;This procedure assumes that the VistA HL7 environment is providing the
+2 ;environment variables and will produce a fatal error if they are missing.
+3 ;
+4 ; Input:
+5 ; DGACKTYP - (required) ACK message type ("AA","AE")
+6 ; DGMIEN - (required) IEN of message entry in file #773
+7 ; DGHL - (required) HL7 environment array
+8 ; DGSEGERR - (optional) Errors found during parsing
+9 ; DGSTOERR - (optional) Errors during data storage
+10 ;
+11 ; Output:
+12 ; none
+13 ;
+14 NEW DGHLROOT,DGHLERR
+15 ;
+16 if ($GET(DGACKTYP)']"")
QUIT
+17 if ('+$GET(DGMIEN))
QUIT
+18 ;
+19 SET DGHLROOT=$NAME(^TMP("HLA",$JOB))
+20 KILL @DGHLROOT
+21 ;
+22 ;build ACK segments array
+23 IF $$BLDACK^DGROHLU4(DGACKTYP,DGHLROOT,.DGHL,.DGSEGERR,.DGSTOERR)
Begin DoDot:1
+24 ;
+25 ;generate the message
+26 DO GENACK^HLMA1(DGHL("EID"),DGMIEN,DGHL("EIDS"),"GM",1,.DGHLERR)
End DoDot:1
+27 ;
+28 ;cleanup
+29 KILL @DGHLROOT
+30 QUIT
+31 ;
SNDQRY(DGDFN) ;Send QRY Message Types (QRY~R02)
+1 ;
+2 ; Input:
+3 ; DGDFN - (required) pointer to patient in PATIENT (#2) file
+4 ;
+5 ; Output:
+6 ; Function value - 1 on success, 0 on failure
+7 ;
+8 ; Use of the API $$GET^XUESSO1() supported by DBIA # 4342
+9 ;
+10 NEW DGLST,DGHLROOT,DGHLLNK,DGHL,DGUSER,DGICN,DGMSG,DGRSLT,HLL,HLEID,HLRSLT
+11 ;
+12 ;the following HL* variables are created by DIRECT^HLMA
+13 NEW HL,HLCS,HLDOM,HLECH,HLFS,HLINST,HLINSTN,HLQ,ACKCODE
+14 NEW HLMTIEN,HLNEXT,HLNODE,HLPARAM,HLPROD,HLQUIT
+15 ;
+16 SET DGRSLT=0
+17 SET DGHLROOT=$NAME(^TMP("HLS",$JOB))
+18 KILL @DGHLROOT
+19 ;
+20 IF +$GET(DGDFN)>0
IF $DATA(^DPT(DGDFN,0))
Begin DoDot:1
+21 ;
+22 ;ICN must be national and LST must not be local site
+23 if '$$MPIOK^DGROUT(DGDFN,.DGICN,.DGLST)
QUIT
+24 ;
+25 ;retrieve LST's HL Logical Link and build HLL array
+26 SET DGHLLNK=$$GETLINK^DGROHLUT(DGLST)
+27 if (DGHLLNK=0)
QUIT
+28 SET HLL("LINKS",1)="DGRO ROM ORF/R04 SUBSC"_U_DGHLLNK
+29 ;
+30 ;initialize VistA HL7 environment
+31 SET HLEID=$$INIT^DGROHLUT("DGRO ROM QRY/R02 EVENT",.DGHL)
+32 if 'HLEID
QUIT
+33 ;
+34 ;retrieve user info ;DG*5.3*572
+35 SET DGUSER=$$GET^XUESSO1()
+36 IF +DGUSER<0
Begin DoDot:2
+37 ;display error message to interactive users
+38 SET DGMSG(1)=" "
+39 SET DGMSG(2)="The query to the LST has been terminated due to insufficient user data"
+40 DO EN^DDIOL(.DGMSG)
End DoDot:2
QUIT
+41 SET DGUSER=$PIECE(DGUSER,U,1,2)_U_$PIECE(DGUSER,U,5,6)
+42 SET DGUSER=$TRANSLATE(DGUSER,U,"~")
+43 ;
+44 ;build QRY segments array
+45 if '$$BLDQRY^DGROHLQ(DGDFN,DGICN,DGHLROOT,.DGHL,DGUSER)
QUIT
+46 ;
+47 ;display busy message to interactive users
+48 SET DGMSG(1)=" "
+49 SET DGMSG(2)="Attempting to connect to the Last Site of Treatment ("_$GET(DGLST)_") to search for Patient"
+50 SET DGMSG(3)="Demographic Data. This request may take some time, please be patient ..."
+51 DO EN^DDIOL(.DGMSG)
+52 ;
+53 ;generate HL7 message
+54 DO DIRECT^HLMA(HLEID,"GM",1,.HLRSLT,"","")
+55 if $PIECE(HLRSLT,U,2)]""
QUIT
+56 IF HLMTIEN
NEW DGROVRCK
SET DGROVRCK=1
DO RCV^DGROHLR
+57 IF ($DATA(DGROVRCK))
IF (DGROVRCK=0)
KILL DGROVRCK
QUIT
+58 if $GET(ACKCODE)
QUIT
+59 ;success
+60 SET DGRSLT=1
End DoDot:1
+61 ;
+62 ;cleanup
+63 KILL @DGHLROOT
+64 QUIT DGRSLT
+65 ;
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
+2 ;environment variables and will produce a fatal error if they are
+3 ;missing. (Called from RCVQRY^DGROHLR)
+4 ;
+5 ; Input:
+6 ; DGQRY - (required) Array of QRY parsing results
+7 ; DGMIEN - (required) IEN of message entry in file #773
+8 ; DGHL - (required) HL7 environment array
+9 ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
+10 ; DGSEGERR - (optional) Errors found during parsing
+11 ; DGQRYERR - (optional) Errors found during query
+12 ;
+13 ; Output:
+14 ; none
+15 ;
+16 NEW DGHLROOT
+17 NEW DGHLERR
+18 ;
+19 if ('$DATA(DGQRY))
QUIT
+20 if ('+$GET(DGMIEN))
QUIT
+21 if ($TRANSLATE(DGQRY("USER"),"~",U)']"")
QUIT
+22 ;
+23 SET DGHLROOT=$NAME(^TMP("HLA",$JOB))
KILL @DGHLROOT
+24 ;
+25 ;build ORF segments array
+26 IF $$BLDORF^DGROHLQ(DGHLROOT,.DGHL,DGDFN,.DGQRY,.DGSEGERR,.DGQRYERR)
Begin DoDot:1
+27 ;
+28 ;generate the message
+29 DO GENACK^HLMA1(DGHL("EID"),DGMIEN,DGHL("EIDS"),"GM",1,.DGHLERR)
End DoDot:1
+30 ;
+31 ;cleanup
+32 KILL @DGHLROOT
+33 QUIT
