BARMAWO3 ; IHS/SD/LSL - Automatic Write-Off UFMS NON-BEN IN ERROR 2007 - Reversal ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**2,28**;OCT 26, 2005;Build 92
;
; THIS IS TO BE USE ONLY TO REVERSE THE WRITE OFFS ON NON-BEN ACCOUNTS
; WHEN PATCH 1 OF THE UFMS WRITE-OFF 2007 WERE MSITAKENLY MADE BECAUSE
; THE OLD CODE WAS USING THE 'STANDS FOR' AND NOT THE CODE FOR VP INSURER TYPE
; THE STRING HAD BEEN CHANGED BY THE AUPN DEVELOPER AND WAS NOT PUBLICIZED.
;
; THIS ROUTINE WAS COPIED AND MODIFIED FROM BARMAWO2
; *********************************************************************
;STOP!!! STOP!!!! STOP!!!!
;IHS/SD/SDR 1.8*28 HEAT293633 - This is an old, outdated routine and shouldn't be used
; without review and possible changes. Routine EN^BARMAWO6 should be used instead. A
; quit has been added to this routine so it can't be accidentally run.
; *********************************************************************
Q
;
EN ; EP - IHS/DIT/CPC 1.8*28 CR 8349 START
W "*********************************************************************",!
W " STOP!!! STOP!!!! STOP!!!!",!
W "This is an old, outdated routine and shouldn't be used. Please ",!
W "request assistance from OIT before starting the write-off process.",!
W "*********************************************************************",!
H 10
Q ;IHS/DIT/CPC 1.8*28 CR 8349 STOP
D NOTE
Q:'BARCONT
D NOW^%DTC
S BARNOW=%
D LOOP
W !!!,BARCNT," Bills with AUTO WRITE-OFF 2007 (916) reversed."
D XIT
Q
; *********************************************************************
;
NOTE ;
S BARCONT=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 916 (AUTO WRITE-OFF 2007)"
W !?7,"will be reversed by creating a new transaction of the same type,"
W !?7,"but negative dollar amount. Only the Non-Ben entries mistakenly written"
W !?7,"off during the UFMS AUTO WRITE-OFF of 2007 in Patch 1 will be reversed"
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:BARDONE
;
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 BARCONT=1
Q
; *********************************************************************
;
CHECK ;
; Check to see if this option has already been run
S BARDONE=0
I $D(^BARTMP("AWO-NON-BEN-REVERSE")) D Q
. S Y=^BARTMP("AWO-NON-BEN-REVERSE")
. D DD^%DT
. S BARDONDT=Y
. S BARDONE=1
. S $P(BARDASH,"*",54)=""
. W !!?14,BARDASH
. W !?14,"* This option was already executed on ",BARDONDT,". *"
. W !?14,"*",?24,"It may not be executed again.",?66,"*"
. W !?14,BARDASH
. D EOP^BARUTL(0)
Q
; *********************************************************************
;
LOOP ;
; Loop all DUZ(2) in transaction file.
S ^BARTMP("AWO-NON-BEN-REVERSE")=DT
S BARCNT=0
S BARHOLD=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^BARTR(DUZ(2))) Q:'+DUZ(2) D TRANS
S DUZ(2)=BARHOLD
Q
; *********************************************************************
;
TRANS ;
; Loop transactions after APR 12,2007 @ 7:00 for each DUZ(2)
; APR 12,2007 @ 7:00 used because this is just before the release (4/13)
; of UFMS AWO coding. Code 916 did not exist before then.
S BARDTTR=3070412.07
F S BARDTTR=$O(^BARTR(DUZ(2),BARDTTR)) Q:('+BARDTTR!(BARDTTR>BARNOW)) D ISITAWO
Q
; *********************************************************************
;
ISITAWO ;
; Check to see if trans is AUTO WRITE-OFF 2007
S BARTR(0)=$G(^BARTR(DUZ(2),BARDTTR,0)) ; A/R Transaction 0 node
S BARTR(1)=$G(^BARTR(DUZ(2),BARDTTR,1)) ; A/R Transaction 1 node
;BAR*1.8*2
S BARBL=$P(BARTR(0),U,4) ;BILL IEN
Q:BARBL=""
S POSTTRAN=$O(^BARTR(DUZ(2),"AC",BARBL,BARDTTR)) ;GET NEXT TRANSACTION
I POSTTRAN'="" D
.S POSTAWO=$$GET1^DIQ(90050.03,POSTTRAN_",",103,"I")
.S POSTDEB=$$GET1^DIQ(90050.03,POSTTRAN_",",3,"I") ;GET DEBIT OF NEXT TRANS
S PRETRAN=$O(^BARTR(DUZ(2),"AC",BARBL,BARDTTR),-1) ;GET NEXT TRANSACTION
I PRETRAN'="" D
.S PREAWO=$$GET1^DIQ(90050.03,PRETRAN_",",103,"I")
.S PRECRED=$$GET1^DIQ(90050.03,PRETRAN_",",2,"I") ;GET DEBIT OF PREVIOUS TRANS
;GET ADJUSTMENT TYPE
;
;this is only for those non-ben accounts that were accidently written off
S BARACT=$P(BARTR(0),U,6)
Q:BARACT=""
S D0=BARACT ;BAR*1.8*2
S BARITYP=$$VALI^BARVPM(8) ;GET INTERNAL CODE INSTEAD OF 'STANDS FOR'
Q:BARITYP'="N" ;NON-BEN CODE
K D0
;end new code
;;ADJUST ACCOUNT - WRITE-OFF - AUTO WRITE-OFF 2007
I $P(BARTR(1),U)=43,($P(BARTR(1),U,2)=3),($P(BARTR(1),U,3)=916) D
. ;I POSTTRAN'="",($P(BARTR(0),U,2)=POSTDEB),(POSTAWO=916) Q ;IF THIS IS TRUE THEY MANUALLY REVER
. ;I PRETRAN'="",($P(BARTR(0),U,3)=PRECRED),(PREAWO=916) Q ;IF THIS IS TRUE THEY
. I POSTTRAN'="",(POSTAWO=916) Q ;IF THIS IS TRUE THEY MANUALLY REVER
. I PRETRAN'="",(PREAWO=916) Q ;IF THIS IS TRUE THEY
. D REVERSE
. D BILLED
. D ARBILL
Q
ARBILL ;
K DIR,DIE,DR,DIC,DA,DR
S DA=$P(BARTR(0),U,4)
S DIE="^BARBL(DUZ(2),"
S DR="15///^S X=$P(BARTR(0),U,2)"
D ^DIE
Q
; *********************************************************************
REVERSE ;
S BARTRIEN=$$NEW^BARTR ; Create new transaction
S DA=BARTRIEN
S DIE=90050.03
S DR="3////^S X=$P(BARTR(0),U,2)" ; PUT WRITE-OFF AMT IN DEBIT ($$$)
S DR=DR_";4////^S X=$P(BARTR(0),U,4)" ; A/R Bill
S DR=DR_";5////^S X=$P(BARTR(0),U,5)" ; A/R Patient
S DR=DR_";6////^S X=$P(BARTR(0),U,6)" ; A/R Account
S DR=DR_";8////^S X=$P(BARTR(0),U,8)" ; Parent Location
S DR=DR_";9////^S X=$P(BARTR(0),U,9)" ; Parent ASUFAC
S DR=DR_";10////^S X=$P(BARTR(0),U,10)" ; A/R Section
S DR=DR_";11////^S X=$P(BARTR(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////916" ; Adj Type (Auto Write off 2007)
S DIDEL=90050
D ^DIE ; Populate transaction file
K DIDEL,DIE,DA,DR
D TR^BARTDO(BARTRIEN) ; Post from trans to files
K BARBL
S BARCNT=BARCNT+1
S BARBILL=$$GET1^DIQ(90050.01,$P(BARTR(0),U,4),.01)
W !,BARBILL,?25," for ",$J($FN(-$P(BARTR(0),U,2),",",2),10)," written off (reversed)."
Q
; *********************************************************************
BILLED ;
S BARBLDA=$P(BARTR(0),U,4)
S ABMBIL=$$FIND3PB^BARUTL(DUZ(2),BARBLDA)
; Mark bill in 3PB Bill file as BILLED
S DIE="^ABMDBILL(DUZ(2),"
S DA=$P(ABMBIL,",",2)
S DR=".04////B"
D ^DIE
K DR
Q
; *********************************************************************
;
XIT ;
D ^BARVKL0
Q
BARMAWO3 ; IHS/SD/LSL - Automatic Write-Off UFMS NON-BEN IN ERROR 2007 - Reversal ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**2,28**;OCT 26, 2005;Build 92
+2 ;
+3 ; THIS IS TO BE USE ONLY TO REVERSE THE WRITE OFFS ON NON-BEN ACCOUNTS
+4 ; WHEN PATCH 1 OF THE UFMS WRITE-OFF 2007 WERE MSITAKENLY MADE BECAUSE
+5 ; THE OLD CODE WAS USING THE 'STANDS FOR' AND NOT THE CODE FOR VP INSURER TYPE
+6 ; THE STRING HAD BEEN CHANGED BY THE AUPN DEVELOPER AND WAS NOT PUBLICIZED.
+7 ;
+8 ; THIS ROUTINE WAS COPIED AND MODIFIED FROM BARMAWO2
+9 ; *********************************************************************
+10 ;STOP!!! STOP!!!! STOP!!!!
+11 ;IHS/SD/SDR 1.8*28 HEAT293633 - This is an old, outdated routine and shouldn't be used
+12 ; without review and possible changes. Routine EN^BARMAWO6 should be used instead. A
+13 ; quit has been added to this routine so it can't be accidentally run.
+14 ; *********************************************************************
+15 QUIT
+16 ;
EN ; EP - IHS/DIT/CPC 1.8*28 CR 8349 START
+1 WRITE "*********************************************************************",!
+2 WRITE " STOP!!! STOP!!!! STOP!!!!",!
+3 WRITE "This is an old, outdated routine and shouldn't be used. Please ",!
+4 WRITE "request assistance from OIT before starting the write-off process.",!
+5 WRITE "*********************************************************************",!
+6 HANG 10
+7 ;IHS/DIT/CPC 1.8*28 CR 8349 STOP
QUIT
+8 DO NOTE
+9 IF 'BARCONT
QUIT
+10 DO NOW^%DTC
+11 SET BARNOW=%
+12 DO LOOP
+13 WRITE !!!,BARCNT," Bills with AUTO WRITE-OFF 2007 (916) reversed."
+14 DO XIT
+15 QUIT
+16 ; *********************************************************************
+17 ;
NOTE ;
+1 SET BARCONT=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 916 (AUTO WRITE-OFF 2007)"
+6 WRITE !?7,"will be reversed by creating a new transaction of the same type,"
+7 WRITE !?7,"but negative dollar amount. Only the Non-Ben entries mistakenly written"
+8 WRITE !?7,"off during the UFMS AUTO WRITE-OFF of 2007 in Patch 1 will be reversed"
+9 WRITE !!?7,$$EN^BARVDF("RVN"),"ALSO,",$$EN^BARVDF("RVF")," the bill will be re-opened in 3PB with a balance due."
+10 ;
+11 ; See if this has been run before
DO CHECK
+12 IF BARDONE
QUIT
+13 ;
+14 WRITE !!,"The bill number and amount written off will scroll by on the screen"
+15 WRITE !,"if you wish to capture this information.",!
+16 ;
+17 KILL DIR
+18 SET DIR(0)="Y"
+19 SET DIR("A")="Continue"
+20 SET DIR("B")="No"
+21 DO ^DIR
+22 KILL DIR
+23 IF Y=1
SET BARCONT=1
+24 QUIT
+25 ; *********************************************************************
+26 ;
CHECK ;
+1 ; Check to see if this option has already been run
+2 SET BARDONE=0
+3 IF $DATA(^BARTMP("AWO-NON-BEN-REVERSE"))
Begin DoDot:1
+4 SET Y=^BARTMP("AWO-NON-BEN-REVERSE")
+5 DO DD^%DT
+6 SET BARDONDT=Y
+7 SET BARDONE=1
+8 SET $PIECE(BARDASH,"*",54)=""
+9 WRITE !!?14,BARDASH
+10 WRITE !?14,"* This option was already executed on ",BARDONDT,". *"
+11 WRITE !?14,"*",?24,"It may not be executed again.",?66,"*"
+12 WRITE !?14,BARDASH
+13 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+14 QUIT
+15 ; *********************************************************************
+16 ;
LOOP ;
+1 ; Loop all DUZ(2) in transaction file.
+2 SET ^BARTMP("AWO-NON-BEN-REVERSE")=DT
+3 SET BARCNT=0
+4 SET BARHOLD=DUZ(2)
+5 SET DUZ(2)=0
+6 FOR
SET DUZ(2)=$ORDER(^BARTR(DUZ(2)))
IF '+DUZ(2)
QUIT
DO TRANS
+7 SET DUZ(2)=BARHOLD
+8 QUIT
+9 ; *********************************************************************
+10 ;
TRANS ;
+1 ; Loop transactions after APR 12,2007 @ 7:00 for each DUZ(2)
+2 ; APR 12,2007 @ 7:00 used because this is just before the release (4/13)
+3 ; of UFMS AWO coding. Code 916 did not exist before then.
+4 SET BARDTTR=3070412.07
+5 FOR
SET BARDTTR=$ORDER(^BARTR(DUZ(2),BARDTTR))
IF ('+BARDTTR!(BARDTTR>BARNOW))
QUIT
DO ISITAWO
+6 QUIT
+7 ; *********************************************************************
+8 ;
ISITAWO ;
+1 ; Check to see if trans is AUTO WRITE-OFF 2007
+2 ; A/R Transaction 0 node
SET BARTR(0)=$GET(^BARTR(DUZ(2),BARDTTR,0))
+3 ; A/R Transaction 1 node
SET BARTR(1)=$GET(^BARTR(DUZ(2),BARDTTR,1))
+4 ;BAR*1.8*2
+5 ;BILL IEN
SET BARBL=$PIECE(BARTR(0),U,4)
+6 IF BARBL=""
QUIT
+7 ;GET NEXT TRANSACTION
SET POSTTRAN=$ORDER(^BARTR(DUZ(2),"AC",BARBL,BARDTTR))
+8 IF POSTTRAN'=""
Begin DoDot:1
+9 SET POSTAWO=$$GET1^DIQ(90050.03,POSTTRAN_",",103,"I")
+10 ;GET DEBIT OF NEXT TRANS
SET POSTDEB=$$GET1^DIQ(90050.03,POSTTRAN_",",3,"I")
End DoDot:1
+11 ;GET NEXT TRANSACTION
SET PRETRAN=$ORDER(^BARTR(DUZ(2),"AC",BARBL,BARDTTR),-1)
+12 IF PRETRAN'=""
Begin DoDot:1
+13 SET PREAWO=$$GET1^DIQ(90050.03,PRETRAN_",",103,"I")
+14 ;GET DEBIT OF PREVIOUS TRANS
SET PRECRED=$$GET1^DIQ(90050.03,PRETRAN_",",2,"I")
End DoDot:1
+15 ;GET ADJUSTMENT TYPE
+16 ;
+17 ;this is only for those non-ben accounts that were accidently written off
+18 SET BARACT=$PIECE(BARTR(0),U,6)
+19 IF BARACT=""
QUIT
+20 ;BAR*1.8*2
SET D0=BARACT
+21 ;GET INTERNAL CODE INSTEAD OF 'STANDS FOR'
SET BARITYP=$$VALI^BARVPM(8)
+22 ;NON-BEN CODE
IF BARITYP'="N"
QUIT
+23 KILL D0
+24 ;end new code
+25 ;;ADJUST ACCOUNT - WRITE-OFF - AUTO WRITE-OFF 2007
+26 IF $PIECE(BARTR(1),U)=43
IF ($PIECE(BARTR(1),U,2)=3)
IF ($PIECE(BARTR(1),U,3)=916)
Begin DoDot:1
+27 ;I POSTTRAN'="",($P(BARTR(0),U,2)=POSTDEB),(POSTAWO=916) Q ;IF THIS IS TRUE THEY MANUALLY REVER
+28 ;I PRETRAN'="",($P(BARTR(0),U,3)=PRECRED),(PREAWO=916) Q ;IF THIS IS TRUE THEY
+29 ;IF THIS IS TRUE THEY MANUALLY REVER
IF POSTTRAN'=""
IF (POSTAWO=916)
QUIT
+30 ;IF THIS IS TRUE THEY
IF PRETRAN'=""
IF (PREAWO=916)
QUIT
+31 DO REVERSE
+32 DO BILLED
+33 DO ARBILL
End DoDot:1
+34 QUIT
ARBILL ;
+1 KILL DIR,DIE,DR,DIC,DA,DR
+2 SET DA=$PIECE(BARTR(0),U,4)
+3 SET DIE="^BARBL(DUZ(2),"
+4 SET DR="15///^S X=$P(BARTR(0),U,2)"
+5 DO ^DIE
+6 QUIT
+7 ; *********************************************************************
REVERSE ;
+1 ; Create new transaction
SET BARTRIEN=$$NEW^BARTR
+2 SET DA=BARTRIEN
+3 SET DIE=90050.03
+4 ; PUT WRITE-OFF AMT IN DEBIT ($$$)
SET DR="3////^S X=$P(BARTR(0),U,2)"
+5 ; A/R Bill
SET DR=DR_";4////^S X=$P(BARTR(0),U,4)"
+6 ; A/R Patient
SET DR=DR_";5////^S X=$P(BARTR(0),U,5)"
+7 ; A/R Account
SET DR=DR_";6////^S X=$P(BARTR(0),U,6)"
+8 ; Parent Location
SET DR=DR_";8////^S X=$P(BARTR(0),U,8)"
+9 ; Parent ASUFAC
SET DR=DR_";9////^S X=$P(BARTR(0),U,9)"
+10 ; A/R Section
SET DR=DR_";10////^S X=$P(BARTR(0),U,10)"
+11 ; Visit location
SET DR=DR_";11////^S X=$P(BARTR(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 (Auto Write off 2007)
SET DR=DR_";103////916"
+17 SET DIDEL=90050
+18 ; Populate transaction file
DO ^DIE
+19 KILL DIDEL,DIE,DA,DR
+20 ; Post from trans to files
DO TR^BARTDO(BARTRIEN)
+21 KILL BARBL
+22 SET BARCNT=BARCNT+1
+23 SET BARBILL=$$GET1^DIQ(90050.01,$PIECE(BARTR(0),U,4),.01)
+24 WRITE !,BARBILL,?25," for ",$JUSTIFY($FNUMBER(-$PIECE(BARTR(0),U,2),",",2),10)," written off (reversed)."
+25 QUIT
+26 ; *********************************************************************
BILLED ;
+1 SET BARBLDA=$PIECE(BARTR(0),U,4)
+2 SET ABMBIL=$$FIND3PB^BARUTL(DUZ(2),BARBLDA)
+3 ; Mark bill in 3PB Bill file as BILLED
+4 SET DIE="^ABMDBILL(DUZ(2),"
+5 SET DA=$PIECE(ABMBIL,",",2)
+6 SET DR=".04////B"
+7 DO ^DIE
+8 KILL DR
+9 QUIT
+10 ; *********************************************************************
+11 ;
XIT ;
+1 DO ^BARVKL0
+2 QUIT
