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
