source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCDXACK.m@ 1361

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

initial load of WorldVistAEHR

File size: 4.1 KB
RevLine 
[613]1SCDXACK ;ALB/JRP - HL7 BATCH ACKNOWLEDGEMENT HANDLER;26-APR-1996 ; 21 Apr 2000 1:01 PM
2 ;;5.3;Scheduling;**44,121,128,215**;AUG 13, 1993
3 ;
4ACKZ00 ;Process batch acknowledgements from National Patient Care Database
5 ;
6 ;Input : All variables set by the HL7 package
7 ;Output : None
8 ;Notes : The batch acknowledgement received is an exception based
9 ; acknowledgement - this allows for a complete acceptance or
10 ; rejection of an entire batch message.
11 ;
12 ; If the batch acknowledgement is a batch acceptance, than
13 ; the batch message will only contain acknowledgements for
14 ; messages that were rejected. All other messages contained
15 ; in the sent batch message are assumed to be accepted.
16 ;
17 ; If the batch acknowledgement is a batch rejection, than
18 ; the batch message will only contain acknowledgements for
19 ; messages that were accepted. All other messages contained
20 ; in the sent batch message are assumed to be rejected.
21 ;
22 ;Declare variables
23 N %,%H,%I,X,ACKDATE,BATCHID,MSGID,XMITPTR,XMITARRY,ACKCODE,SDCT
24 N MSGTYPE,EVNTTYPE,FLDSEP,CMPNTSEP,REPTNSEP,ERRCODES,ERROR,ERRNUM,ERRCNT
25 S XMITARRY="^TMP(""AMB-CARE"","_$J_",""BID"")"
26 K @XMITARRY
27 ;Remember date/time acknowledgement was received
28 S ACKDATE=$$NOW^XLFDT()
29 ;Get field & component seperators
30 S FLDSEP=HL("FS")
31 S CMPNTSEP=$E(HL("ECH"),1)
32 S REPTNSEP=$E(HL("ECH"),2)
33 ;Get acknowledgement code
34 S ACKCODE=$P(HLMSA,FLDSEP,2)
35 ;Get rejection reason
36 S ERROR=$P(HLMSA,FLDSEP,4)
37 ;Default to acceptance
38 S:(ACKCODE="") ACKCODE="AA"
39 ;Only file APPLICATION ACKNOWLEDGEMENT
40 Q:($E(ACKCODE,1)'="A")
41 ;Translate acknowledgement code to Accept, Reject, Error
42 S ACKCODE=$E(ACKCODE,2)
43 ;Get batch control ID
44 S BATCHID=$P(HLMSA,FLDSEP,3)
45 ;Do implied acceptance/rejection for entries in ACRP Transmission
46 ; History file (#409.77)
47 D ACKBID^SCDXFU12(BATCHID,ACKDATE,ACKCODE)
48 ;Get list of all entries in Transmitted Outpatient Encounter file
49 ; (#409.73) that were contained in batch being acknowledged
50 D PTRS4BID^SCDXFU02(BATCHID,XMITARRY)
51 ;Loop through list of entries - do implied acceptance/rejection
52 S XMITPTR=""
53 F S XMITPTR=+$O(@XMITARRY@(XMITPTR)) Q:('XMITPTR) D
54 .;Mark entry as accepted/rejected by National Patient Care Database
55 .D ACKDATA^SCDXFU03(XMITPTR,ACKDATE,ACKCODE)
56 .;Store error code if rejected by National Patient Care Database
57 .I (ACKCODE'="A") S X=$$CRTERR^SCDXFU02(XMITPTR,ERROR,1)
58 ;Loop through batch acknowledgement - do explicite acceptance/rejection
59 F X HLNEXT D Q:(HLQUIT'>0)
60 .;Skip to next message header (MSH)
61 .Q:($E(HLNODE,1,3)'="MSH")
62 .;Get field & component seperators
63 .S FLDSEP=$E(HLNODE,4)
64 .S CMPNTSEP=$E(HLNODE,5)
65 .;Get message and event types
66 .S X=$P(HLNODE,FLDSEP,9)
67 .S MSGTYPE=$P(X,CMPNTSEP,1)
68 .S EVNTTYPE=$P(X,CMPNTSEP,2)
69 .;Only process message types ACK-A08 and ACK-A23
70 .Q:(MSGTYPE'="ACK")
71 .Q:((EVNTTYPE'="A08")&(EVNTTYPE'="A23"))
72 .;Skip to message acknowledgement (MSA)
73 .F X HLNEXT Q:((HLQUIT'>0)!($E(HLNODE,1,3)="MSA"))
74 .;Didn't find MSA - quit
75 .Q:($E(HLNODE,1,3)'="MSA")
76 .;Get acknowledgement code
77 .S ACKCODE=$P(HLNODE,FLDSEP,2)
78 .;Only file APPLICATION ACKNOWLEDGEMENT codes
79 .Q:($E(ACKCODE,1)'="A")
80 .;Translate acknowledgement code to Accept, Reject, Error
81 .S ACKCODE=$E(ACKCODE,2)
82 .;Get message ID being acknowledged
83 .S MSGID=$P(HLNODE,FLDSEP,3)
84 .;Get error codes
85 .S ERRCODES=$P(HLNODE,FLDSEP,4)
86 .;Do explicite acceptance/rejection for entry in ACRP Transmission
87 .; History file (#409.77)
88 .D ACKMID^SCDXFU12(MSGID,ACKDATE,ACKCODE)
89 .;Find entry in Transmitted Outpatient Encounter file
90 .S XMITPTR=$$PTR4MID^SCDXFU02(MSGID)
91 .;Didn't find message control ID
92 .Q:('XMITPTR)
93 .;Store acknowledgement code
94 .D ACKDATA^SCDXFU03(XMITPTR,ACKDATE,ACKCODE)
95 .;Parse list of reported error codes
96 .S ERRCNT=$L(ERRCODES,REPTNSEP),SDCT=0
97 .F ERRNUM=1:1:ERRCNT D
98 ..;Get error code
99 ..S ERROR=$P(ERRCODES,REPTNSEP,ERRNUM)
100 ..;Store error code
101 ..Q:(ERROR="")
102 ..S X=$$CRTERR^SCDXFU02(XMITPTR,ERROR,1),SDCT=SDCT+1
103 .;If rejected, insure that at least one error code gets filed
104 .I ACKCODE'="A",'SDCT S ERROR=999,X=$$CRTERR^SCDXFU02(XMITPTR,ERROR,1)
105 ;Clean up
106 K @XMITARRY
107 ;Done
108 Q
Note: See TracBrowser for help on using the repository browser.