- ABPAPDD4 ;DELETE PAYMENT ENTRY; [ 07/09/91 7:55 AM ]
- ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- A0 K DIR S DIR(0)="YO",DIR("B")="YES"
- S DIR("A")="DELETE THE CURRENT TRANSACTIONS - ARE YOUR SURE "
- S DIR("A")=DIR("A")_"(Y/N)" W *7 D ^DIR I 'Y D G ^ABPAPDD1
- .K ABPAMESS S ABPAMESS="Nothing deleted!"
- .S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN
- A0A W !,"The '",ABPABDT,"' transactions for ",ABPAPAT," are being deleted "
- ;--------------------------------------------------------------------
- A1 ;PROCEDURE TO RESET CLAIM FLAGS AND WRITE-OFF FIELDS
- K DIC,DIE,DA,DR,DIK,ABPA("QF"),ABPADOS
- S ABPADOS=0 F ABPA("I")=0:0 D Q:$D(ABPA("QF"))=1
- .S ABPADOS=$O(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADOS))
- .I +ABPADOS=0 S ABPA("QF")="" Q
- .S DA=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADOS,0),"^",2)
- .Q:(+DA<1)!($D(^ABPVAO(ABPATDFN,1,DA,0))'=1)
- .S ZDA=0 F ABPAPCNT=0:1 D I +ZDA=0 K ZDA Q
- ..S ZDA=$O(^ABPVAO("PD",ABPATDFN,DA,ZDA))
- .I +ABPAPCNT<2 D
- ..K DIE,DR S DA(1)=ABPATDFN,DIE="^ABPVAO("_DA(1)_",1,",DR=".18///O"
- ..D ^DIE W "."
- .I +ABPAPCNT>1 D
- ..K DIE,DR S DA(1)=ABPATDFN,DIE="^ABPVAO("_DA(1)_",1,"
- ..S DR=".18///"_$P(^ABPVAO(DA(1),1,DA,0),"^",17)
- ..D ^DIE W "."
- .K DIE,DR S DA(1)=ABPATDFN,DIE="^ABPVAO("_DA(1)_",1,",DR=".03///@"
- .D ^DIE
- .Q
- ;--------------------------------------------------------------------
- A2 ;PROCEDURE TO DELETE THE INSURER PAYMENT NODE
- K DIC,DIE,DA,DR,DIK,ABPA("I"),ABPA("QF")
- S DA(1)=ABPATDFN,DA=ABPADDFN,DIK="^ABPVAO("_DA(1)_",""P"","
- D ^DIK W "."
- ;--------------------------------------------------------------------
- A3 ;PROCEDURE TO ADJUST CHECK BALANCES
- I ABPACHK]"" F I=0:0 D Q:GOTCHECK
- .S (RESTRICT,GOTCHECK)=0,ABPASCR=""
- .D LOOK^ABPACKLK,CLEAR^ABPACKLK I 'GOTCHECK D Q
- ..W *7,!?5,"<<< PLEASE SELECT THE APPROPRIATE CHECK >>>"
- .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///"_$S(ABPACHK("PAMT")=0:"N",1:"P")
- .S DR=DR_";7///"_ABPACHK("PAMT")_";8///"_ABPACHK("RAMT")
- .S DR=DR_";9///"_DUZ_";10///NOW" D ^DIE
- .K DIK S DIK=DIE D IX^DIK Q
- ;--------------------------------------------------------------------
- L ^ABPVAO(ABPATDFN)
- K GOTCHECK,ABPAMESS S ABPAMESS="Deletion Complete!"
- S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN
- G ^ABPAPDD1
- ABPAPDD4 ;DELETE PAYMENT ENTRY; [ 07/09/91 7:55 AM ]
- +1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
- A0 KILL DIR
- SET DIR(0)="YO"
- SET DIR("B")="YES"
- +1 SET DIR("A")="DELETE THE CURRENT TRANSACTIONS - ARE YOUR SURE "
- +2 SET DIR("A")=DIR("A")_"(Y/N)"
- WRITE *7
- DO ^DIR
- IF 'Y
- Begin DoDot:1
- +3 KILL ABPAMESS
- SET ABPAMESS="Nothing deleted!"
- +4 SET ABPAMESS(2)="... Press any key to continue ... "
- DO PAUSE^ABPAMAIN
- End DoDot:1
- GOTO ^ABPAPDD1
- A0A WRITE !,"The '",ABPABDT,"' transactions for ",ABPAPAT," are being deleted "
- +1 ;--------------------------------------------------------------------
- A1 ;PROCEDURE TO RESET CLAIM FLAGS AND WRITE-OFF FIELDS
- +1 KILL DIC,DIE,DA,DR,DIK,ABPA("QF"),ABPADOS
- +2 SET ABPADOS=0
- FOR ABPA("I")=0:0
- Begin DoDot:1
- +3 SET ABPADOS=$ORDER(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADOS))
- +4 IF +ABPADOS=0
- SET ABPA("QF")=""
- QUIT
- +5 SET DA=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADOS,0),"^",2)
- +6 IF (+DA<1)!($DATA(^ABPVAO(ABPATDFN,1,DA,0))'=1)
- QUIT
- +7 SET ZDA=0
- FOR ABPAPCNT=0:1
- Begin DoDot:2
- +8 SET ZDA=$ORDER(^ABPVAO("PD",ABPATDFN,DA,ZDA))
- End DoDot:2
- IF +ZDA=0
- KILL ZDA
- QUIT
- +9 IF +ABPAPCNT<2
- Begin DoDot:2
- +10 KILL DIE,DR
- SET DA(1)=ABPATDFN
- SET DIE="^ABPVAO("_DA(1)_",1,"
- SET DR=".18///O"
- +11 DO ^DIE
- WRITE "."
- End DoDot:2
- +12 IF +ABPAPCNT>1
- Begin DoDot:2
- +13 KILL DIE,DR
- SET DA(1)=ABPATDFN
- SET DIE="^ABPVAO("_DA(1)_",1,"
- +14 SET DR=".18///"_$PIECE(^ABPVAO(DA(1),1,DA,0),"^",17)
- +15 DO ^DIE
- WRITE "."
- End DoDot:2
- +16 KILL DIE,DR
- SET DA(1)=ABPATDFN
- SET DIE="^ABPVAO("_DA(1)_",1,"
- SET DR=".03///@"
- +17 DO ^DIE
- +18 QUIT
- End DoDot:1
- IF $DATA(ABPA("QF"))=1
- QUIT
- +19 ;--------------------------------------------------------------------
- A2 ;PROCEDURE TO DELETE THE INSURER PAYMENT NODE
- +1 KILL DIC,DIE,DA,DR,DIK,ABPA("I"),ABPA("QF")
- +2 SET DA(1)=ABPATDFN
- SET DA=ABPADDFN
- SET DIK="^ABPVAO("_DA(1)_",""P"","
- +3 DO ^DIK
- WRITE "."
- +4 ;--------------------------------------------------------------------
- A3 ;PROCEDURE TO ADJUST CHECK BALANCES
- +1 IF ABPACHK]""
- FOR I=0:0
- Begin DoDot:1
- +2 SET (RESTRICT,GOTCHECK)=0
- SET ABPASCR=""
- +3 DO LOOK^ABPACKLK
- DO CLEAR^ABPACKLK
- IF 'GOTCHECK
- Begin DoDot:2
- +4 WRITE *7,!?5,"<<< PLEASE SELECT THE APPROPRIATE CHECK >>>"
- End DoDot:2
- QUIT
- +5 KILL DIE,DA,DR
- SET DA(2)=$ORDER(ABPACHK(""))
- SET DA(1)=$ORDER(ABPACHK(DA(2),""))
- +6 SET DA=$ORDER(ABPACHK(DA(2),DA(1),""))
- +7 SET DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
- +8 SET ABPACHK("RAMT")=ABPACHK("RAMT")+ABPA("STDAMT")
- +9 SET ABPACHK("PAMT")=ABPACHK("AMT")-ABPACHK("RAMT")
- +10 SET DR="6///"_$SELECT(ABPACHK("PAMT")=0:"N",1:"P")
- +11 SET DR=DR_";7///"_ABPACHK("PAMT")_";8///"_ABPACHK("RAMT")
- +12 SET DR=DR_";9///"_DUZ_";10///NOW"
- DO ^DIE
- +13 KILL DIK
- SET DIK=DIE
- DO IX^DIK
- QUIT
- End DoDot:1
- IF GOTCHECK
- QUIT
- +14 ;--------------------------------------------------------------------
- +15 LOCK ^ABPVAO(ABPATDFN)
- +16 KILL GOTCHECK,ABPAMESS
- SET ABPAMESS="Deletion Complete!"
- +17 SET ABPAMESS(2)="... Press any key to continue ... "
- DO PAUSE^ABPAMAIN
- +18 GOTO ^ABPAPDD1
