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

DGQEHLS.m

Go to the documentation of this file. 
  1. DGQEHLS ;ALB/RPM - VIC REPLACEMENT HL7 SEND DRIVER ; 10/13/05
  1.  ;;5.3;Registration;**571,679,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  Q  ;no direct entry
  1.  ;
  1. SND(DGRIEN,DGERR) ;Send a single ORM orders message
  1.  ; This function builds and transmits a General Order (ORM~O01)
  1.  ; Message used to either release a hold on a Veteran ID Card (VIC)
  1.  ; request or cancel the VIC request.
  1.  ;
  1.  ;  Input:
  1.  ;    DGRIEN - pointer VIC REQUEST (#39.6) file
  1.  ;
  1.  ;  Output:
  1.  ;    Function result - '1' on success; '0' on failure
  1.  ;    DGERR - undefined on success; error message string on failure
  1.  ;
  1.  N DGHLEID   ;event protocol ID
  1.  N DGHLRSLT  ;result from GENERATE API
  1.  N DGREQ     ;VIC REQUEST data array
  1.  N DGROOT    ;HL7 message text array name
  1.  N DGRSLT    ;function result
  1.  ;
  1.  S DGROOT=$NA(^TMP("HLS",$J))
  1.  K @DGROOT
  1.  ;
  1.  S DGRSLT=0
  1.  ;
  1.  I $G(DGRIEN)>0 D
  1.  . ;
  1.  . ;initialize HL7 environment
  1.  . S DGHLEID=$$INIT^DGQEHLUT("DGQE VIC ORM/O01 EVENT",.DGHL)
  1.  . I 'DGHLEID S DGERR="Unable to initialize HL7 environment"
  1.  . Q:$D(DGERR)
  1.  . ;
  1.  . ;retrieve VIC REQUEST file record
  1.  . I '$$GETREQ^DGQEREQ(DGRIEN,.DGREQ) D
  1.  . . S DGERR="Unable to retrieve VIC REQUEST data"
  1.  . Q:$D(DGERR)
  1.  . ;
  1.  . ;build ORM message
  1.  . I '$$BLDORM(.DGREQ,DGROOT,.DGHL) D
  1.  . . S DGERR="Unable to build ORM message text"
  1.  . Q:$D(DGERR)
  1.  . ;
  1.  . ;transmit the message
  1.  . D GENERATE^HLMA(DGHLEID,$S(DGROOT["^":"GM",1:"LM"),1,.DGHLRSLT)
  1.  . I +$P(DGHLRSLT,U,2) S DGERR=$P(DGHLRSLT,U,2)
  1.  . Q:$D(DGERR)
  1.  . ;
  1.  . ;set transmission log
  1.  . D STOXMIT^DGQEHLL($P(DGHLRSLT,U),DGRIEN)
  1.  . ;
  1.  . ;clear transmission required flag
  1.  . D XMITOFF^DGQEDD(DGRIEN)
  1.  . ;
  1.  . S DGRSLT=1
  1.  ;
  1.  K @DGROOT
  1.  ;
  1.  Q DGRSLT
  1.  ;
  1. BLDORM(DGREQ,DGROOT,DGHL) ;build segments for a single ORM message
  1.  ;
  1.  ;  Input:
  1.  ;    DGREQ - (required) VIC REQUEST data array
  1.  ;   DGROOT - (required) closed root array name to contain segments
  1.  ;     DGHL - VistA HL7 environment array
  1.  ;
  1.  ;  Output:
  1.  ;    Function value - "1" on sucess; "0" on failure
  1.  ;
  1.  N DGPTID    ;Patient ID field 3 of PID segment
  1.  N DGRSLT    ;function result
  1.  N DGSEG     ;segment counter
  1.  N DGSEGSTR  ;formatted segment string
  1.  N DGSTR     ;comma-delimited list of segment fields
  1.  ;
  1.  S DGRSLT=0
  1.  S DGSEG=0
  1.  I $D(DGREQ),$G(DGROOT)]"",$D(DGHL) D
  1.  . Q:'$G(DGREQ("DFN"))
  1.  . Q:'$D(^DPT(DGREQ("DFN")))
  1.  . Q:$G(DGREQ("CARDID"))']""
  1.  . ;
  1.  . ;build PID segment
  1.  . S DGSTR="1,2,3,5,7,19"  ;{3=ICN,5=NAME,7=DOB,19=SSN}
  1.  . S DGSEGSTR=$$EN^VAFHLPID(DGREQ("DFN"),DGSTR,1,1)
  1.  . Q:(DGSEGSTR="")
  1.  . ;set Patient ID field 3 Check Digit component to null
  1.  . S DGPTID=$P(DGSEGSTR,DGHL("FS"),4)
  1.  . S $P(DGPTID,$E(DGHL("ECH")),2)=""
  1.  . S $P(DGSEGSTR,DGHL("FS"),4)=DGPTID
  1.  . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
  1.  . ;
  1.  . ;build ORC segment
  1.  . S DGSTR="1"
  1.  . S DGSEGSTR=$$ORC^DGQEHLOR(.DGREQ,DGSTR,.DGHL)
  1.  . Q:(DGSEGSTR="")
  1.  . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
  1.  . ;
  1.  . ;build RQD segment
  1.  . S DGSTR="1,3"
  1.  . S DGSEGSTR=$$RQD^DGQEHLRQ(.DGREQ,DGSTR,.DGHL)
  1.  . Q:(DGSEGSTR="")
  1.  . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
  1.  . ;
  1.  . ;build NTE segment for POW and PH
  1.  . S DGSTR="3"
  1.  . S DGSEGSTR=$$NTE^DGQEHLNT(.DGREQ,DGSTR,.DGHL)
  1.  . Q:(DGSEGSTR="")
  1.  . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR
  1.  . ;
  1.  . ;success
  1.  . S DGRSLT=1
  1.  ;
  1.  Q DGRSLT