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

PRCHAAC2.m

Go to the documentation of this file.
  1. PRCHAAC2 ;WIFO/CR-CONT. OF IFCAP HL7 MESSAGE TO AUSTIN ;3/4/05 11:43 AM
  1. ;;5.1;IFCAP;**79**;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;This routine is a continuation of the routine PRCHAAC1.
  1. ;
  1. CLEAN K %,PRCACMSG,PRCACK,PRCBATCH,PRCDATE,PRCMESG,PRCMID,PRCSUB,HL,HLFS,HLRS,HLRS,HLNODE,HLNEXT,HLQUIT,PRCTAAC,PRCFAAC,PRCDIF,X,X1,Y
  1. Q
  1. ;
  1. END ;Log the date/time ($H format) of the AAC response and the creation date
  1. ;(FileMan format) in ^XTMP
  1. S X=DT D NOW^%DTC S X1=$$FMTH^XLFDT(%)
  1. S $P(^XTMP(PRCSUB,"TIME"),U,2)=X1
  1. S $P(^XTMP(PRCSUB,0),U,2)=X
  1. S X=DT D NOW^%DTC,YX^%DTC S PRCDATE=Y
  1. S $P(^XTMP(PRCSUB,0),U,3)="Processing done "_PRCDATE_" for IFCAP HL7 MSG to the AAC"
  1. ;
  1. ;Get an approximated calculation of how long it takes to get a response
  1. ;from the AAC, to help in troubleshooting problems.
  1. I $P(^XTMP(PRCSUB,"TIME"),U,1)]""&$P(^XTMP(PRCSUB,"TIME"),U,2)]"" D
  1. . S PRCTAAC=$P(^XTMP(PRCSUB,"TIME"),U,1) ;date/time msg to the AAC
  1. . S PRCFAAC=$P(^XTMP(PRCSUB,"TIME"),U,2) ;date/time msg from the AAC
  1. . S PRCDIF=$$HDIFF^XLFDT(PRCFAAC,PRCTAAC,3) ;time difference
  1. . S $P(^XTMP(PRCSUB,"TIME"),U,3)=PRCDIF ;time elapsed
  1. D CLEAN
  1. Q
  1. ;
  1. ERR ;Errors from incoming messages are logged here
  1. I $D(PRCERR) D
  1. . S PRCMSG=PRCMSG_";"_"HL7 Message ID: "_$S(PRCMID>0:PRCMID,1:"No MID")
  1. . S ^XTMP(PRCSUB,"ERR",$H)=PRCMSG
  1. Q
  1. ;
  1. LOG ;Set purge date to keep ^XTMP clean; first piece is purge date, FM form
  1. S X=$$FMADD^XLFDT(DT,7) ;keep for seven days
  1. S $P(^XTMP(PRCSUB,0),U,1)=X
  1. ;Record date of message to the AAC
  1. S X=DT D NOW^%DTC S X1=$$FMTH^XLFDT(%)
  1. S $P(^XTMP(PRCSUB,"TIME"),U,1)=X1
  1. ;Keep track of who created the message
  1. S $P(^XTMP(PRCSUB,"TIME"),U,4)=PRCDUZ
  1. Q
  1. ;
  1. SUB ;Subscriber to handle the ACKs coming from the AAC
  1. ;Error message 'No MID' = no message id
  1. S HLFS=$G(HL("FS"))
  1. S HLCS=$E(HL("ECH"),1),HLRS=$E(HL("ECH"),2)
  1. I HL("MTN")'="MFK" S PRCERR=1,PRCMSG="1A"_"^Wrong message name." D REC Q
  1. X HLNEXT I HLQUIT'>0 S PRCERR=1,PRCMSG="2A"_"^Missing MSH segment." D REC Q
  1. S PRCACMSG=$P(HLNODE,HLFS,10)
  1. X HLNEXT I HLQUIT'>0 S PRCERR=1,PRCMSG="3A"_"^Missing segments." D REC Q
  1. S PRCMID=$$FLD^HLCSUTL(.HLNODE,3) I '$D(PRCMID) S PRCMID="No MID",PRCERR=1,PRCMSG="4A"_"^No MID" D REC Q
  1. S PRCSUB="PRCHAAC1;"_PRCMID
  1. I $P(HLNODE,HLFS)'="MSA" S PRCERR=1,PRCMSG="5A"_"^No MSA segment." D REC Q
  1. S PRCACK=$P(HLNODE,HLFS,2)
  1. S PRCBATCH=$G(HLNODE)
  1. I $P(HLNODE,HLFS)="MSA"&(PRCACK="AA") D Q
  1. . S ^XTMP(PRCSUB,"AAC_MSG_ID")=PRCACMSG
  1. . S ^XTMP(PRCSUB,"IFCAP_MSG_ID")=$P(PRCBATCH,HLFS,3)
  1. . D END
  1. ;
  1. ;If there is an error, store the entire string.
  1. I PRCACK'="AA" S PRCERR=1,PRCMSG=PRCACK_";"_PRCBATCH D REC
  1. Q
  1. ;
  1. REC ;For errors, log as much as possible in ^XTMP
  1. I '$D(PRCMID) S PRCMID=$$FLD^HLCSUTL(.HLNODE,3)
  1. I '$D(PRCSUB) S PRCSUB=$S(PRCMID>0:"PRCHAAC1;"_PRCMID,1:"PRCHAAC1;"_"No MID")
  1. D ERR,END
  1. Q