ABPAPD8.m

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