ABPAROCC.m

ABPAROCC ;RE-OPEN CLOSED PATIENT BILL;[ 07/25/91  8:06 AM ]

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

 W !!,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!! Q

START ;ENTRY POINT

 ;PROCEDURE TO RE-OPEN A CLOSED PATIENT BILL;REMOVES WRITE-OFF AMOUNTS

 D XIT,DT^DICRW S ABPAHD1="Delete Current Write-offs"

 D HEADER^ABPAMAIN W !! D ^ABPAPATL I $D(ABPATDFN)'=1 G XIT

 K DIC,DA S DIC="^ABPVAO("_ABPATDFN_",1,",DIC(0)="AEQZ",DA(1)=ABPATDFN

 S DIC("S")="I $P(^ABPVAO(DA(1),1,+Y,0),U,17)=""C"""

 W ! D ^DIC G:+Y'>0 START S ABPA("WO")=$P(Y(0),"^",3),ABPACDFN=+Y

 S ABPAFRDT=+Y(0),ABPATODT=ABPAFRDT,$P(ABPAXX,"=",81)="" D ^ABPAPD2C

 I ABPA("WO")>0 D  G PAUSE

 .W *7,!,"I am going to remove the $",$J(ABPA("WO"),8,2)," write-off."

 .K DIR S DIR(0)="Y",DIR("A")="Is this O.K.",DIR("B")="YES" D ^DIR

 .I 'Y W " ... Bill not re-opened!" Q

 .K DIC,DIE,DA,DR S DIE="^ABPVAO("_ABPATDFN_",1,",DR=".03///0;.18///PA"

 .S DA(1)=ABPATDFN,DA=ABPACDFN D ^DIE W " ... Bill re-opened!"

 K ABPAMESS S ABPAMESS="There is no write-off to delete!"

 S ABPAMESS(2)="... Press any key to continue ... "

PAUSE D PAUSE^ABPAMAIN

XIT K DIC,DIE,DA,DR,X,Y,ABPATDFN,DIR,ABPACDFN

ABPAROCC  ;RE-OPEN CLOSED PATIENT BILL;[ 07/25/91  8:06 AM ]

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

 +2        WRITE !!,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!!

           QUIT 

START     ;ENTRY POINT

 +1       ;PROCEDURE TO RE-OPEN A CLOSED PATIENT BILL;REMOVES WRITE-OFF AMOUNTS

 +2        DO XIT

           DO DT^DICRW

           SET ABPAHD1="Delete Current Write-offs"

 +3        DO HEADER^ABPAMAIN

           WRITE !!

           DO ^ABPAPATL

           IF $DATA(ABPATDFN)'=1

               GOTO XIT

 +4        KILL DIC,DA

           SET DIC="^ABPVAO("_ABPATDFN_",1,"

           SET DIC(0)="AEQZ"

           SET DA(1)=ABPATDFN

 +5        SET DIC("S")="I $P(^ABPVAO(DA(1),1,+Y,0),U,17)=""C"""

 +6        WRITE !

           DO ^DIC

           IF +Y'>0

               GOTO START

           SET ABPA("WO")=$PIECE(Y(0),"^",3)

           SET ABPACDFN=+Y

 +7        SET ABPAFRDT=+Y(0)

           SET ABPATODT=ABPAFRDT

           SET $PIECE(ABPAXX,"=",81)=""

           DO ^ABPAPD2C

 +8        IF ABPA("WO")>0

               Begin DoDot:1

 +9                WRITE *7,!,"I am going to remove the $",$JUSTIFY(ABPA("WO"),8,2)," write-off."

 +10               KILL DIR

                   SET DIR(0)="Y"

                   SET DIR("A")="Is this O.K."

                   SET DIR("B")="YES"

                   DO ^DIR

 +11               IF 'Y

                       WRITE " ... Bill not re-opened!"

                       QUIT 

 +12               KILL DIC,DIE,DA,DR

                   SET DIE="^ABPVAO("_ABPATDFN_",1,"

                   SET DR=".03///0;.18///PA"

 +13               SET DA(1)=ABPATDFN

                   SET DA=ABPACDFN

                   DO ^DIE

                   WRITE " ... Bill re-opened!"

               End DoDot:1

               GOTO PAUSE

 +14       KILL ABPAMESS

           SET ABPAMESS="There is no write-off to delete!"

 +15       SET ABPAMESS(2)="... Press any key to continue ... "

PAUSE      DO PAUSE^ABPAMAIN

XIT        KILL DIC,DIE,DA,DR,X,Y,ABPATDFN,DIR,ABPACDFN