DGQEHLS ;ALB/RPM - VIC REPLACEMENT HL7 SEND DRIVER ; 10/13/05
;;5.3;Registration;**571,679,1015**;Aug 13, 1993;Build 21
;
Q ;no direct entry
;
SND(DGRIEN,DGERR) ;Send a single ORM orders message
; This function builds and transmits a General Order (ORM~O01)
; Message used to either release a hold on a Veteran ID Card (VIC)
; request or cancel the VIC request.
;
; Input:
; DGRIEN - pointer VIC REQUEST (#39.6) file
;
; Output:
; Function result - '1' on success; '0' on failure
; DGERR - undefined on success; error message string on failure
;
N DGHLEID ;event protocol ID
N DGHLRSLT ;result from GENERATE API
N DGREQ ;VIC REQUEST data array
N DGROOT ;HL7 message text array name
N DGRSLT ;function result
;
S DGROOT=$NA(^TMP("HLS",$J))
K @DGROOT
;
S DGRSLT=0
;
I $G(DGRIEN)>0 D
. ;
. ;initialize HL7 environment
. S DGHLEID=$$INIT^DGQEHLUT("DGQE VIC ORM/O01 EVENT",.DGHL)
. I 'DGHLEID S DGERR="Unable to initialize HL7 environment"
. Q:$D(DGERR)
. ;
. ;retrieve VIC REQUEST file record
. I '$$GETREQ^DGQEREQ(DGRIEN,.DGREQ) D
. . S DGERR="Unable to retrieve VIC REQUEST data"
. Q:$D(DGERR)
. ;
. ;build ORM message
. I '$$BLDORM(.DGREQ,DGROOT,.DGHL) D
. . S DGERR="Unable to build ORM message text"
. Q:$D(DGERR)
. ;
. ;transmit the message
. D GENERATE^HLMA(DGHLEID,$S(DGROOT["^":"GM",1:"LM"),1,.DGHLRSLT)
. I +$P(DGHLRSLT,U,2) S DGERR=$P(DGHLRSLT,U,2)
. Q:$D(DGERR)
. ;
. ;set transmission log
. D STOXMIT^DGQEHLL($P(DGHLRSLT,U),DGRIEN)
. ;
. ;clear transmission required flag
. D XMITOFF^DGQEDD(DGRIEN)
. ;
. S DGRSLT=1
;
K @DGROOT
;
Q DGRSLT
;
BLDORM(DGREQ,DGROOT,DGHL) ;build segments for a single ORM message
;
; Input:
; DGREQ - (required) VIC REQUEST data array
; DGROOT - (required) closed root array name to contain segments
; DGHL - VistA HL7 environment array
;
; Output:
; Function value - "1" on sucess; "0" on failure
;
N DGPTID ;Patient ID field 3 of PID segment
N DGRSLT ;function result
N DGSEG ;segment counter
N DGSEGSTR ;formatted segment string
N DGSTR ;comma-delimited list of segment fields
;
S DGRSLT=0
S DGSEG=0
I $D(DGREQ),$G(DGROOT)]"",$D(DGHL) D
. Q:'$G(DGREQ("DFN"))
. Q:'$D(^DPT(DGREQ("DFN")))
. Q:$G(DGREQ("CARDID"))']""
. ;
. ;build PID segment
. S DGSTR="1,2,3,5,7,19" ;{3=ICN,5=NAME,7=DOB,19=SSN}
. S DGSEGSTR=$$EN^VAFHLPID(DGREQ("DFN"),DGSTR,1,1)
. Q:(DGSEGSTR="")
. ;set Patient ID field 3 Check Digit component to null
. S DGPTID=$P(DGSEGSTR,DGHL("FS"),4)
. S $P(DGPTID,$E(DGHL("ECH")),2)=""
. S $P(DGSEGSTR,DGHL("FS"),4)=DGPTID
. S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
. ;
. ;build ORC segment
. S DGSTR="1"
. S DGSEGSTR=$$ORC^DGQEHLOR(.DGREQ,DGSTR,.DGHL)
. Q:(DGSEGSTR="")
. S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
. ;
. ;build RQD segment
. S DGSTR="1,3"
. S DGSEGSTR=$$RQD^DGQEHLRQ(.DGREQ,DGSTR,.DGHL)
. Q:(DGSEGSTR="")
. S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
. ;
. ;build NTE segment for POW and PH
. S DGSTR="3"
. S DGSEGSTR=$$NTE^DGQEHLNT(.DGREQ,DGSTR,.DGHL)
. Q:(DGSEGSTR="")
. S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
DGQEHLS ;ALB/RPM - VIC REPLACEMENT HL7 SEND DRIVER ; 10/13/05
+1 ;;5.3;Registration;**571,679,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;no direct entry
QUIT
+4 ;
SND(DGRIEN,DGERR) ;Send a single ORM orders message
+1 ; This function builds and transmits a General Order (ORM~O01)
+2 ; Message used to either release a hold on a Veteran ID Card (VIC)
+3 ; request or cancel the VIC request.
+4 ;
+5 ; Input:
+6 ; DGRIEN - pointer VIC REQUEST (#39.6) file
+7 ;
+8 ; Output:
+9 ; Function result - '1' on success; '0' on failure
+10 ; DGERR - undefined on success; error message string on failure
+11 ;
+12 ;event protocol ID
NEW DGHLEID
+13 ;result from GENERATE API
NEW DGHLRSLT
+14 ;VIC REQUEST data array
NEW DGREQ
+15 ;HL7 message text array name
NEW DGROOT
+16 ;function result
NEW DGRSLT
+17 ;
+18 SET DGROOT=$NAME(^TMP("HLS",$JOB))
+19 KILL @DGROOT
+20 ;
+21 SET DGRSLT=0
+22 ;
+23 IF $GET(DGRIEN)>0
Begin DoDot:1
+24 ;
+25 ;initialize HL7 environment
+26 SET DGHLEID=$$INIT^DGQEHLUT("DGQE VIC ORM/O01 EVENT",.DGHL)
+27 IF 'DGHLEID
SET DGERR="Unable to initialize HL7 environment"
+28 IF $DATA(DGERR)
QUIT
+29 ;
+30 ;retrieve VIC REQUEST file record
+31 IF '$$GETREQ^DGQEREQ(DGRIEN,.DGREQ)
Begin DoDot:2
+32 SET DGERR="Unable to retrieve VIC REQUEST data"
End DoDot:2
+33 IF $DATA(DGERR)
QUIT
+34 ;
+35 ;build ORM message
+36 IF '$$BLDORM(.DGREQ,DGROOT,.DGHL)
Begin DoDot:2
+37 SET DGERR="Unable to build ORM message text"
End DoDot:2
+38 IF $DATA(DGERR)
QUIT
+39 ;
+40 ;transmit the message
+41 DO GENERATE^HLMA(DGHLEID,$SELECT(DGROOT["^":"GM",1:"LM"),1,.DGHLRSLT)
+42 IF +$PIECE(DGHLRSLT,U,2)
SET DGERR=$PIECE(DGHLRSLT,U,2)
+43 IF $DATA(DGERR)
QUIT
+44 ;
+45 ;set transmission log
+46 DO STOXMIT^DGQEHLL($PIECE(DGHLRSLT,U),DGRIEN)
+47 ;
+48 ;clear transmission required flag
+49 DO XMITOFF^DGQEDD(DGRIEN)
+50 ;
+51 SET DGRSLT=1
End DoDot:1
+52 ;
+53 KILL @DGROOT
+54 ;
+55 QUIT DGRSLT
+56 ;
BLDORM(DGREQ,DGROOT,DGHL) ;build segments for a single ORM message
+1 ;
+2 ; Input:
+3 ; DGREQ - (required) VIC REQUEST data array
+4 ; DGROOT - (required) closed root array name to contain segments
+5 ; DGHL - VistA HL7 environment array
+6 ;
+7 ; Output:
+8 ; Function value - "1" on sucess; "0" on failure
+9 ;
+10 ;Patient ID field 3 of PID segment
NEW DGPTID
+11 ;function result
NEW DGRSLT
+12 ;segment counter
NEW DGSEG
+13 ;formatted segment string
NEW DGSEGSTR
+14 ;comma-delimited list of segment fields
NEW DGSTR
+15 ;
+16 SET DGRSLT=0
+17 SET DGSEG=0
+18 IF $DATA(DGREQ)
IF $GET(DGROOT)]""
IF $DATA(DGHL)
Begin DoDot:1
+19 IF '$GET(DGREQ("DFN"))
QUIT
+20 IF '$DATA(^DPT(DGREQ("DFN")))
QUIT
+21 IF $GET(DGREQ("CARDID"))']""
QUIT
+22 ;
+23 ;build PID segment
+24 ;{3=ICN,5=NAME,7=DOB,19=SSN}
SET DGSTR="1,2,3,5,7,19"
+25 SET DGSEGSTR=$$EN^VAFHLPID(DGREQ("DFN"),DGSTR,1,1)
+26 IF (DGSEGSTR="")
QUIT
+27 ;set Patient ID field 3 Check Digit component to null
+28 SET DGPTID=$PIECE(DGSEGSTR,DGHL("FS"),4)
+29 SET $PIECE(DGPTID,$EXTRACT(DGHL("ECH")),2)=""
+30 SET $PIECE(DGSEGSTR,DGHL("FS"),4)=DGPTID
+31 SET DGSEG=DGSEG+1
SET @DGROOT@(DGSEG)=DGSEGSTR
+32 ;
+33 ;build ORC segment
+34 SET DGSTR="1"
+35 SET DGSEGSTR=$$ORC^DGQEHLOR(.DGREQ,DGSTR,.DGHL)
+36 IF (DGSEGSTR="")
QUIT
+37 SET DGSEG=DGSEG+1
SET @DGROOT@(DGSEG)=DGSEGSTR
+38 ;
+39 ;build RQD segment
+40 SET DGSTR="1,3"
+41 SET DGSEGSTR=$$RQD^DGQEHLRQ(.DGREQ,DGSTR,.DGHL)
+42 IF (DGSEGSTR="")
QUIT
+43 SET DGSEG=DGSEG+1
SET @DGROOT@(DGSEG)=DGSEGSTR
+44 ;
+45 ;build NTE segment for POW and PH
+46 SET DGSTR="3"
+47 SET DGSEGSTR=$$NTE^DGQEHLNT(.DGREQ,DGSTR,.DGHL)
+48 IF (DGSEGSTR="")
QUIT
+49 SET DGSEG=DGSEG+1
SET @DGROOT@(DGSEG)=DGSEGSTR
+50 ;
+51 ;success
+52 SET DGRSLT=1
End DoDot:1
+53 ;
+54 QUIT DGRSLT
