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

DGPFHLT3.m

Go to the documentation of this file. 
  1. DGPFHLT3 ;SHRPE/YMG - PRF HL7 QBP/RSP PROCESSING ; 05/02/18
  1.  ;;5.3;Registration;**951**;Aug 13, 1993;Build 135
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; This is the main driver for processing RSP^K11 (response to PRF flag transfer request) messages
  1.  ;
  1.  Q
  1.  ;
  1. EN ; entry point
  1.  ; called from EN^DGPFHLT1, uses ^TMP("DGPFHLT1,$J") work global created there.
  1.  ;
  1.  N DGERR,DGFDA,DGFERR,ERTXT,IENS,LOGIEN,MAILARY,MAILPFA,MSGID,REQID,SEGCNT,SEGNM,SEGSTR,SNDFAC,STOP
  1.  ;
  1.  S STOP=0,DGERR=""
  1.  ; parse the message
  1.  S SEGCNT="" F  S SEGCNT=$O(^TMP("DGPFHLT1",$J,SEGCNT)) Q:SEGCNT=""  D  Q:STOP
  1.  .S SEGSTR=$G(^TMP("DGPFHLT1",$J,SEGCNT,0))
  1.  .S SEGNM=$P(SEGSTR,HLFS)
  1.  .I SEGNM="MSH" D
  1.  ..; parse MSH segment
  1.  ..S SNDFAC=$P($P(SEGSTR,HLFS,4),HLCMP) ; sending facility (station #) for use in error messages
  1.  ..S MSGID=$P(SEGSTR,HLFS,10) ; HL7 message Id
  1.  ..Q
  1.  .I SEGNM="QAK" D  Q:STOP
  1.  ..; parse QAK segment
  1.  ..S REQID=$P(SEGSTR,HLFS,2) ; query Id
  1.  ..S LOGIEN=$$FNDLOG(REQID) I 'LOGIEN D  Q
  1.  ...S DGERR="Unable to find log entry for query id "_REQID
  1.  ...D SENDERR(MSGID,SNDFAC,"",DGERR)
  1.  ...S STOP=1
  1.  ...Q
  1.  ..S IENS=LOGIEN_","
  1.  ..I DGERR="",$P(SEGSTR,HLFS,3)'="OK" S DGERR="Receiver was unable to find corresponding PRF flag assignment."
  1.  ..Q
  1.  .I SEGNM="QPD" D
  1.  ..; parse QPD segment
  1.  ..S MAILARY("REVBY")=$$DECHL7^DGPFHLUT($P(SEGSTR,HLFS,6)) ; reviewer name
  1.  ..S MAILARY("REVDTM")=$$FMDATE^HLFNC($P(SEGSTR,HLFS,7)) ; review date/time
  1.  ..Q
  1.  .I SEGNM="NTE" D
  1.  ..; parse NTE segment
  1.  ..S MAILARY("REVRES")=$P($P(SEGSTR,HLFS,4),HLREP) ; result of the review
  1.  ..S MAILARY("REVCMT")=$$DECHL7^DGPFHLUT($P($P(SEGSTR,HLFS,4),HLREP,2)) ; review reason
  1.  ..Q
  1.  .Q
  1.  S MAILARY("REVRES")=$G(MAILARY("REVRES"))
  1.  I "^A^D^"'[(U_MAILARY("REVRES")_U),DGERR="" S DGERR="Invalid review status code received."
  1.  ; send ACK message
  1.  D SEND^DGPFHLT4(MSGID,DGERR)
  1.  ; update log entry
  1.  I $G(IENS) D UPDLOG(IENS,DGERR,.MAILARY,.DGFERR)
  1.  I DGERR'=""!$D(DGFERR) D  G ENX
  1.  .; Send Mailman notification for error
  1.  .D:DGERR'="" SENDERR(MSGID,SNDFAC,"",DGERR)
  1.  .D:$D(DGFERR) SENDERR(MSGID,SNDFAC,$G(DGFERR("DIERR",1)),$G(DGFERR("DIERR",1,"TEXT",1)))
  1.  .Q
  1.  ; finish setting up data structures for DGPFHLTM and send Mailman notification about response
  1.  K DGFDA D GETS^DIQ(26.22,IENS,".01:.04;2.01",,"DGFDA")
  1.  S MAILARY("REQDTM")=$G(DGFDA(26.22,IENS,.01))
  1.  S MAILARY("REQBY")=$G(DGFDA(26.22,IENS,.02))
  1.  S MAILARY("REQCMT")=$G(DGFDA(26.22,IENS,2.01))
  1.  ; only set external values here for TREQMSG^DGPFHLTM, full DGPFA is not needed.
  1.  S MAILPFA("DFN")=U_$G(DGFDA(26.22,IENS,.03))
  1.  S MAILPFA("FLAG")=U_$G(DGFDA(26.22,IENS,.04))
  1.  D TREQMSG^DGPFHLTM(.MAILARY,.MAILPFA,2)
  1.  ; update "NO RESPONSE" entries with new review date/time
  1.  D NORESPDT($$FIND1^DIC(2,,"X",$G(DGFDA(26.22,IENS,.03))),$$FIND1^DIC(26.15,,"X",$G(DGFDA(26.22,IENS,.04))),MAILARY("REVDTM"))
  1.  ;
  1. ENX ; exit point
  1.  K ^TMP("DGPFHLT1",$J)
  1.  Q
  1.  ;
  1. FNDLOG(REQID) ; find log entry (file 26.22) for a given query id
  1.  ; REQID - query id to look for
  1.  ; Returns ien in file 26.22 on success, 0 otherwise
  1.  N RES
  1.  S RES=0 I $G(REQID)'="" S RES=+$O(^DGPF(26.22,"C",REQID,""))
  1.  Q RES
  1.  ;
  1. SENDERR(MSGID,SNDFAC,DGECODE,DGERR) ; send Mailman notification for an error
  1.  N ERTXT
  1.  S ERTXT(1)="Error while processing RSP^K11 HL7 message from station # "_$G(SNDFAC)_"."
  1.  S ERTXT(3)="Error code: "_$S($G(DGECODE)="":"N/A",1:$G(DGECODE))
  1.  S ERTXT(4)="Error description: "_$G(DGERR)
  1.  D TERRMSG^DGPFHLTM(MSGID,.ERTXT)
  1.  Q
  1.  ;
  1. UPDLOG(IENS,DGERR,DATA,DGFERR) ; update log entry in file 26.22
  1.  ; only updates fields .05,.06,.07,and 1
  1.  ;
  1.  ; IENS - ien in file 26.22_","
  1.  ; DGERR - error text to file into 26.22/1
  1.  ; DATA - array of values to file (see tag EN^DGPFHLT1)
  1.  ; DGFERR - array to return FM filing errors in
  1.  ;
  1.  ; returns filing errors in DGFERR, if any.
  1.  ;
  1.  N DGFDA
  1.  S DGFDA(26.22,IENS,.05)=$S(DGERR'="":5,DATA("REVRES")="A":3,1:4)
  1.  S DGFDA(26.22,IENS,.06)=$G(DATA("REVBY"))
  1.  S DGFDA(26.22,IENS,.07)=$G(DATA("REVDTM"))
  1.  S DGFDA(26.22,IENS,2.02)=$G(DATA("REVCMT"))
  1.  S:DGERR'="" DGFDA(26.22,IENS,1)=DGERR
  1.  D FILE^DIE(,"DGFDA","DGFERR")
  1.  Q
  1.  ;
  1. NORESPDT(DFN,FLAG,RDT) ; update review date/time of "NO RESPONSE" entries in file 26.22
  1.  ; DFN - patient DFN
  1.  ; FLAG - flag ien in file 26.15
  1.  ; RDT - review date/time to use in internal FM format
  1.  ;
  1.  N DATE,DGFDA,DIERR,IEN
  1.  I +DFN'>0!(+FLAG'>0) Q
  1.  ; loop through "NO RESPONSE" entries
  1.  S DATE="" F  S DATE=$O(^DGPF(26.22,"D",DFN,FLAG,6,DATE)) Q:DATE=""  D
  1.  .S IEN=+$O(^DGPF(26.22,"D",DFN,FLAG,6,DATE,""))
  1.  .S DGFDA(26.22,IEN_",",.07)=RDT
  1.  .D FILE^DIE(,"DGFDA","DIERR") K DGFDA
  1.  .Q
  1.  Q