SCDXACK.m

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 ---SCDXACK   4315     printed  Mar 13, 2025@21:44:03                                                                                                                                                                                                     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