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