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

DGPFHLR.m

Go to the documentation of this file. 
  1. DGPFHLR ;ALB/RPM - PRF HL7 RECEIVE DRIVERS ; 8/14/06 12:01pm
  1.  ;;5.3;Registration;**425,650,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. RCV ;Receive all message types and route to message specific receiver
  1.  ;
  1.  ;This procedure is the main driver entry point for receiving all
  1.  ;message types (ORU, ACK, QRY and ORF) for patient record flag
  1.  ;assignment sharing.
  1.  ;
  1.  ;All procedures and functions assume that all VistA HL7 environment
  1.  ;variables are properly initialized and will produce a fatal error if
  1.  ;they are missing.
  1.  ;
  1.  ;The received message is copied to a temporary work global for
  1.  ;processing.  The message type is determined from the MSH segment and
  1.  ;a receive processing procedure specific to the message type is called.
  1.  ;(Ex. ORU~R01 message calls procedure: RCVORU).  The specific receive
  1.  ;processing procedure calls a message specific parse procedure to
  1.  ;validate the message data and return data arrays for storage.  If no
  1.  ;parse errors are reported during validation, then the data arrays are
  1.  ;stored by the receive processing procedure.  Control, along with any
  1.  ;parse validation errors, is then passed to the message specific send
  1.  ;processing procedures to build and transmit the acknowledgment and
  1.  ;query results messages.
  1.  ;
  1.  ;  The message specific procedures are as follows:
  1.  ;
  1.  ;  Message   Receive Procedure   Parse Procedure    Send Procedure
  1.  ;  -------   -----------------   ----------------    --------------
  1.  ;  ORU~R01   RCVORU^DGPFHLR      PARSORU^DGPFHLU    SNDACK^DGPFHLS
  1.  ;  ACK~R01   RCVACK^DGPFHLR      PARSACK^DGPFHLU4   N/A
  1.  ;  QRY~R02   RCVQRY^DGPFHLR      PARSQRY^DGPFHLQ3   SNDORF^DGPFHLS
  1.  ;  ORF~R04   RCVORF^DGPFHLR      PARSORF^DGPFHLQ3   N/A
  1.  ;
  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 "MSH"
  1.  I $$NXTSEG^DGPFHLUT(DGWRK,0,HL("FS"),.DGSEG),$G(DGSEG("TYPE"))="MSH" D
  1.  . S DGMSGTYP=$P(DGSEG(9),$E(HL("ECH"),1),1)
  1.  . ;HLMTIENS is only required by RCVORU and RCVQRY, thus $GET
  1.  . I DGMSGTYP=HL("MTN") D @("RCV"_DGMSGTYP_"(DGWRK,$G(HLMTIENS),.HL)")
  1.  ;
  1.  ;cleanup
  1.  K @DGWRK
  1.  Q
  1.  ;
  1. RCVORU(DGWRK,DGMIEN,DGHL) ;Receive ORU Message Types (ORU~R01)
  1.  ;
  1.  ;  Input:
  1.  ;    DGWRK - name of work global containing segments
  1.  ;   DGMIEN - IEN of message entry in file #773
  1.  ;     DGHL - HL environment array
  1.  ;
  1.  ;  Output:
  1.  ;    none
  1.  ;
  1.  N DGORU
  1.  N DGSEGERR
  1.  N DGSTOERR   ;store error array
  1.  N DGACKTYP
  1.  ;
  1.  S DGORU=$NA(^TMP("DGPF",$J))
  1.  K @DGORU
  1.  D PARSORU^DGPFHLU(DGWRK,.DGHL,DGORU,.DGSEGERR)
  1.  ;
  1.  I '$D(DGSEGERR),$$STOORU(DGORU,.DGSTOERR) D
  1.  . S DGACKTYP="AA"
  1.  E  D
  1.  . S DGACKTYP="AE"
  1.  ;
  1.  D SNDACK^DGPFHLS(DGACKTYP,DGMIEN,.DGHL,.DGSEGERR,.DGSTOERR)
  1.  ;
  1.  ;cleanup
  1.  K @DGORU
  1.  Q
  1.  ;
  1. STOORU(DGORU,DGERR) ;store ORU data array
  1.  ;
  1.  ;  Input:
  1.  ;    DGORU - parsed ORU segment data array
  1.  ;    
  1.  ;  Output:
  1.  ;   Function value - 1 on success; 0 on failure
  1.  ;            DGERR - defined on failure
  1.  ;    
  1.  N DGADT     ;assignment date
  1.  N DGCNT     ;count of assignment histories sent
  1.  N DGPFA     ;assignment data array
  1.  N DGPFAH    ;assignment history data array
  1.  N DGSINGLE  ;flag to indicate a single history update
  1.  ;
  1.  ;
  1.  S DGPFA("SNDFAC")=$G(@DGORU@("SNDFAC"))
  1.  S DGPFA("DFN")=$G(@DGORU@("DFN"))
  1.  S DGPFA("FLAG")=$G(@DGORU@("FLAG"))
  1.  ;
  1.  ;init STATUS as a placeholder, $$STATUS^DGPFUT sets value in loop
  1.  S DGPFA("STATUS")=""
  1.  S DGPFA("OWNER")=$G(@DGORU@("OWNER"))
  1.  S DGPFA("ORIGSITE")=$G(@DGORU@("ORIGSITE"))
  1.  M DGPFA("NARR")=@DGORU@("NARR")
  1.  ;
  1.  ;count number of assignment histories sent
  1.  S (DGADT,DGCNT)=0
  1.  F  S DGADT=$O(@DGORU@(DGADT)) Q:'DGADT  S DGCNT=DGCNT+1
  1.  S DGSINGLE=$S(DGCNT>1:0,1:1)
  1.  S DGADT=0
  1.  ;
  1.  ;process only the last history action when assignment already exists 
  1.  I 'DGSINGLE,$$FNDASGN^DGPFAA(DGPFA("DFN"),DGPFA("FLAG")) D
  1.  . S DGADT=+$O(@DGORU@($O(@DGORU@(9999999.999999),-1)),-1)
  1.  . S DGSINGLE=1
  1.  ;
  1.  F  S DGADT=$O(@DGORU@(DGADT)) Q:'DGADT  D  Q:$D(DGERR)
  1.  . N DGPFAH   ;assignment history data array
  1.  . ;
  1.  . S DGPFAH("ASSIGNDT")=DGADT
  1.  . S DGPFAH("ACTION")=$G(@DGORU@(DGADT,"ACTION"))
  1.  . S DGPFAH("ENTERBY")=.5  ;POSTMASTER
  1.  . S DGPFAH("APPRVBY")=.5  ;POSTMASTER
  1.  . M DGPFAH("COMMENT")=@DGORU@(DGADT,"COMMENT")
  1.  . ;
  1.  . ;calculate the assignment STATUS from the ACTION
  1.  . S DGPFA("STATUS")=$$STATUS^DGPFUT(DGPFAH("ACTION"))
  1.  . ;validate before filing for single updates and new assignments
  1.  . I DGSINGLE!(DGPFAH("ACTION")=1) D
  1.  . . I $$STOHL7^DGPFAA3(.DGPFA,.DGPFAH,"DGERR")
  1.  . ;otherwise, just file it
  1.  . E  D
  1.  . . I $$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGERR)
  1.  ;
  1.  ;convert dialog to dialog code
  1.  I $D(DGERR) S DGERR=$G(DGERR("DIERR",1))
  1.  ;
  1.  Q '$D(DGERR)
  1.  ;
  1. RCVACK(DGWRK,DGMIEN,DGHL) ;Receive ACK Message Types (ACK~R01)
  1.  ;
  1.  ;  Input:
  1.  ;    DGWRK - name of work global containing segments
  1.  ;   DGMIEN - IEN of message entry in file #773
  1.  ;     DGHL - HL environment array
  1.  ;
  1.  ;  Output:
  1.  ;    none
  1.  ;
  1.  N DGACK   ;ACK data array
  1.  N DGERR   ;error array
  1.  N DGLIEN  ;HL7 transmission log IEN
  1.  ;
  1.  D PARSACK^DGPFHLU4(DGWRK,.DGHL,.DGACK,.DGERR)
  1.  S DGLIEN=$$FNDLOG^DGPFHLL(26.17,$G(DGACK("MSGID")))
  1.  Q:'DGLIEN
  1.  ;
  1.  I $G(DGACK("ACKCODE"))="AA" D
  1.  . D STOSTAT^DGPFHLL(26.17,DGLIEN,"A",.DGERR)
  1.  E  D
  1.  . ;update transmission log status (REJECTED) and process error
  1.  . D STOSTAT^DGPFHLL(26.17,DGLIEN,"RJ",.DGERR)
  1.  . D PROCERR^DGPFHLU5(DGLIEN,.DGACK,.DGERR)
  1.  Q
  1.  ;
  1. RCVQRY(DGWRK,DGMIEN,DGHL) ;Receive QRY Message Types (QRY~R02)
  1.  ;
  1.  ;  Input:
  1.  ;    DGWRK - name of work global containing segments
  1.  ;   DGMIEN - IEN of message entry in file #773
  1.  ;     DGHL - HL environment array
  1.  ;
  1.  ;  Output:
  1.  ;    none
  1.  ;
  1.  N DGDFN
  1.  N DGDFNERR
  1.  N DGQRY
  1.  N DGQRYERR
  1.  N DGSEGERR
  1.  ;
  1.  D PARSQRY^DGPFHLQ3(DGWRK,.DGHL,.DGQRY,.DGSEGERR)
  1.  S DGDFN=$$GETDFN^DGPFUT2(DGQRY("ICN"),"DGDFNERR")
  1.  I DGDFN'>0,$G(DGDFNERR("DIERR",1))]"" D
  1.  . S DGQRYERR=DGDFNERR("DIERR",1)
  1.  D SNDORF^DGPFHLS(.DGQRY,DGMIEN,.DGHL,DGDFN,.DGSEGERR,.DGQRYERR)
  1.  Q
  1.  ;
  1. RCVORF(DGWRK,DGMIEN,DGHL) ;Receive ORF Message Types (ORF~R04)
  1.  ;
  1.  ;  Input:
  1.  ;    DGWRK - name of work global containing segments
  1.  ;   DGMIEN - IEN of message entry in file #773
  1.  ;     DGHL - HL environment array
  1.  ;
  1.  ;  Output:
  1.  ;    none
  1.  ;
  1.  N DGDFN   ;pointer to PATIENT (#2) file
  1.  N DGLIEN  ;HL7 query log IEN
  1.  N DGORF   ;ORF data array root
  1.  N DGERR   ;parser error array
  1.  N DGSTAT  ;query log status
  1.  ;
  1.  S DGORF=$NA(^TMP("DGPF",$J))
  1.  K @DGORF
  1.  D PARSORF^DGPFHLQ4(DGWRK,.DGHL,DGORF,.DGERR)
  1.  S DGDFN=+$$GETDFN^MPIF001($G(@DGORF@("ICN")))
  1.  ;
  1.  ;successful query
  1.  I $G(@DGORF@("ACKCODE"))="AA" D
  1.  . S DGSTAT=$S(+$O(@DGORF@(0))>0:"A",1:"AN")
  1.  . ;
  1.  . ;REJECT when filer fails; otherwise mark event as COMPLETE
  1.  . I '$$STOORF(DGDFN,DGORF) D
  1.  . . S DGSTAT="RJ"
  1.  . . S DGERR($O(DGERR(""),-1)+1)=261120  ;Unable to file
  1.  . E  D STOEVNT^DGPFHLL1(DGDFN,"C")
  1.  ;
  1.  ;failed query
  1.  I $G(@DGORF@("ACKCODE"))'="AA" S DGSTAT="RJ"
  1.  ;
  1.  ;find and update query log status
  1.  S DGLIEN=$$FNDLOG^DGPFHLL(26.19,$G(@DGORF@("MSGID")))
  1.  I DGLIEN D STOSTAT^DGPFHLL(26.19,DGLIEN,DGSTAT,.DGERR)
  1.  ;
  1.  ;purge PRF HL7 QUERY LOG when status is COMPLETE
  1.  I $$GETSTAT^DGPFHLL1(DGDFN)="C" D PRGQLOG^DGPFHLL($$FNDEVNT^DGPFHLL1(DGDFN))
  1.  ;
  1.  ;cleanup
  1.  K @DGORF
  1.  Q
  1.  ;
  1. STOORF(DGDFN,DGORF,DGERR) ;store ORF data
  1.  ;
  1.  ;  Input:
  1.  ;    DGDFN - pointer to patient in PATIENT (#2) file
  1.  ;    DGORF - parsed ORF segments data array
  1.  ;
  1.  ;  Output:
  1.  ;   Function value - 1 on success; 0 on failure
  1.  ;    DGERR - defined on failure
  1.  ;
  1.  N DGADT     ;activity date ("ASSIGNDT")
  1.  N DGPFA     ;assignment data array
  1.  N DGPFAH    ;assignment history data array
  1.  N DGSET     ;set id to represent a single PRF assignment
  1.  ;
  1.  ;
  1.  S DGSET=0
  1.  F  S DGSET=$O(@DGORF@(DGSET)) Q:'DGSET  D
  1.  . N DGPFA   ;assignment data array
  1.  . ;
  1.  . S DGPFA("DFN")=DGDFN
  1.  . S DGPFA("FLAG")=$G(@DGORF@(DGSET,"FLAG"))
  1.  . Q:DGPFA("FLAG")']""
  1.  . ;
  1.  . ;prevent overwriting existing assignments
  1.  . Q:$$FNDASGN^DGPFAA(DGPFA("DFN"),DGPFA("FLAG"))
  1.  . ;
  1.  . ;init STATUS as a placeholder, $$STATUS^DGPFUT sets value in loop
  1.  . S DGPFA("STATUS")=""
  1.  . S DGPFA("OWNER")=$G(@DGORF@(DGSET,"OWNER"))
  1.  . S DGPFA("ORIGSITE")=$G(@DGORF@(DGSET,"ORIGSITE"))
  1.  . M DGPFA("NARR")=@DGORF@(DGSET,"NARR")
  1.  . S DGADT=0  ;each DGADT represents a single PRF history action
  1.  . F  S DGADT=$O(@DGORF@(DGSET,DGADT)) Q:'DGADT  D  Q:$D(DGERR)
  1.  . . N DGPFAH   ;assignment history data array
  1.  . . ;
  1.  . . S DGPFAH("ASSIGNDT")=DGADT
  1.  . . S DGPFAH("ACTION")=$G(@DGORF@(DGSET,DGADT,"ACTION"))
  1.  . . S DGPFAH("ENTERBY")=.5  ;POSTMASTER
  1.  . . S DGPFAH("APPRVBY")=.5  ;POSTMASTER
  1.  . . M DGPFAH("COMMENT")=@DGORF@(DGSET,DGADT,"COMMENT")
  1.  . . ;
  1.  . . ;calculate the assignment STATUS from the ACTION
  1.  . . S DGPFA("STATUS")=$$STATUS^DGPFUT(DGPFAH("ACTION"))
  1.  . . I $$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGERR)
  1.  Q '$D(DGERR)