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
Q
;
;--------------------
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
Q
;
;--------------------
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)
Q
;
;--------------------
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
Q
;
;--------------------
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
Q
;
;--------------------
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
Q
;
;--------------------
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)."
Q
;
;--------------------
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
Q
;
;--------------------
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
Q
;
;--------------------
EOJ ;
;D ^BARVKL0
D EN^XBVK("BAR"),EN^XBVK("AMB")
Q
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
