| 1 | PRCHAAC2 ;WIFO/CR-CONT. OF IFCAP HL7 MESSAGE TO AUSTIN ;3/4/05 11:43 AM
|
|---|
| 2 | ;;5.1;IFCAP;**79**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;This routine is a continuation of the routine PRCHAAC1.
|
|---|
| 6 | ;
|
|---|
| 7 | CLEAN K %,PRCACMSG,PRCACK,PRCBATCH,PRCDATE,PRCMESG,PRCMID,PRCSUB,HL,HLFS,HLRS,HLRS,HLNODE,HLNEXT,HLQUIT,PRCTAAC,PRCFAAC,PRCDIF,X,X1,Y
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | END ;Log the date/time ($H format) of the AAC response and the creation date
|
|---|
| 11 | ;(FileMan format) in ^XTMP
|
|---|
| 12 | S X=DT D NOW^%DTC S X1=$$FMTH^XLFDT(%)
|
|---|
| 13 | S $P(^XTMP(PRCSUB,"TIME"),U,2)=X1
|
|---|
| 14 | S $P(^XTMP(PRCSUB,0),U,2)=X
|
|---|
| 15 | S X=DT D NOW^%DTC,YX^%DTC S PRCDATE=Y
|
|---|
| 16 | S $P(^XTMP(PRCSUB,0),U,3)="Processing done "_PRCDATE_" for IFCAP HL7 MSG to the AAC"
|
|---|
| 17 | ;
|
|---|
| 18 | ;Get an approximated calculation of how long it takes to get a response
|
|---|
| 19 | ;from the AAC, to help in troubleshooting problems.
|
|---|
| 20 | I $P(^XTMP(PRCSUB,"TIME"),U,1)]""&$P(^XTMP(PRCSUB,"TIME"),U,2)]"" D
|
|---|
| 21 | . S PRCTAAC=$P(^XTMP(PRCSUB,"TIME"),U,1) ;date/time msg to the AAC
|
|---|
| 22 | . S PRCFAAC=$P(^XTMP(PRCSUB,"TIME"),U,2) ;date/time msg from the AAC
|
|---|
| 23 | . S PRCDIF=$$HDIFF^XLFDT(PRCFAAC,PRCTAAC,3) ;time difference
|
|---|
| 24 | . S $P(^XTMP(PRCSUB,"TIME"),U,3)=PRCDIF ;time elapsed
|
|---|
| 25 | D CLEAN
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | ERR ;Errors from incoming messages are logged here
|
|---|
| 29 | I $D(PRCERR) D
|
|---|
| 30 | . S PRCMSG=PRCMSG_";"_"HL7 Message ID: "_$S(PRCMID>0:PRCMID,1:"No MID")
|
|---|
| 31 | . S ^XTMP(PRCSUB,"ERR",$H)=PRCMSG
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | LOG ;Set purge date to keep ^XTMP clean; first piece is purge date, FM form
|
|---|
| 35 | S X=$$FMADD^XLFDT(DT,7) ;keep for seven days
|
|---|
| 36 | S $P(^XTMP(PRCSUB,0),U,1)=X
|
|---|
| 37 | ;Record date of message to the AAC
|
|---|
| 38 | S X=DT D NOW^%DTC S X1=$$FMTH^XLFDT(%)
|
|---|
| 39 | S $P(^XTMP(PRCSUB,"TIME"),U,1)=X1
|
|---|
| 40 | ;Keep track of who created the message
|
|---|
| 41 | S $P(^XTMP(PRCSUB,"TIME"),U,4)=PRCDUZ
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | SUB ;Subscriber to handle the ACKs coming from the AAC
|
|---|
| 45 | ;Error message 'No MID' = no message id
|
|---|
| 46 | S HLFS=$G(HL("FS"))
|
|---|
| 47 | S HLCS=$E(HL("ECH"),1),HLRS=$E(HL("ECH"),2)
|
|---|
| 48 | I HL("MTN")'="MFK" S PRCERR=1,PRCMSG="1A"_"^Wrong message name." D REC Q
|
|---|
| 49 | X HLNEXT I HLQUIT'>0 S PRCERR=1,PRCMSG="2A"_"^Missing MSH segment." D REC Q
|
|---|
| 50 | S PRCACMSG=$P(HLNODE,HLFS,10)
|
|---|
| 51 | X HLNEXT I HLQUIT'>0 S PRCERR=1,PRCMSG="3A"_"^Missing segments." D REC Q
|
|---|
| 52 | S PRCMID=$$FLD^HLCSUTL(.HLNODE,3) I '$D(PRCMID) S PRCMID="No MID",PRCERR=1,PRCMSG="4A"_"^No MID" D REC Q
|
|---|
| 53 | S PRCSUB="PRCHAAC1;"_PRCMID
|
|---|
| 54 | I $P(HLNODE,HLFS)'="MSA" S PRCERR=1,PRCMSG="5A"_"^No MSA segment." D REC Q
|
|---|
| 55 | S PRCACK=$P(HLNODE,HLFS,2)
|
|---|
| 56 | S PRCBATCH=$G(HLNODE)
|
|---|
| 57 | I $P(HLNODE,HLFS)="MSA"&(PRCACK="AA") D Q
|
|---|
| 58 | . S ^XTMP(PRCSUB,"AAC_MSG_ID")=PRCACMSG
|
|---|
| 59 | . S ^XTMP(PRCSUB,"IFCAP_MSG_ID")=$P(PRCBATCH,HLFS,3)
|
|---|
| 60 | . D END
|
|---|
| 61 | ;
|
|---|
| 62 | ;If there is an error, store the entire string.
|
|---|
| 63 | I PRCACK'="AA" S PRCERR=1,PRCMSG=PRCACK_";"_PRCBATCH D REC
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | REC ;For errors, log as much as possible in ^XTMP
|
|---|
| 67 | I '$D(PRCMID) S PRCMID=$$FLD^HLCSUTL(.HLNODE,3)
|
|---|
| 68 | I '$D(PRCSUB) S PRCSUB=$S(PRCMID>0:"PRCHAAC1;"_PRCMID,1:"PRCHAAC1;"_"No MID")
|
|---|
| 69 | D ERR,END
|
|---|
| 70 | Q
|
|---|
