ABPAPDD1.m

ABPAPDD1 ;PVT-INS PYMT DELETE CONTINUED;[ 06/25/91  4:00 PM ]

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

BEG D XIT S U="^"

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

 D ^ABPAHD W !,"*"

 S X="CURRENT BATCH FACILITY: "_$P(^DIC(4,ABPASITE,0),"^",1)

 W ?(40-($L(X)/2)),X,?78,"*",! F X=1:1:79 W "*"

 S X="BATCH DATE = "_ABPABDT W !!?(40-($L(X)/2)),X

PAT W !! D ^ABPAPATL

 I $D(ABPATDFN)'=1 K ABPA("HD") D  G FAC^ABPAPDD0

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

 .D ^ABPAHD S X="BATCH DATE = "_ABPABDT W !!?(40-($L(X)/2)),X

 G:+ABPATDFN<1 BEG

 L ^ABPVAO(ABPATDFN):3 I '$T D  G PAT

 .W *7,!!?5,"<<< PATIENT RECORD UNAVAILABLE AT THIS TIME -- "

 .W "TRY AGAIN LATER"

LOOK I $D(^ABPVAO("BD",ABPABDFN,ABPATDFN))'=10 D  G PAT

 .W *7,!!?10,"<<< NO PAYMENT RECORD (FOR THIS BATCH DATE) FOUND >>>"

 .L ^ABPVAO(ABPATDFN)

 D ^ABPAPDEM

 I $D(ABPADDFN)=0 G BEG

 I +ABPADDFN<1 D  G PAT

 .W *7,!!?10,"<<< GLOBAL ERROR DETECTED - PLEASE CONTACT YOUR SYSTEM"

 .L ^ABPVAO(ABPATDFN)

 .W " MANAGER"

 S $P(ABPAX,"=",80)="",$P(ABPAXX,"-",80)=""

CONT G ^ABPAPDD2

XIT K ABPARECV,ABPAPD,ABPAENT,ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D

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

 K ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,%DT,ABPAFRDT,ABPATODT,ABPAX Q

ABPAPDD1  ;PVT-INS PYMT DELETE CONTINUED;[ 06/25/91  4:00 PM ]

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

BEG        DO XIT

           SET U="^"

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

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

 +2        DO ^ABPAHD

           WRITE !,"*"

 +3        SET X="CURRENT BATCH FACILITY: "_$PIECE(^DIC(4,ABPASITE,0),"^",1)

 +4        WRITE ?(40-($LENGTH(X)/2)),X,?78,"*",!

           FOR X=1:1:79

               WRITE "*"

 +5        SET X="BATCH DATE = "_ABPABDT

           WRITE !!?(40-($LENGTH(X)/2)),X

PAT        WRITE !!

           DO ^ABPAPATL

 +1        IF $DATA(ABPATDFN)'=1

               KILL ABPA("HD")

               Begin DoDot:1

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

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

 +3                DO ^ABPAHD

                   SET X="BATCH DATE = "_ABPABDT

                   WRITE !!?(40-($LENGTH(X)/2)),X

               End DoDot:1

               GOTO FAC^ABPAPDD0

 +4        IF +ABPATDFN<1

               GOTO BEG

 +5        LOCK ^ABPVAO(ABPATDFN):3

           IF '$TEST

               Begin DoDot:1

 +6                WRITE *7,!!?5,"<<< PATIENT RECORD UNAVAILABLE AT THIS TIME -- "

 +7                WRITE "TRY AGAIN LATER"

               End DoDot:1

               GOTO PAT

LOOK       IF $DATA(^ABPVAO("BD",ABPABDFN,ABPATDFN))'=10

               Begin DoDot:1

 +1                WRITE *7,!!?10,"<<< NO PAYMENT RECORD (FOR THIS BATCH DATE) FOUND >>>"

 +2                LOCK ^ABPVAO(ABPATDFN)

               End DoDot:1

               GOTO PAT

 +3        DO ^ABPAPDEM

 +4        IF $DATA(ABPADDFN)=0

               GOTO BEG

 +5        IF +ABPADDFN<1

               Begin DoDot:1

 +6                WRITE *7,!!?10,"<<< GLOBAL ERROR DETECTED - PLEASE CONTACT YOUR SYSTEM"

 +7                LOCK ^ABPVAO(ABPATDFN)

 +8                WRITE " MANAGER"

               End DoDot:1

               GOTO PAT

 +9        SET $PIECE(ABPAX,"=",80)=""

           SET $PIECE(ABPAXX,"-",80)=""

CONT       GOTO ^ABPAPDD2

XIT        KILL ABPARECV,ABPAPD,ABPAENT,ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D

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

 +2        KILL ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,%DT,ABPAFRDT,ABPATODT,ABPAX

           QUIT