Routine: BZSMAWO3

BZSMAWO3 ; IHS/TAO/EDE - WRITE OFF OLD BILLS REVERSAL [ 04/06/2003  9:29 AM ]

 ;;1.0;TUCSON AREA OFFICE W/O;;MAR 14, 2003

 ;     Reverse all transactions of transaction type 43 (Adjustment)

 ;     with Adjustment category 3 (Write-off)

 ;     with Adjustment type 1003 (TAO Auto Write-off)

START ;

 D NOW^%DTC

 S BZSNOW=%

 D NOTE

 Q:'BZSCONT

 D LOOP

 W !!,BZSCNT," Bills with Auto Write off (1003) reversed."

 D EOJ

 ;--------------------

NOTE ; TELL USER WHAT IS GOING TO HAPPEN

 S BZSCONT=0

 W !!,$$EN^BARVDF("RVN"),"NOTE:",$$EN^BARVDF("RVF")

 W ?7,"All transactions (at all facilities) of transaction type 43 (Adjustment)"

 W !?7,"with Adjustment Category 3 (Write Off)"

 W !?7,"and Adjustment Type 1003 (Paid Denied Over Stat Limit)"

 W !?7,"will be reversed by creating a new transaction of the same type,"

 W !?7,"but negative dollar amount."

 W !!?7,$$EN^BARVDF("RVN"),"ALSO,",$$EN^BARVDF("RVF")," the bill will be re-opened in 3PB with a balance due."

 D CHECK                          ; See if this has been run before

 Q:BZSDONE

 W !!,"The bill number and amount written off will scroll by on the screen"

 W !,"if you wish to capture this information.",!

 K DIR

 S DIR(0)="Y"

 S DIR("A")="Continue"

 S DIR("B")="No"

 D ^DIR

 K DIR

 S:Y=1 BZSCONT=1

 ;--------------------

CHECK ;

 ; Check to see if this option has already been run

 S BZSDONE=0

 I $D(^BZSTMP("AWO-REVERSE")) D  Q

 . S Y=^BZSTMP("AWO-REVERSE")

 . D DD^%DT

 . S BZSDONDT=Y

 . S BZSDONE=1

 . S $P(BZSDASH,"*",54)=""

 . W !!?14,BZSDASH

 . W !?14,"* This routine was already executed on ",BZSDONDT,". *"

 . W !?14,"*",?24,"It may not be executed again.",?66,"*"

 . W !?14,BZSDASH

 . D EOP^BARUTL(0)

 ;--------------------

LOOP ; LOOP ALL DUZ(2) IN TRANSACTION FILE

 S BZSCNT=0

 S ^BZSTMP("AWO-REVERSE")=DT

 S BZSHOLD=DUZ(2)

 S DUZ(2)=0

 F  S DUZ(2)=$O(^BARTR(DUZ(2))) Q:'+DUZ(2)  D TRANS

 S DUZ(2)=BZSHOLD

 ;--------------------

TRANS ; LOOP TRANSACTIONS FOR EACH DUZ(2)

 ; Loop transactions after 03/01/2003 @ 7:00 for each DUZ(2). This

 ; date and time used because code 1003 did not exist before then.

 S BZSDTTR=3030301.07

 F  S BZSDTTR=$O(^BARTR(DUZ(2),BZSDTTR)) Q:('+BZSDTTR!(BZSDTTR>BZSNOW))  D ISITAWO

 ;--------------------

ISITAWO ; CHECK TO SEE IF TRANS IS TAO AWO 1003

 S BZSTR(0)=$G(^BARTR(DUZ(2),BZSDTTR,0))    ; A/R Transaction 0 node

 S BZSTR(1)=$G(^BARTR(DUZ(2),BZSDTTR,1))    ; A/R Transaction 1 node

 I $P(BZSTR(1),U)=43,$P(BZSTR(1),U,2)=3,$P(BZSTR(1),U,3)=1003 D

 . D REVERSE

 . D ROLLBILL

 ;--------------------

REVERSE ; REVERSE THE TAO 1003 WRITE OFF

 S BZSTRIEN=$$NEW^BARTR ;                   Create new transaction

 S DA=BZSTRIEN

 S DIE=90050.03

 S DR="2////^S X=-$P(BZSTR(0),U,2)"       ; Credit ($$$)

 S DR=DR_";4////^S X=$P(BZSTR(0),U,4)"    ; A/R Bill

 S DR=DR_";5////^S X=$P(BZSTR(0),U,5)"    ; A/R Patient

 S DR=DR_";6////^S X=$P(BZSTR(0),U,6)"    ; A/R Account

 S DR=DR_";8////^S X=$P(BZSTR(0),U,8)"    ; Parent Location

 S DR=DR_";9////^S X=$P(BZSTR(0),U,9)"    ; Parent ASUFAC

 S DR=DR_";10////^S X=$P(BZSTR(0),U,10)"  ; A/R Section

 S DR=DR_";11////^S X=$P(BZSTR(0),U,11)"  ; Visit location

 S DR=DR_";12////^S X=DT"                 ; Date

 S DR=DR_";13////^S X=DUZ"                ; A/R Entry by

 S DR=DR_";101////43"                     ; Transaction type (Adj)

 S DR=DR_";102////3"                      ; Adj Category (Write off)

 S DR=DR_";103////1003"                  ; Adj Type (TAO Auto Write off)

 S DIDEL=90050

 D ^BARDIE ;                                Populate transaction file

 K DIDEL,DIE,DA,DR

 D TR^BARTDO(BZSTRIEN) ;                    Post from trans to files

 K BARBL

 S BZSCNT=BZSCNT+1

 S BZSBILL=$$GET1^DIQ(90050.01,$P(BZSTR(0),U,4),.01)

 W !,BZSBILL,?25," for ",$J($FN(-$P(BZSTR(0),U,2),",",2),10)," written off (reversed)."

 ;--------------------

ROLLBILL ; UPDATE PAYMENT MULTIPLE IN 3PB, MARK AS BILLED IN 3PB

 ; For bills reversed, update the payment multiple in 3PB and mark the

 ; bill as BILLED in 3PB Bill File.

 S BARBLDA=$P(BZSTR(0),U,4)

 D SETVAR^BARROLL                          ; Set A/R vars to roll to 3PB

 D ROLL^BZSMAWO2

 D BILLED

 ;--------------------

BILLED ; MARK BILL IN 3PB BILL FILE AS BILLED

 S DIE="^ABMDBILL(DUZ(2),"

 S DA=ABMP("BDFN")

 S DR=".04////B"

 D ^DIE

 K DR

 ;--------------------

EOJ ;

 ;D ^BARVKL0

 D EN^XBVK("BAR"),EN^XBVK("AMB")

BZSMAWO3  ; IHS/TAO/EDE - WRITE OFF OLD BILLS REVERSAL [ 04/06/2003  9:29 AM ]

 +1       ;;1.0;TUCSON AREA OFFICE W/O;;MAR 14, 2003

 +2       ;

 +3       ;     Reverse all transactions of transaction type 43 (Adjustment)

 +4       ;     with Adjustment category 3 (Write-off)

 +5       ;     with Adjustment type 1003 (TAO Auto Write-off)

 +6       ;

START     ;

 +1        DO NOW^%DTC

 +2        SET BZSNOW=%

 +3        DO NOTE

 +4        IF 'BZSCONT

               QUIT

 +5        DO LOOP

 +6        WRITE !!,BZSCNT," Bills with Auto Write off (1003) reversed."

 +7        DO EOJ

 +8        QUIT

 +9       ;

 +10      ;--------------------

NOTE      ; TELL USER WHAT IS GOING TO HAPPEN

 +1        SET BZSCONT=0

 +2        WRITE !!,$$EN^BARVDF("RVN"),"NOTE:",$$EN^BARVDF("RVF")

 +3        WRITE ?7,"All transactions (at all facilities) of transaction type 43 (Adjustment)"

 +4        WRITE !?7,"with Adjustment Category 3 (Write Off)"

 +5        WRITE !?7,"and Adjustment Type 1003 (Paid Denied Over Stat Limit)"

 +6        WRITE !?7,"will be reversed by creating a new transaction of the same type,"

 +7        WRITE !?7,"but negative dollar amount."

 +8        WRITE !!?7,$$EN^BARVDF("RVN"),"ALSO,",$$EN^BARVDF("RVF")," the bill will be re-opened in 3PB with a balance due."

 +9       ;

 +10      ; See if this has been run before

           DO CHECK

 +11       IF BZSDONE

               QUIT

 +12      ;

 +13       WRITE !!,"The bill number and amount written off will scroll by on the screen"

 +14       WRITE !,"if you wish to capture this information.",!

 +15      ;

 +16       KILL DIR

 +17       SET DIR(0)="Y"

 +18       SET DIR("A")="Continue"

 +19       SET DIR("B")="No"

 +20       DO ^DIR

 +21       KILL DIR

 +22       IF Y=1

               SET BZSCONT=1

 +23       QUIT

 +24      ;

 +25      ;--------------------

CHECK     ;

 +1       ; Check to see if this option has already been run

 +2        SET BZSDONE=0

 +3        IF $DATA(^BZSTMP("AWO-REVERSE"))

               Begin DoDot:1

 +4                SET Y=^BZSTMP("AWO-REVERSE")

 +5                DO DD^%DT

 +6                SET BZSDONDT=Y

 +7                SET BZSDONE=1

 +8                SET $PIECE(BZSDASH,"*",54)=""

 +9                WRITE !!?14,BZSDASH

 +10               WRITE !?14,"* This routine was already executed on ",BZSDONDT,". *"

 +11               WRITE !?14,"*",?24,"It may not be executed again.",?66,"*"

 +12               WRITE !?14,BZSDASH

 +13               DO EOP^BARUTL(0)

               End DoDot:1

               QUIT

 +14       QUIT

 +15      ;

 +16      ;--------------------

LOOP      ; LOOP ALL DUZ(2) IN TRANSACTION FILE

 +1        SET BZSCNT=0

 +2        SET ^BZSTMP("AWO-REVERSE")=DT

 +3        SET BZSHOLD=DUZ(2)

 +4        SET DUZ(2)=0

 +5        FOR

               SET DUZ(2)=$ORDER(^BARTR(DUZ(2)))

               IF '+DUZ(2)

                   QUIT

               DO TRANS

 +6        SET DUZ(2)=BZSHOLD

 +7        QUIT

 +8       ;

 +9       ;--------------------

TRANS     ; LOOP TRANSACTIONS FOR EACH DUZ(2)

 +1       ; Loop transactions after 03/01/2003 @ 7:00 for each DUZ(2). This

 +2       ; date and time used because code 1003 did not exist before then.

 +3        SET BZSDTTR=3030301.07

 +4        FOR

               SET BZSDTTR=$ORDER(^BARTR(DUZ(2),BZSDTTR))

               IF ('+BZSDTTR!(BZSDTTR>BZSNOW))

                   QUIT

               DO ISITAWO

 +5        QUIT

 +6       ;

 +7       ;--------------------

ISITAWO   ; CHECK TO SEE IF TRANS IS TAO AWO 1003

 +1       ; A/R Transaction 0 node

           SET BZSTR(0)=$GET(^BARTR(DUZ(2),BZSDTTR,0))

 +2       ; A/R Transaction 1 node

           SET BZSTR(1)=$GET(^BARTR(DUZ(2),BZSDTTR,1))

 +3        IF $PIECE(BZSTR(1),U)=43

               IF $PIECE(BZSTR(1),U,2)=3

                   IF $PIECE(BZSTR(1),U,3)=1003

                       Begin DoDot:1

 +4                        DO REVERSE

 +5                        DO ROLLBILL

                       End DoDot:1

 +6        QUIT

 +7       ;

 +8       ;--------------------

REVERSE   ; REVERSE THE TAO 1003 WRITE OFF

 +1       ;                   Create new transaction

           SET BZSTRIEN=$$NEW^BARTR

 +2        SET DA=BZSTRIEN

 +3        SET DIE=90050.03

 +4       ; Credit ($$$)

           SET DR="2////^S X=-$P(BZSTR(0),U,2)"

 +5       ; A/R Bill

           SET DR=DR_";4////^S X=$P(BZSTR(0),U,4)"

 +6       ; A/R Patient

           SET DR=DR_";5////^S X=$P(BZSTR(0),U,5)"

 +7       ; A/R Account

           SET DR=DR_";6////^S X=$P(BZSTR(0),U,6)"

 +8       ; Parent Location

           SET DR=DR_";8////^S X=$P(BZSTR(0),U,8)"

 +9       ; Parent ASUFAC

           SET DR=DR_";9////^S X=$P(BZSTR(0),U,9)"

 +10      ; A/R Section

           SET DR=DR_";10////^S X=$P(BZSTR(0),U,10)"

 +11      ; Visit location

           SET DR=DR_";11////^S X=$P(BZSTR(0),U,11)"

 +12      ; Date

           SET DR=DR_";12////^S X=DT"

 +13      ; A/R Entry by

           SET DR=DR_";13////^S X=DUZ"

 +14      ; Transaction type (Adj)

           SET DR=DR_";101////43"

 +15      ; Adj Category (Write off)

           SET DR=DR_";102////3"

 +16      ; Adj Type (TAO Auto Write off)

           SET DR=DR_";103////1003"

 +17       SET DIDEL=90050

 +18      ;                                Populate transaction file

           DO ^BARDIE

 +19       KILL DIDEL,DIE,DA,DR

 +20      ;                    Post from trans to files

           DO TR^BARTDO(BZSTRIEN)

 +21       KILL BARBL

 +22       SET BZSCNT=BZSCNT+1

 +23       SET BZSBILL=$$GET1^DIQ(90050.01,$PIECE(BZSTR(0),U,4),.01)

 +24       WRITE !,BZSBILL,?25," for ",$JUSTIFY($FNUMBER(-$PIECE(BZSTR(0),U,2),",",2),10)," written off (reversed)."

 +25       QUIT

 +26      ;

 +27      ;--------------------

ROLLBILL  ; UPDATE PAYMENT MULTIPLE IN 3PB, MARK AS BILLED IN 3PB

 +1       ; For bills reversed, update the payment multiple in 3PB and mark the

 +2       ; bill as BILLED in 3PB Bill File.

 +3        SET BARBLDA=$PIECE(BZSTR(0),U,4)

 +4       ; Set A/R vars to roll to 3PB

           DO SETVAR^BARROLL

 +5        DO ROLL^BZSMAWO2

 +6        DO BILLED

 +7        QUIT

 +8       ;

 +9       ;--------------------

BILLED    ; MARK BILL IN 3PB BILL FILE AS BILLED

 +1        SET DIE="^ABMDBILL(DUZ(2),"

 +2        SET DA=ABMP("BDFN")

 +3        SET DR=".04////B"

 +4        DO ^DIE

 +5        KILL DR

 +6        QUIT

 +7       ;

 +8       ;--------------------

EOJ       ;

 +1       ;D ^BARVKL0

 +2        DO EN^XBVK("BAR")

           DO EN^XBVK("AMB")

 +3        QUIT

BZSMAWO3.m