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