- 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 Feb 18, 2025@23:31:55 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