- 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