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

DGPFHLT2.m

Go to the documentation of this file.
  1. DGPFHLT2 ;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 sending RSP^K11 (response to PRF flag transfer request) messages.
  1. ;
  1. Q
  1. ;
  1. SEND(DGMERR,DATA) ; entry point
  1. ; DATA - Array of values to file (see tag EN^DGPFHLT1)
  1. ; DGMERR - error message to include in MSA segment
  1. ;
  1. N DGERR,DGFDA,DGHLRSLT,ERTXT,IENS,SEGCNT
  1. N HL,HLCMP,HLECH,HLFS,HLL,HLREP,HLSCMP
  1. K ^TMP("HLS",$J)
  1. ; get logical link
  1. S HLL("LINKS",1)="DGPF PRF RSP/K11 SUBSC"_U_$$GETLINK^DGPFHLUT(DATA("SENDTO"))
  1. ; Initialize the HL7
  1. D INIT^HLFNC2("DGPF PRF RSP/K11 EVENT",.HL)
  1. S HLFS=HL("FS"),HLECH=HL("ECH"),HLCMP=$E(HLECH),HLREP=$E(HL("ECH"),2),HLSCMP=$E(HL("ECH"),4)
  1. ; Create HL7 message
  1. S SEGCNT=0
  1. S SEGCNT=$$SAVESEG^DGPFHLT(SEGCNT,$$QAK()) ; QAK segment
  1. S SEGCNT=$$SAVESEG^DGPFHLT(SEGCNT,$$QPD()) ; QPD segment
  1. S SEGCNT=$$SAVESEG^DGPFHLT(SEGCNT,$$NTE()) ; NTE segment
  1. ; Send HL7 message
  1. D GENERATE^HLMA("DGPF PRF RSP/K11 EVENT","GM",1,.DGHLRSLT)
  1. I $P(DGHLRSLT,U,2)'="" D
  1. .; There was an error while sending RSP^K11 message
  1. .; Update log entry in file 26.22 accordingly
  1. .S IENS=$O(^DGPF(26.22,"B",$G(DATA("REQDTM")),""))_","
  1. .S DGFDA(26.22,IENS,.05)=5
  1. .S DGFDA(26.22,IENS,1)=$E($P(DGHLRSLT,U,3),1,80)
  1. .D FILE^DIE(,"DGFDA","DGERR")
  1. .; Send Mailman notification
  1. .S ERTXT(1)="Error while sending RSP^K11 HL7 message in response to QBP^Q11 HL7"
  1. .S ERTXT(2)="message with message Id "_$G(DATA("MSGID"))_"."
  1. .S ERTXT(3)="Error code: "_$P(DGHLRSLT,U,2)
  1. .S ERTXT(4)="Error description: "_$P(DGHLRSLT,U,3)
  1. .I $D(DGERR) D
  1. ..S ERTXT(5)=""
  1. ..S ERTXT(6)="Error while updating log entry in file 26.22."
  1. ..S ERTXT(7)="Error code: "_$G(DGERR("DIERR",1))
  1. ..S ERTXT(8)="Error description: "_$G(DGERR("DIERR",1,"TEXT",1))
  1. ..Q
  1. .D TERRMSG^DGPFHLTM($P(DGHLRSLT,U),.ERTXT)
  1. .Q
  1. ; update "NO RESPONSE" entries with new review date/time
  1. D NORESPDT^DGPFHLT3($G(DATA("DFN")),$G(DATA("FLAG")),$G(DATA("REVDTM")))
  1. K ^TMP("HLS",$J)
  1. Q
  1. ;
  1. QAK() ; create QAK segment
  1. N SEG
  1. S $P(SEG,HLFS)=$G(DATA("REQID")) ; field 1
  1. S $P(SEG,HLFS,2)=$S($G(DATA("QOK"))=1:"OK",1:"AR") ; field 2
  1. S $P(SEG,HLFS,3)="PRFREQ01"_HLCMP_"PRF Ownership Transfer Request" ; field 3
  1. S SEG="QAK"_HLFS_SEG
  1. Q SEG
  1. ;
  1. QPD() ; create QPD segment
  1. N IENS,SEG
  1. S $P(SEG,HLFS)="PRFREQ01"_HLCMP_"PRF Ownership Transfer Request" ; field 1
  1. S $P(SEG,HLFS,2)=$G(DATA("REQID")) ; field 2
  1. S $P(SEG,HLFS,3)=$G(DATA("ICN")) ; field 3
  1. S IENS=$G(DATA("FLAG"))_","
  1. S $P(SEG,HLFS,4)=$$ENCHL7^DGPFHLUT($$GET1^DIQ(26.15,IENS,.01)) ; field 4
  1. S $P(SEG,HLFS,5)=$$ENCHL7^DGPFHLUT($G(DATA("REVBY"))) ; field 5
  1. S $P(SEG,HLFS,6)=$$HLDATE^HLFNC($G(DATA("REVDTM"))) ; field 6
  1. S SEG="QPD"_HLFS_SEG
  1. Q SEG
  1. ;
  1. NTE() ; create NTE segment
  1. N NAME,SEG,Z
  1. S $P(SEG,HLFS)="1" ; field 1
  1. S Z=$G(DATA("REVRES"))_HLREP_$$ENCHL7^DGPFHLUT($G(DATA("REVCMT")))
  1. S $P(SEG,HLFS,3)=Z ; field 3
  1. S $P(SEG,HLFS,4)="RE" ; field 4
  1. S Z="",$P(Z,HLCMP,14)=HLSCMP_$G(DATA("ORIGOWN"))
  1. S $P(SEG,HLFS,5)=Z ; field 5
  1. S SEG="NTE"_HLFS_SEG
  1. Q SEG