ABPAPD8 ;CANCEL/DELETE PAYMENT ENTRY; [ 07/09/91 7:51 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 G DISP^ABPAPD3:'Y
A0A W !,"The current transactions for '",ABPAPAT,"' are being deleted "
A1 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)
.K DIE,DR S DA(1)=ABPATDFN,DIE="^ABPVAO("_DA(1)_",1,",DR=".03///@"
.D ^DIE 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 "."
A2 K DIC,DIE,DA,DR,DIK,ABPA("I"),ABPA("QF"),ABPAPCNT
S DA(1)=ABPATDFN,DA=ABPADDFN,DIK="^ABPVAO("_DA(1)_",""P"","
D ^DIK W "." H 1 L ^ABPVAO(ABPATDFN)
G ^ABPAPD1
ABPAPD8 ;CANCEL/DELETE PAYMENT ENTRY; [ 07/09/91 7:51 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
GOTO DISP^ABPAPD3
A0A WRITE !,"The current transactions for '",ABPAPAT,"' are being deleted "
A1 KILL DIC,DIE,DA,DR,DIK,ABPA("QF"),ABPADOS
+1 SET ABPADOS=0
FOR ABPA("I")=0:0
Begin DoDot:1
+2 SET ABPADOS=$ORDER(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADOS))
+3 IF +ABPADOS=0
SET ABPA("QF")=""
QUIT
+4 SET DA=$PIECE(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADOS,0),"^",2)
+5 IF (+DA<1)!($DATA(^ABPVAO(ABPATDFN,1,DA,0))'=1)
QUIT
+6 KILL DIE,DR
SET DA(1)=ABPATDFN
SET DIE="^ABPVAO("_DA(1)_",1,"
SET DR=".03///@"
+7 DO ^DIE
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
End DoDot:1
IF $DATA(ABPA("QF"))=1
QUIT
A2 KILL DIC,DIE,DA,DR,DIK,ABPA("I"),ABPA("QF"),ABPAPCNT
+1 SET DA(1)=ABPATDFN
SET DA=ABPADDFN
SET DIK="^ABPVAO("_DA(1)_",""P"","
+2 DO ^DIK
WRITE "."
HANG 1
LOCK ^ABPVAO(ABPATDFN)
+3 GOTO ^ABPAPD1