ABPAPD7.m

ABPAPD7 ;POST PAYMENT EDIT CHECK; [ 07/25/91  11:30 AM ]

 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

A0 K DIC,DIE,DA,DR,ABPAERR S DA(1)=ABPATDFN,DA=ABPADDFN

 I +$P(^ABPVAO(DA(1),"P",DA,"A",0),"^",4)'>0 D  G A0A^ABPAPD8

 .W *7,!!?10,"You have deleted all payment information...therefore,"

A0A I ((+ABPA("STDAMT")<0)&('GOTCHECK)) K ABPA("DHS") D

 .K DIR S DIR(0)="YOA",DIR("A")="Are you issuing a refund (Y/N)? "

 .S DIR("B")="NO" W *7 D ^DIR I Y D

 ..K DIR S DIR(0)="FO",DIR("A")="Enter the DHS check number you are "

 ..S DIR("A")=DIR("A")_"processing" D ^DIR

 ..I X]""&($E(X)'=" ")&(X'["^") S ABPA("DHS")=X

 .I $D(ABPA("DHS"))'=1 S ABPAERR="" W *7 D  Q

 ..K ABPAMESS S ABPAMESS="CHECK NUMBER/TRANSACTION TYPE MIS-MATCH"

 ..S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN

 .K DIE,DR,DA S DA(1)=ABPATDFN,DA=ABPADDFN,DR=".1///"_ABPA("DHS")

 .S DIE="^ABPVAO("_ABPATDFN_",""P""," D ^DIE

VOID I ((+ABPA("STDAMT")>0)&('GOTCHECK)) K ABPA("DHS") D

 .K DIR S DIR(0)="YOA",DIR("A")="Are you voiding a previous refund"

 .S DIR("A")=DIR("A")_" (Y/N)? ",DIR("B")="NO" W *7 D ^DIR I Y D

 ..K DIR S DIR(0)="FO",DIR("A")="Enter the DHS check number you are "

 ..S DIR("A")=DIR("A")_"voiding" D ^DIR

 ..I X]""&($E(X)'=" ")&(X'["^") S ABPA("DHS")=X

 .I $D(ABPA("DHS"))'=1 S ABPAERR="" W *7 D  Q

 ..K ABPAMESS S ABPAMESS="CHECK NUMBER/TRANSACTION TYPE MIS-MATCH"

 ..S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN

 .K DIE,DR,DA S DA(1)=ABPATDFN,DA=ABPADDFN,DR=".1///"_ABPA("DHS")

 .S DIE="^ABPVAO("_ABPATDFN_",""P""," D ^DIE

 I ((+ABPA("STDAMT")=0)&(GOTCHECK)) S ABPAERR="" W *7 D

 .K ABPAMESS S ABPAMESS="CHECK NUMBER/TRANSACTION TYPE MIS-MATCH"

 .S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN

 I GOTCHECK I +ABPA("STDAMT")>+ABPACHK("RAMT") S ABPAERR="" W *7 D

 .K ABPAMESS S ABPAMESS="PAYMENT ALLOCATION-CHECK BALANCE ERROR"

 .S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN

 I $D(ABPAERR)=1 K ABPAERR G DISP^ABPAPD3

 K ABPA("OPERR"),ABPA("RBERR") D BEGIN^ABPAPD7A,^ABPAPD7C

 I $D(ABPA("RBERR"))'=0 D  K ABPA("RBERR") G A0A^ABPAPD8

 .S ABPAMESS="YOU CANNOT REFUND MORE THAN WAS PREVIOUSLY POSTED" W *7

 .S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN

 I $D(ABPA("OPERR"))'=0 D  K ABPA("OPERR") G A0A^ABPAPD8

 .S ABPAMESS="ILLEGAL OVERPAYMENT ENCOUNTERED" W *7

 .S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN

 K DIR S DIR("A",1)="1 - Execute write-offs, 2 - Select write-offs"

 S DIR("A",1)=DIR("A",1)_", 3 - Do not write-off, 4 - Cancel"

 S DIR("A")="Select ACTION: ",DIR(0)="SOA^1:Execute write-offs;"

 S DIR(0)=DIR(0)_"2:Select write-off;3:Do not write-off;4:Cancel;"

 S DIR("B")=1 D ^DIR G:+Y=0!(+Y=4) A0A^ABPAPD8 S ABPA("Y")=+Y

FILE ;ENTRY POINT

 ;PROCEDURE TO SET CLAIM SPECIFIC PAYMENT TRANSACTION AMOUNTS

 ;REQUIRES ABPATDFN=CURRENT PATIENT DFN, ABPADDFN=CURRENT PAYMENT DFN

 ;REQUIRES THE ARRAY ABPA("PP",ABPADOS,DA) BE DEFINED WHERE:

 ;ABPADOS=CLAIM DOS, DA=CLAIM DFN

 ;REQUIRES ABPA("Y")=1, 2, OR 3 WHERE 1=EXECUTE AUTOMATIC WRITE-OFFS,

 ;2=EXECUTE SELECTIVE WRITE-OFFS, 3=EXECUTE NO WRITE-OFFS

 K DIC,DIE,DA,DR,DIK,ABPA("QF"),ABPADOS

 S ABPAD=0 F ABPA("I")=0:0 D  Q:+ABPAD=0

 .S ABPAD=$O(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPAD)) Q:+ABPAD=0

 .Q:$D(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPAD,0))'=1  S ABPADATA=^(0)

 .S ABPADOS=+ABPADATA,DA=$P(ABPADATA,"^",2) Q:+ABPADOS=0!(+DA<1)

 .Q:$D(^ABPVAO(ABPATDFN,1,DA,0))'=1!($D(ABPA("PP",ABPADOS,DA))'=1)

 .F P=2:1:5 S $P(ABPADATA,"^",P+1)=$P(ABPA("CP",ABPADOS,DA),"^",P)

 .S ^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPAD,0)=ABPADATA K DIE,DR

 .Q:$D(ABPA("CONVERT"))=1

 .I +ABPA("PP",ABPADOS,DA)'>0 D  Q

 ..S DA(1)=ABPATDFN,DIE="^ABPVAO("_DA(1)_",1,",DR=".18///C" D ^DIE

 .I ABPA("Y")=1 D  Q

 ..S $P(^ABPVAO(ABPATDFN,1,DA,0),"^",3)=+ABPA("PP",ABPADOS,DA)

 ..S DA(1)=ABPATDFN,DIE="^ABPVAO("_DA(1)_",1,",DR=".18///C" D ^DIE

 .I ABPA("Y")=2 D  Q

 ..K DIR S DIR(0)="YO",DIR("A")="Write-off the remaining $"

 ..S DIR("A")=DIR("A")_$J($P(ABPA("PP",ABPADOS,DA),"^"),8,2)

 ..S DIR("A")=DIR("A")_" for Claim #",DIR("B")="YES"

 ..S DIR("A")=DIR("A")_$P(^ABPVAO(ABPATDFN,1,DA,0),"^",2) D ^DIR

 ..I +Y=1 D  W "... Written-off!" Q

 ...S $P(^ABPVAO(ABPATDFN,1,DA,0),"^",3)=+ABPA("PP",ABPADOS,DA)

 ...S DA(1)=ABPATDFN,DIE="^ABPVAO("_DA(1)_",1,",DR=".18///C" D ^DIE

 ..W " ... Not written-off!"

 Q:$D(ABPA("CONVERT"))=1

A3 I GOTCHECK D

 .K DIE,DA,DR S DA(2)=$O(ABPACHK("")),DA(1)=$O(ABPACHK(DA(2),""))

 .S DA=$O(ABPACHK(DA(2),DA(1),""))

 .S DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","

 .S ABPACHK("RAMT")=ABPACHK("RAMT")-ABPA("STDAMT")

 .S ABPACHK("PAMT")=ABPACHK("AMT")-ABPACHK("RAMT")

 .S DR="6///P;7///"_ABPACHK("PAMT")_";8///"_ABPACHK("RAMT")

 .S DR=DR_";9///"_DUZ_";10///NOW" D ^DIE

 .K DIK S DIK=DIE D IX^DIK

 L ^ABPVAO(ABPATDFN)

 K DIC,DIE,DA,DR,ABPACAMT,ABPAPAMT,DIK,ABPADOS,ABPA("I"),ABPA("QF")

 K ABPAPOST,ABPASDT,ABPARECV,ABPADATA,ABPACHK,CLOSE,ABPA("CHK")

 G ^ABPAPD1

ABPAPD7   ;POST PAYMENT EDIT CHECK; [ 07/25/91  11:30 AM ]

 +1       ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

A0         KILL DIC,DIE,DA,DR,ABPAERR

           SET DA(1)=ABPATDFN

           SET DA=ABPADDFN

 +1        IF +$PIECE(^ABPVAO(DA(1),"P",DA,"A",0),"^",4)'>0

               Begin DoDot:1

 +2                WRITE *7,!!?10,"You have deleted all payment information...therefore,"

               End DoDot:1

               GOTO A0A^ABPAPD8

A0A        IF ((+ABPA("STDAMT")<0)&('GOTCHECK))

               KILL ABPA("DHS")

               Begin DoDot:1

 +1                KILL DIR

                   SET DIR(0)="YOA"

                   SET DIR("A")="Are you issuing a refund (Y/N)? "

 +2                SET DIR("B")="NO"

                   WRITE *7

                   DO ^DIR

                   IF Y

                       Begin DoDot:2

 +3                        KILL DIR

                           SET DIR(0)="FO"

                           SET DIR("A")="Enter the DHS check number you are "

 +4                        SET DIR("A")=DIR("A")_"processing"

                           DO ^DIR

 +5                        IF X]""&($EXTRACT(X)'=" ")&(X'["^")

                               SET ABPA("DHS")=X

                       End DoDot:2

 +6                IF $DATA(ABPA("DHS"))'=1

                       SET ABPAERR=""

                       WRITE *7

                       Begin DoDot:2

 +7                        KILL ABPAMESS

                           SET ABPAMESS="CHECK NUMBER/TRANSACTION TYPE MIS-MATCH"

 +8                        SET ABPAMESS(2)="... Press any key to continue ... "

                           DO PAUSE^ABPAMAIN

                       End DoDot:2

                       QUIT 

 +9                KILL DIE,DR,DA

                   SET DA(1)=ABPATDFN

                   SET DA=ABPADDFN

                   SET DR=".1///"_ABPA("DHS")

 +10               SET DIE="^ABPVAO("_ABPATDFN_",""P"","

                   DO ^DIE

               End DoDot:1

VOID       IF ((+ABPA("STDAMT")>0)&('GOTCHECK))

               KILL ABPA("DHS")

               Begin DoDot:1

 +1                KILL DIR

                   SET DIR(0)="YOA"

                   SET DIR("A")="Are you voiding a previous refund"

 +2                SET DIR("A")=DIR("A")_" (Y/N)? "

                   SET DIR("B")="NO"

                   WRITE *7

                   DO ^DIR

                   IF Y

                       Begin DoDot:2

 +3                        KILL DIR

                           SET DIR(0)="FO"

                           SET DIR("A")="Enter the DHS check number you are "

 +4                        SET DIR("A")=DIR("A")_"voiding"

                           DO ^DIR

 +5                        IF X]""&($EXTRACT(X)'=" ")&(X'["^")

                               SET ABPA("DHS")=X

                       End DoDot:2

 +6                IF $DATA(ABPA("DHS"))'=1

                       SET ABPAERR=""

                       WRITE *7

                       Begin DoDot:2

 +7                        KILL ABPAMESS

                           SET ABPAMESS="CHECK NUMBER/TRANSACTION TYPE MIS-MATCH"

 +8                        SET ABPAMESS(2)="... Press any key to continue ... "

                           DO PAUSE^ABPAMAIN

                       End DoDot:2

                       QUIT 

 +9                KILL DIE,DR,DA

                   SET DA(1)=ABPATDFN

                   SET DA=ABPADDFN

                   SET DR=".1///"_ABPA("DHS")

 +10               SET DIE="^ABPVAO("_ABPATDFN_",""P"","

                   DO ^DIE

               End DoDot:1

 +11       IF ((+ABPA("STDAMT")=0)&(GOTCHECK))

               SET ABPAERR=""

               WRITE *7

               Begin DoDot:1

 +12               KILL ABPAMESS

                   SET ABPAMESS="CHECK NUMBER/TRANSACTION TYPE MIS-MATCH"

 +13               SET ABPAMESS(2)="... Press any key to continue ... "

                   DO PAUSE^ABPAMAIN

               End DoDot:1

 +14       IF GOTCHECK

               IF +ABPA("STDAMT")>+ABPACHK("RAMT")

                   SET ABPAERR=""

                   WRITE *7

                   Begin DoDot:1

 +15                   KILL ABPAMESS

                       SET ABPAMESS="PAYMENT ALLOCATION-CHECK BALANCE ERROR"

 +16                   SET ABPAMESS(2)="... Press any key to continue ... "

                       DO PAUSE^ABPAMAIN

                   End DoDot:1

 +17       IF $DATA(ABPAERR)=1

               KILL ABPAERR

               GOTO DISP^ABPAPD3

 +18       KILL ABPA("OPERR"),ABPA("RBERR")

           DO BEGIN^ABPAPD7A

           DO ^ABPAPD7C

 +19       IF $DATA(ABPA("RBERR"))'=0

               Begin DoDot:1

 +20               SET ABPAMESS="YOU CANNOT REFUND MORE THAN WAS PREVIOUSLY POSTED"

                   WRITE *7

 +21               SET ABPAMESS(2)="... Press any key to continue ... "

                   DO PAUSE^ABPAMAIN

               End DoDot:1

               KILL ABPA("RBERR")

               GOTO A0A^ABPAPD8

 +22       IF $DATA(ABPA("OPERR"))'=0

               Begin DoDot:1

 +23               SET ABPAMESS="ILLEGAL OVERPAYMENT ENCOUNTERED"

                   WRITE *7

 +24               SET ABPAMESS(2)="... Press any key to continue ... "

                   DO PAUSE^ABPAMAIN

               End DoDot:1

               KILL ABPA("OPERR")

               GOTO A0A^ABPAPD8

 +25       KILL DIR

           SET DIR("A",1)="1 - Execute write-offs, 2 - Select write-offs"

 +26       SET DIR("A",1)=DIR("A",1)_", 3 - Do not write-off, 4 - Cancel"

 +27       SET DIR("A")="Select ACTION: "

           SET DIR(0)="SOA^1:Execute write-offs;"

 +28       SET DIR(0)=DIR(0)_"2:Select write-off;3:Do not write-off;4:Cancel;"

 +29       SET DIR("B")=1

           DO ^DIR

           IF +Y=0!(+Y=4)

               GOTO A0A^ABPAPD8

           SET ABPA("Y")=+Y

FILE      ;ENTRY POINT

 +1       ;PROCEDURE TO SET CLAIM SPECIFIC PAYMENT TRANSACTION AMOUNTS

 +2       ;REQUIRES ABPATDFN=CURRENT PATIENT DFN, ABPADDFN=CURRENT PAYMENT DFN

 +3       ;REQUIRES THE ARRAY ABPA("PP",ABPADOS,DA) BE DEFINED WHERE:

 +4       ;ABPADOS=CLAIM DOS, DA=CLAIM DFN

 +5       ;REQUIRES ABPA("Y")=1, 2, OR 3 WHERE 1=EXECUTE AUTOMATIC WRITE-OFFS,

 +6       ;2=EXECUTE SELECTIVE WRITE-OFFS, 3=EXECUTE NO WRITE-OFFS

 +7        KILL DIC,DIE,DA,DR,DIK,ABPA("QF"),ABPADOS

 +8        SET ABPAD=0

           FOR ABPA("I")=0:0

               Begin DoDot:1

 +9                SET ABPAD=$ORDER(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPAD))

                   IF +ABPAD=0

                       QUIT 

 +10               IF $DATA(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPAD,0))'=1

                       QUIT 

                   SET ABPADATA=^(0)

 +11               SET ABPADOS=+ABPADATA

                   SET DA=$PIECE(ABPADATA,"^",2)

                   IF +ABPADOS=0!(+DA<1)

                       QUIT 

 +12               IF $DATA(^ABPVAO(ABPATDFN,1,DA,0))'=1!($DATA(ABPA("PP",ABPADOS,DA))'=1)

                       QUIT 

 +13               FOR P=2:1:5

                       SET $PIECE(ABPADATA,"^",P+1)=$PIECE(ABPA("CP",ABPADOS,DA),"^",P)

 +14               SET ^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPAD,0)=ABPADATA

                   KILL DIE,DR

 +15               IF $DATA(ABPA("CONVERT"))=1

                       QUIT 

 +16               IF +ABPA("PP",ABPADOS,DA)'>0

                       Begin DoDot:2

 +17                       SET DA(1)=ABPATDFN

                           SET DIE="^ABPVAO("_DA(1)_",1,"

                           SET DR=".18///C"

                           DO ^DIE

                       End DoDot:2

                       QUIT 

 +18               IF ABPA("Y")=1

                       Begin DoDot:2

 +19                       SET $PIECE(^ABPVAO(ABPATDFN,1,DA,0),"^",3)=+ABPA("PP",ABPADOS,DA)

 +20                       SET DA(1)=ABPATDFN

                           SET DIE="^ABPVAO("_DA(1)_",1,"

                           SET DR=".18///C"

                           DO ^DIE

                       End DoDot:2

                       QUIT 

 +21               IF ABPA("Y")=2

                       Begin DoDot:2

 +22                       KILL DIR

                           SET DIR(0)="YO"

                           SET DIR("A")="Write-off the remaining $"

 +23                       SET DIR("A")=DIR("A")_$JUSTIFY($PIECE(ABPA("PP",ABPADOS,DA),"^"),8,2)

 +24                       SET DIR("A")=DIR("A")_" for Claim #"

                           SET DIR("B")="YES"

 +25                       SET DIR("A")=DIR("A")_$PIECE(^ABPVAO(ABPATDFN,1,DA,0),"^",2)

                           DO ^DIR

 +26                       IF +Y=1

                               Begin DoDot:3

 +27                               SET $PIECE(^ABPVAO(ABPATDFN,1,DA,0),"^",3)=+ABPA("PP",ABPADOS,DA)

 +28                               SET DA(1)=ABPATDFN

                                   SET DIE="^ABPVAO("_DA(1)_",1,"

                                   SET DR=".18///C"

                                   DO ^DIE

                               End DoDot:3

                               WRITE "... Written-off!"

                               QUIT 

 +29                       WRITE " ... Not written-off!"

                       End DoDot:2

                       QUIT 

               End DoDot:1

               IF +ABPAD=0

                   QUIT 

 +30       IF $DATA(ABPA("CONVERT"))=1

               QUIT 

A3         IF GOTCHECK

               Begin DoDot:1

 +1                KILL DIE,DA,DR

                   SET DA(2)=$ORDER(ABPACHK(""))

                   SET DA(1)=$ORDER(ABPACHK(DA(2),""))

 +2                SET DA=$ORDER(ABPACHK(DA(2),DA(1),""))

 +3                SET DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","

 +4                SET ABPACHK("RAMT")=ABPACHK("RAMT")-ABPA("STDAMT")

 +5                SET ABPACHK("PAMT")=ABPACHK("AMT")-ABPACHK("RAMT")

 +6                SET DR="6///P;7///"_ABPACHK("PAMT")_";8///"_ABPACHK("RAMT")

 +7                SET DR=DR_";9///"_DUZ_";10///NOW"

                   DO ^DIE

 +8                KILL DIK

                   SET DIK=DIE

                   DO IX^DIK

               End DoDot:1

 +9        LOCK ^ABPVAO(ABPATDFN)

 +10       KILL DIC,DIE,DA,DR,ABPACAMT,ABPAPAMT,DIK,ABPADOS,ABPA("I"),ABPA("QF")

 +11       KILL ABPAPOST,ABPASDT,ABPARECV,ABPADATA,ABPACHK,CLOSE,ABPA("CHK")

 +12       GOTO ^ABPAPD1