source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHAAC2.m@ 1274

Last change on this file since 1274 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PRCHAAC2 ;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 ;
7CLEAN K %,PRCACMSG,PRCACK,PRCBATCH,PRCDATE,PRCMESG,PRCMID,PRCSUB,HL,HLFS,HLRS,HLRS,HLNODE,HLNEXT,HLQUIT,PRCTAAC,PRCFAAC,PRCDIF,X,X1,Y
8 Q
9 ;
10END ;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 ;
28ERR ;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 ;
34LOG ;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 ;
44SUB ;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 ;
66REC ;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
Note: See TracBrowser for help on using the repository browser.