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

DGQEHLR.m

Go to the documentation of this file. 
  1. DGQEHLR ;ALB/RPM - VIC REPLACEMENT HL7 RECEIVE DRIVER ; 10/6/03
  1.  ;;5.3;Registration;**571,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. RCV ;
  1.  N DGCNT
  1.  N DGMSGTYP
  1.  N DGSEG
  1.  N DGSEGCNT
  1.  N DGWRK
  1.  ;
  1.  S DGWRK=$NA(^TMP("DGPFHL7",$J))
  1.  K @DGWRK
  1.  ;
  1.  ;load work global with segments
  1.  F DGSEGCNT=1:1 X HLNEXT Q:HLQUIT'>0  D
  1.  . S DGCNT=0
  1.  . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE
  1.  . F  S DGCNT=$O(HLNODE(DGCNT)) Q:'DGCNT  D
  1.  . . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT)
  1.  ;
  1.  ;get message type from first segment
  1.  I $$NXTSEG^DGQEHLUT(DGWRK,0,HL("FS"),.DGSEG),$G(DGSEG("TYPE"))="MSH" D
  1.  . S DGMSGTYP=$P(DGSEG(9),$E(HL("ECH"),1),1)
  1.  . I DGMSGTYP=HL("MTN") D RCVORR(DGWRK,.HL)
  1.  ;
  1.  ;cleanup
  1.  K @DGWRK
  1.  Q
  1.  ;
  1. RCVORR(DGWRK,DGHL) ;process a single ORR~O02 message
  1.  ;
  1.  ;  Input:
  1.  ;    DGWRK - temporary segment work array
  1.  ;     DGHL - VistA HL7 environment array
  1.  ;
  1.  ;  Output:
  1.  ;    none
  1.  ;
  1.  N DGORR
  1.  N DGLIEN
  1.  N DGSTAT
  1.  ;
  1.  D PARSORR(DGWRK,.DGHL,.DGORR)
  1.  ;
  1.  I +$G(DGORR("MSGID")),$G(DGORR("ACKCODE"))]"" D
  1.  . S DGLIEN=$$FINDMID^DGQEHLL(DGORR("MSGID"))
  1.  . Q:'DGLIEN
  1.  . ;
  1.  . I DGORR("ACKCODE")="AA" S DGSTAT="A"
  1.  . E  D
  1.  . . S DGSTAT="RJ"
  1.  . . ;send bulletin indicating failed NCMD update
  1.  . . D SENDBULL(DGLIEN,.DGORR)
  1.  . ;
  1.  . ;remove "H"old event entry from VIC HL7 TRANSMISSION LOG (#39.6) file
  1.  . D STOACK^DGQEHLL(DGLIEN,DGSTAT)
  1.  ;
  1.  Q
  1.  ;
  1. PARSORR(DGWRK,DGHL,DGORR) ;Parse ORR Message/Segments
  1.  ;
  1.  ;  Input:
  1.  ;    DGWRK - Closed root work global reference
  1.  ;     DGHL - HL7 environment array
  1.  ;
  1.  ;  Output:
  1.  ;    DGORR - array of ACK results
  1.  ;
  1.  N DGFS
  1.  N DGCS
  1.  N DGRS
  1.  N DGSS
  1.  N DGCURLIN
  1.  ;
  1.  S DGFS=DGHL("FS")
  1.  S DGCS=$E(DGHL("ECH"),1)
  1.  S DGRS=$E(DGHL("ECH"),2)
  1.  S DGSS=$E(DGHL("ECH"),4)
  1.  S DGCURLIN=0
  1.  ;
  1.  ;loop through the message segments and retrieve the field data
  1.  F  D  Q:'DGCURLIN
  1.  . N DGSEG
  1.  . S DGCURLIN=$$NXTSEG^DGQEHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG)
  1.  . Q:'DGCURLIN
  1.  . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGORR)")
  1.  Q
  1.  ;
  1. MSH(DGSEG,DGCS,DGRS,DGSS,DGORR) ;
  1.  ;
  1.  ;  Input:
  1.  ;    DGSEG - MSH segment field array
  1.  ;     DGCS - HL7 component separator
  1.  ;     DGRS - HL7 repetition separator
  1.  ;     DGSS - HL7 sub-component separator
  1.  ;
  1.  ;  Output:
  1.  ;    DGORR - array of ACK results
  1.  ;            "SNDFAC" - sending facility
  1.  ;            "RCVFAC" - receiving facility
  1.  ;            "MSGDTM" - message creation date/time in FileMan format
  1.  ;
  1.  S DGORR("SNDFAC")=$P($G(DGSEG(4)),DGCS,1)
  1.  S DGORR("RCVFAC")=$P($G(DGSEG(6)),DGCS,1)
  1.  S DGORR("MSGDTM")=$$HL7TFM^XLFDT($G(DGSEG(7)))
  1.  Q
  1.  ;
  1. MSA(DGSEG,DGCS,DGRS,DGSS,DGORR) ;
  1.  ;
  1.  ;  Input:
  1.  ;    DGSEG - MSH segment field array
  1.  ;     DGCS - HL7 component separator
  1.  ;     DGRS - HL7 repetition separator
  1.  ;     DGSS - HL7 sub-component separator
  1.  ;
  1.  ;  Output:
  1.  ;    DGORR - array of ACK results
  1.  ;            "ACKCODE" - Acknowledgment code
  1.  ;            "MSGID" - Message Control ID of the message being ACK'ed
  1.  ;            "ERR",# - Error field defined on failure
  1.  ;
  1.  N DGCNT
  1.  ;
  1.  S DGORR("ACKCODE")=$G(DGSEG(1))
  1.  S DGORR("MSGID")=$G(DGSEG(2))
  1.  I DGORR("ACKCODE")'="AA",$G(DGSEG(6))]"" D
  1.  . S DGCNT=$O(DGORR("ERR",""),-1),DGCNT=DGCNT+1
  1.  . S DGORR("ERR",DGCNT)=$P(DGSEG(6),DGCS,1)
  1.  Q
  1.  ;
  1. SENDBULL(DGLIEN,DGORR) ;build and send error bulletin
  1.  ;
  1.  ;  Input:
  1.  ;    DGLIEN - IEN of VIC HL7 TRANSMISSION LOG (#39.7)
  1.  ;     DGORR - array of parsed ACK results
  1.  ;            "SNDFAC" - sending facility
  1.  ;            "RCVFAC" - receiving facility
  1.  ;            "MSGDTM" - message creation date/time in FileMan format
  1.  ;            "ACKCODE" - Acknowledgment code
  1.  ;            "MSGID" - Message Control ID of the message being ACK'ed
  1.  ;            "ERR",# - Error field defined on failure
  1.  ;
  1.  ;  Output:
  1.  ;    none
  1.  ;
  1.  N XMB    ;name of bulletin and parameter array
  1.  N XMDUZ  ;sending user
  1.  N XMSUB  ;bulletin subject
  1.  N XMTEXT  ;additional text for rejection reasons
  1.  N DGLOG  ;VIC HL7 TRANSMISSION LOG data array
  1.  N DGREQ  ;VIC REQUEST data array
  1.  ;
  1.  I +$G(DGLIEN) D
  1.  . ;
  1.  . ;retrieve HL7 LOG data
  1.  . Q:'$$GETLOG^DGQEHLL(DGLIEN,.DGLOG)
  1.  . ;
  1.  . ;retrieve VIC REQUEST data
  1.  . Q:'$$GETREQ^DGQEREQ($G(DGLOG("REQIEN")),.DGREQ)
  1.  . ;
  1.  . ;load bulletin params
  1.  . S XMB(1)=$$FMTE^XLFDT($$NOW^XLFDT())
  1.  . S XMB(2)=$G(DGREQ("NAME"))
  1.  . S XMB(3)=$G(DGREQ("CARDID"))
  1.  . S XMB(4)=$S($G(DGREQ("CPRSTAT"))="P":"Release and print previously held VIC request",1:"Cancel VIC request")
  1.  . S XMB(5)=$G(DGLOG("HLMID"))
  1.  . S XMB(6)=$$FMTE^XLFDT($G(DGLOG("XMITDT")))
  1.  . I $D(DGORR("ERR")) D
  1.  . . S XMTEXT=$NA(^TMP("DGQEBULL",$J))
  1.  . . K @XMTEXT
  1.  . . S @XMTEXT@(1)=" "
  1.  . . S @XMTEXT@(2)="  Reason(s) for rejection:"
  1.  . . S DGCNT=0
  1.  . . F  S DGCNT=$O(DGORR("ERR",DGCNT)) Q:'DGCNT  D
  1.  . . . S @XMTEXT@(DGCNT+2)="    #"_DGCNT_":"_" "_DGORR("ERR",DGCNT)
  1.  . ;
  1.  . S XMB="DGQE HL7ERR"
  1.  . S XMDUZ="VIC NCMD HL7 INTERFACE MODULE"
  1.  . S XMSUB="VIC HL7 ERROR"
  1.  . D ^XMB
  1.  . I $G(XMTEXT)]"" K @XMTEXT
  1.  Q