ABPAPDD0.m

ABPAPDD0 ;PVT-INS PAYMENT DELETE (START); [ 06/26/91  8:12 PM ]

 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

 D XIT,CURRENT^%ZIS S U="^"

 S ABPA("HD",1)=ABPATLE,ABPA("HD",2)="DELETE existing payments"

 D ^ABPAHD

BATDT D ^ABPAGPB I $D(ABPABDT)'=1 D XIT G END

 K ABPA("HD")

 S ABPA("HD",1)=ABPATLE,ABPA("HD",2)="DELETE existing payments"

 D ^ABPAHD W !!

 S D0=ABPABDFN K DXS D ^ABPABAT K DXS

FAC K DIC S DIC="^DIC(4,",DIC(0)="AEQZ",DIC("A")="Select BATCH FACILITY: "

 W !! D ^DIC I +Y<1 D  G ABPAPDD0

 .D ^ABPABRC0,XIT S U="^"

 .S ABPA("HD",1)=ABPATLE_" - DELETE existing payments"

 .S ABPA("HD",2)="BATCH SUMMARY" D ^ABPAHD W !!

 .S D0=ABPABDFN K DXS D ^ABPABAT K DXS

 .W ! F X=1:1:79 W "="

 .D CLOSE^ABPABRC0,PAUSE^ABPAMAIN

 .L

 S ABPASITE=+Y

CONT G ^ABPAPDD1

XIT K ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D,ABPAX,ABPAFRDT,ABPATODT

 K ABPA,ABPAL,DIC,C,ABPADT,ABPAQKS,ABPAQK,ABPAHRN,DA,J,K,Z,XQH

 K ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,ABPAPD,ABPABDT,ABPASITE,DIC,X,Y Q

END K ABPA("I"),ABPABDFN Q

ABPAPDD0  ;PVT-INS PAYMENT DELETE (START); [ 06/26/91  8:12 PM ]

 +1       ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

 +2        DO XIT

           DO CURRENT^%ZIS

           SET U="^"

 +3        SET ABPA("HD",1)=ABPATLE

           SET ABPA("HD",2)="DELETE existing payments"

 +4        DO ^ABPAHD

BATDT      DO ^ABPAGPB

           IF $DATA(ABPABDT)'=1

               DO XIT

               GOTO END

 +1        KILL ABPA("HD")

 +2        SET ABPA("HD",1)=ABPATLE

           SET ABPA("HD",2)="DELETE existing payments"

 +3        DO ^ABPAHD

           WRITE !!

 +4        SET D0=ABPABDFN

           KILL DXS

           DO ^ABPABAT

           KILL DXS

FAC        KILL DIC

           SET DIC="^DIC(4,"

           SET DIC(0)="AEQZ"

           SET DIC("A")="Select BATCH FACILITY: "

 +1        WRITE !!

           DO ^DIC

           IF +Y<1

               Begin DoDot:1

 +2                DO ^ABPABRC0

                   DO XIT

                   SET U="^"

 +3                SET ABPA("HD",1)=ABPATLE_" - DELETE existing payments"

 +4                SET ABPA("HD",2)="BATCH SUMMARY"

                   DO ^ABPAHD

                   WRITE !!

 +5                SET D0=ABPABDFN

                   KILL DXS

                   DO ^ABPABAT

                   KILL DXS

 +6                WRITE !

                   FOR X=1:1:79

                       WRITE "="

 +7                DO CLOSE^ABPABRC0

                   DO PAUSE^ABPAMAIN

 +8                LOCK 

               End DoDot:1

               GOTO ABPAPDD0

 +9        SET ABPASITE=+Y

CONT       GOTO ^ABPAPDD1

XIT        KILL ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D,ABPAX,ABPAFRDT,ABPATODT

 +1        KILL ABPA,ABPAL,DIC,C,ABPADT,ABPAQKS,ABPAQK,ABPAHRN,DA,J,K,Z,XQH

 +2        KILL ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,ABPAPD,ABPABDT,ABPASITE,DIC,X,Y

           QUIT 

END        KILL ABPA("I"),ABPABDFN

           QUIT