BZSMAWO ; IHS/TAO/EDE - WRITE OFF OLD BILLS [ 04/06/2003 9:28 AM ]
;;1.0;TUCSON AREA OFFICE W/O;;MAR 14, 2003
;
; This routine is intended to be used to clean up accounts
; receivable on dates of service specified by the user.
;
; All bills for up to and including the DOS specified for the
; A/R Accounts specified will be written off to a special code.
;
; The user selects the allowance category, Medicare, Medicaid, or
; Private Insurance. Based on the allowance category the
; account types are selected. Based on the account types the
; individual accounts are selected.
;
START ;
D INIT ; initialization
I BZSQF D EOJ Q ; problem or user sez quit
D WRITEOFF ; write off bills
D EOJ ; clean up
Q
;
SACCT ; EP-TO WRITE OFF SELECTED ACCOUNTS
S BZSSAFLG=1 ; set selected accts flag
D INIT ; initialization
I BZSQF D EOJ Q ; problem or user sez quit
D WRITEOFF ; write off bills
D EOJ ; clean up
Q
;
;====================
INIT ; INITIALIZATION
S BZSQF=1 ; set quit flag to yes
S BZSHOLD=DUZ(2)
I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS
I '$D(IORVON) S (IORVON,IORVOFF)="""" ;use " then
I '$D(^BARTBL(1003,0)) D Q
. W !,"A/R tabe entry 1003 PAID DENIED OVER STAT LIMIT not defined.",!
. W "Terminating run.",!!
. Q
S (BZSCONT,BZSCNT)=0
S BZSSECT=$$VALI^XBDIQ1(200,DUZ,29) ; Serv/Sect from NEW PERSON
I $G(BZSSAFLG) D I 1
. W !!,"This routine allows the user to write off old bills for selected accounts",!
. W "and date of service. You should capture this session to a file.",!
. Q
I '$G(BZSSAFLG) D
. W !!,"This routine allows the user to write off old bills based on the allowance",!
. W "category and date of service. You should capture this session to a file.",!
. Q
W "You need to run this routine using terminal software that allows you to",!
W "scroll back.",!
I $G(BZSSAFLG) D INITSA I 1 ; init for selected accts
E D INITAC ; init for allowance cat
Q:BZSSQF ; quit if sub qf set
D ASKDOS ; Ask Date of Service
Q:$G(BZSEDOS)="" ; Quit if no ending date
D CONTINUE ; Display choices ask continue
Q:'+BZSCONT ; Don't continue
S BZSQF=0 ; set quit flag to no
Q
;
INITSA ; INITIALIZATION FOR SELECTED ACCOUNTS ONLY
S BZSSQF=1 ; set sub quit flag to yes
D ASKACCT ; as for selected accts
Q:'$O(BZS("ACCT",0)) ; no acct selected
S BZSSQF=0 ; set sub quit flag to no
Q
;
INITAC ; INITIALIZATION FOR ALLOWANCE CATEGORY
S BZSSQF=1 ; set sub quit flag to yes
D ASKACAT ; ask allowance category
Q:'BZSACAT ; no allowance cat selected
D ASKACCTT ; ask account types
Q:'BZSACCTT ; no account types
D BLDACCTL ; build account list
S BZSSQF=0 ; set sub quit flag to no
Q
;
;--------------------
ASKACCT ; ASK FOR LIST OF A/R ACCOUNTS
K BZS("ACCT") ; no residue
K DIC,X,Y
W !
S DIC="^BARAC(DUZ(2),"
S DIC(0)="AEMQ"
S DIC("A")="Select A/R Account:"
F D Q:+Y<0
. I $D(BZS("ACCT")) S DIC("A")="Select Another A/R Account: "
. D ^DIC
. Q:+Y<0
. S BZSACT=$$GET1^DIQ(90050.02,+Y,1.08)
. S:BZSACT]"" BZS("ACCTTYPE",BZSACT)="" ; save account types
. S BZS("ACCT",+Y)=$P(Y,U,2) ; save account
. Q
K DIC
W !!
Q
;
;--------------------
ASKACAT ; ASK ALLOWANCE CATEGORY
S BZSACAT="" ; allowance cat to null
S DIR(0)="S^1:MEDICARE;2:MEDICAID;3:PRIVATE INSURANCE",DIR("A")="Select allowance category to write off" KILL DA D ^DIR KILL DIR
Q:$D(DIRUT) ; ^ or time out
S BZSACAT=Y ; save allowance cat
S BZSACATN=$S(Y=1:"MEDICARE",Y=2:"MEDICAID",Y=3:"PRIVATE INSURANCE",1:"")
Q
;
;--------------------
ASKACCTT ; ASK FOR LIST OF ACCOUNT TYPES
S BZSACCTT=0
K BZSATTBL
S BZSACCT=0
F S BZSACCT=$O(^BARAC(DUZ(2),BZSACCT)) Q:'BZSACCT D
. Q:'$D(^BARAC(DUZ(2),BZSACCT,0)) ; corrupt database
. S BZSAT=$$VAL^XBDIQ1(90050.02,BZSACCT,1.08)
. Q:BZSAT="" ; bad acct entry
. S BZSATTBL(BZSAT)=$S(BZSAT["MEDICARE":1,BZSAT["MEDICAID":2,BZSAT["PRIVATE":3,1:"")
. S BZSATTBL(BZSAT,BZSACCT)=$P(^BARAC(DUZ(2),BZSACCT,0),U)
. Q
S BZSAT=""
F BZSATC=1:1 S BZSAT=$O(BZSATTBL(BZSAT)) Q:BZSAT="" D
. S BZSATL(BZSATC)=BZSAT_U_$S(BZSATTBL(BZSAT)=BZSACAT:"In",1:"Out")
. Q
S BZSATC=BZSATC-1 ; set to real count
F D CONFAT Q:BZSLQF ; confirm acct types
Q:$D(DUOUT) ; user ^ out
; gen temp tbl of acct types in allowance category
F BZSSN=1:1 S BZSAT=$P(BZSATL(BZSSN),U) D Q:BZSSN=BZSATC
. Q:$P(BZSATL(BZSSN),U,2)'="In"
. S BZSTMP(BZSAT)=""
. Q
; delete all acct types not in allowance category from bzsattbl
S BZSAT=""
F S BZSAT=$O(BZSATTBL(BZSAT)) Q:BZSAT="" D
. Q:$D(BZSTMP(BZSAT)) ; quit if in allow cat
. K BZSATTBL(BZSAT) ; delete acct type nic
. Q
S BZSAT=""
F BZSACCTT=1:1 S BZSAT=$O(BZSATTBL(BZSAT)) Q:BZSAT=""
S BZSACCTT=BZSACCTT-1
K BZSATL,BZSTMP
Q
;
CONFAT ; CONFIRM ACCOUNT TYPES
S BZSLQF=1 ; loop control flag to end
W !,"Allowance Category: ",BZSACATN,!!
F BZSSN=1:1 S BZSAT=$P(BZSATL(BZSSN),U) D Q:BZSSN=BZSATC
. W ?1,BZSSN,?5,$P(BZSATL(BZSSN),U,2),?10,BZSAT,!
. Q
S DIR(0)="NO^1:"_BZSATC,DIR("A")="Select item number to toggle in/out of allowance category" KILL DA D ^DIR KILL DIR
Q:$D(DIRUT) ; ^ or time out
Q:Y="" ; user thru
NEW X S X=$P(BZSATL(Y),U,2) ; get cat flag
S $P(BZSATL(Y),U,2)=$S(X="In":"Out",1:"In") ;toggle value
S BZSLQF=0 ; loop control flag to go
Q
;
;--------------------
BLDACCTL ; BUILD ACCOUNT LIST
K BZS
S BZSAT=""
F S BZSAT=$O(BZSATTBL(BZSAT)) Q:BZSAT="" D
. S BZSACCT=0
. F S BZSACCT=$O(BZSATTBL(BZSAT,BZSACCT)) Q:'BZSACCT D
. . S BZS("ACCT",BZSACCT)=BZSATTBL(BZSAT,BZSACCT)
.. Q
. Q
K BZSATTBL
Q
;
;--------------------
ASKDOS ; ASK DATE OF SERVICE
I $G(BZSACAT) S BZSDYS=$S(BZSACAT=1:((365*2)+180),BZSACAT=2:365,BZSACAT=3:(365+90),1:"") I 1
E S BZSDYS=((365*2)+180) ; for selected accts default long
S BZSDOS2=$$FMADD^XLFDT(DT,-BZSDYS) ; latest end date
S Y=BZSDOS2
D DD^%DT
S BZSDOSE=Y
W !!,"Enter a date, preferably less than or equal to "_BZSDOSE_".",!
W "Dates up to and including the one entered will be written off.",!
K DIR
S DIR("?")="Enter a date, preferably less than or equal to "_BZSDOSE_"."
S DIR("?",1)="Dates up to and including the one entered will be written off."
S DIR(0)="DO^::EP",DIR("A")="Enter ending date of time frame" KILL DA D ^DIR KILL DIR
Q:'+Y
S BZSEDOS=Y
S BZSDOS("E")=Y(0)
I BZSEDOS>BZSDOS2 D Q:'$D(BZSEDOS) ; quit if no end date
. W !!,IORVON_"Ending date of time frame is after "_BZSDOSE_"."_IORVOFF,!
. W IORVON_"Are you absolutely certain you want this date?"_IORVOFF,!
. S DIR(0)="YO",DIR("B")="NO" KILL DA D ^DIR KILL DIR
. I 'Y K BZSDOS,BZSEDOS ; user said no
. Q
S BZSBDOS=""
W !
S DIR(0)="DO^:"_BZSEDOS_":EP",DIR("A")="Enter beginning date of time frame" KILL DA D ^DIR KILL DIR
S BZSBDOS=Y
S BZSDOS("B")=$G(Y(0))
Q
;
;--------------------
CONTINUE ; DISPLAY CHOICES AND ASK IF THEY WISH TO CONTINUE
; Tell them bills written off will scroll on the screen if they wish to
; capture.
S BZSX=$S(BZSDOS("B")="":"up to and including "_BZSDOS("E"),1:"between "_BZSDOS("B")_" and "_BZSDOS("E")_" inclusively")
W !!,"You have chosen to write off bills for dates of service ",!
W BZSX,!
;W !!,"for the following Locations: "
;I '$D(BZS("LOC")) W ?40,"ALL"
;I $D(BZS("LOC")) D
;. S BZSTMP=0
;. F S BZSTMP=$O(BZS("LOC",BZSTMP)) Q:'+BZSTMP D
;. . W ?40,$P(^DIC(4,BZSTMP,0),U),!
W !,"for the following A/R accounts: "
I '$D(BZS("ACCT")) W ?40,"ALL"
I $D(BZS("ACCT")) D
. S BZSTMP=0
. F S BZSTMP=$O(BZS("ACCT",BZSTMP)) Q:'+BZSTMP D
. . W ?40,$$VAL^XBDIQ1(90050.02,BZSTMP,.01),!
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
;
;--------------------
PAUSE ; PAUSE FOR USER
S DIR(0)="EO",DIR("A")="Press RETURN to continue"
KILL DA
D ^DIR
KILL DIR
Q
;
;====================
WRITEOFF ; WRITE OFF BILLS
S BZSCNT=0
D ^BZSMAWO2 ; write off bills matching criteria
W !!,BZSCNT," Bills written off to Auto Write-off 1003."
Q
;
;====================
EOJ ; EOJ CLEAN UP
S DUZ(2)=BZSHOLD
D EN^XBVK("BZS") ; Kill local variables
Q
BZSMAWO ; IHS/TAO/EDE - WRITE OFF OLD BILLS [ 04/06/2003 9:28 AM ]
+1 ;;1.0;TUCSON AREA OFFICE W/O;;MAR 14, 2003
+2 ;
+3 ; This routine is intended to be used to clean up accounts
+4 ; receivable on dates of service specified by the user.
+5 ;
+6 ; All bills for up to and including the DOS specified for the
+7 ; A/R Accounts specified will be written off to a special code.
+8 ;
+9 ; The user selects the allowance category, Medicare, Medicaid, or
+10 ; Private Insurance. Based on the allowance category the
+11 ; account types are selected. Based on the account types the
+12 ; individual accounts are selected.
+13 ;
START ;
+1 ; initialization
DO INIT
+2 ; problem or user sez quit
IF BZSQF
DO EOJ
QUIT
+3 ; write off bills
DO WRITEOFF
+4 ; clean up
DO EOJ
+5 QUIT
+6 ;
SACCT ; EP-TO WRITE OFF SELECTED ACCOUNTS
+1 ; set selected accts flag
SET BZSSAFLG=1
+2 ; initialization
DO INIT
+3 ; problem or user sez quit
IF BZSQF
DO EOJ
QUIT
+4 ; write off bills
DO WRITEOFF
+5 ; clean up
DO EOJ
+6 QUIT
+7 ;
+8 ;====================
INIT ; INITIALIZATION
+1 ; set quit flag to yes
SET BZSQF=1
+2 SET BZSHOLD=DUZ(2)
+3 IF '$DATA(IORVON)
SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
+4 ;use " then
IF '$DATA(IORVON)
SET (IORVON,IORVOFF)=""""
+5 IF '$DATA(^BARTBL(1003,0))
Begin DoDot:1
+6 WRITE !,"A/R tabe entry 1003 PAID DENIED OVER STAT LIMIT not defined.",!
+7 WRITE "Terminating run.",!!
+8 QUIT
End DoDot:1
QUIT
+9 SET (BZSCONT,BZSCNT)=0
+10 ; Serv/Sect from NEW PERSON
SET BZSSECT=$$VALI^XBDIQ1(200,DUZ,29)
+11 IF $GET(BZSSAFLG)
Begin DoDot:1
+12 WRITE !!,"This routine allows the user to write off old bills for selected accounts",!
+13 WRITE "and date of service. You should capture this session to a file.",!
+14 QUIT
End DoDot:1
IF 1
+15 IF '$GET(BZSSAFLG)
Begin DoDot:1
+16 WRITE !!,"This routine allows the user to write off old bills based on the allowance",!
+17 WRITE "category and date of service. You should capture this session to a file.",!
+18 QUIT
End DoDot:1
+19 WRITE "You need to run this routine using terminal software that allows you to",!
+20 WRITE "scroll back.",!
+21 ; init for selected accts
IF $GET(BZSSAFLG)
DO INITSA
IF 1
+22 ; init for allowance cat
IF '$TEST
DO INITAC
+23 ; quit if sub qf set
IF BZSSQF
QUIT
+24 ; Ask Date of Service
DO ASKDOS
+25 ; Quit if no ending date
IF $GET(BZSEDOS)=""
QUIT
+26 ; Display choices ask continue
DO CONTINUE
+27 ; Don't continue
IF '+BZSCONT
QUIT
+28 ; set quit flag to no
SET BZSQF=0
+29 QUIT
+30 ;
INITSA ; INITIALIZATION FOR SELECTED ACCOUNTS ONLY
+1 ; set sub quit flag to yes
SET BZSSQF=1
+2 ; as for selected accts
DO ASKACCT
+3 ; no acct selected
IF '$ORDER(BZS("ACCT",0))
QUIT
+4 ; set sub quit flag to no
SET BZSSQF=0
+5 QUIT
+6 ;
INITAC ; INITIALIZATION FOR ALLOWANCE CATEGORY
+1 ; set sub quit flag to yes
SET BZSSQF=1
+2 ; ask allowance category
DO ASKACAT
+3 ; no allowance cat selected
IF 'BZSACAT
QUIT
+4 ; ask account types
DO ASKACCTT
+5 ; no account types
IF 'BZSACCTT
QUIT
+6 ; build account list
DO BLDACCTL
+7 ; set sub quit flag to no
SET BZSSQF=0
+8 QUIT
+9 ;
+10 ;--------------------
ASKACCT ; ASK FOR LIST OF A/R ACCOUNTS
+1 ; no residue
KILL BZS("ACCT")
+2 KILL DIC,X,Y
+3 WRITE !
+4 SET DIC="^BARAC(DUZ(2),"
+5 SET DIC(0)="AEMQ"
+6 SET DIC("A")="Select A/R Account:"
+7 FOR
Begin DoDot:1
+8 IF $DATA(BZS("ACCT"))
SET DIC("A")="Select Another A/R Account: "
+9 DO ^DIC
+10 IF +Y<0
QUIT
+11 SET BZSACT=$$GET1^DIQ(90050.02,+Y,1.08)
+12 ; save account types
IF BZSACT]""
SET BZS("ACCTTYPE",BZSACT)=""
+13 ; save account
SET BZS("ACCT",+Y)=$PIECE(Y,U,2)
+14 QUIT
End DoDot:1
IF +Y<0
QUIT
+15 KILL DIC
+16 WRITE !!
+17 QUIT
+18 ;
+19 ;--------------------
ASKACAT ; ASK ALLOWANCE CATEGORY
+1 ; allowance cat to null
SET BZSACAT=""
+2 SET DIR(0)="S^1:MEDICARE;2:MEDICAID;3:PRIVATE INSURANCE"
SET DIR("A")="Select allowance category to write off"
KILL DA
DO ^DIR
KILL DIR
+3 ; ^ or time out
IF $DATA(DIRUT)
QUIT
+4 ; save allowance cat
SET BZSACAT=Y
+5 SET BZSACATN=$SELECT(Y=1:"MEDICARE",Y=2:"MEDICAID",Y=3:"PRIVATE INSURANCE",1:"")
+6 QUIT
+7 ;
+8 ;--------------------
ASKACCTT ; ASK FOR LIST OF ACCOUNT TYPES
+1 SET BZSACCTT=0
+2 KILL BZSATTBL
+3 SET BZSACCT=0
+4 FOR
SET BZSACCT=$ORDER(^BARAC(DUZ(2),BZSACCT))
IF 'BZSACCT
QUIT
Begin DoDot:1
+5 ; corrupt database
IF '$DATA(^BARAC(DUZ(2),BZSACCT,0))
QUIT
+6 SET BZSAT=$$VAL^XBDIQ1(90050.02,BZSACCT,1.08)
+7 ; bad acct entry
IF BZSAT=""
QUIT
+8 SET BZSATTBL(BZSAT)=$SELECT(BZSAT["MEDICARE":1,BZSAT["MEDICAID":2,BZSAT["PRIVATE":3,1:"")
+9 SET BZSATTBL(BZSAT,BZSACCT)=$PIECE(^BARAC(DUZ(2),BZSACCT,0),U)
+10 QUIT
End DoDot:1
+11 SET BZSAT=""
+12 FOR BZSATC=1:1
SET BZSAT=$ORDER(BZSATTBL(BZSAT))
IF BZSAT=""
QUIT
Begin DoDot:1
+13 SET BZSATL(BZSATC)=BZSAT_U_$SELECT(BZSATTBL(BZSAT)=BZSACAT:"In",1:"Out")
+14 QUIT
End DoDot:1
+15 ; set to real count
SET BZSATC=BZSATC-1
+16 ; confirm acct types
FOR
DO CONFAT
IF BZSLQF
QUIT
+17 ; user ^ out
IF $DATA(DUOUT)
QUIT
+18 ; gen temp tbl of acct types in allowance category
+19 FOR BZSSN=1:1
SET BZSAT=$PIECE(BZSATL(BZSSN),U)
Begin DoDot:1
+20 IF $PIECE(BZSATL(BZSSN),U,2)'="In"
QUIT
+21 SET BZSTMP(BZSAT)=""
+22 QUIT
End DoDot:1
IF BZSSN=BZSATC
QUIT
+23 ; delete all acct types not in allowance category from bzsattbl
+24 SET BZSAT=""
+25 FOR
SET BZSAT=$ORDER(BZSATTBL(BZSAT))
IF BZSAT=""
QUIT
Begin DoDot:1
+26 ; quit if in allow cat
IF $DATA(BZSTMP(BZSAT))
QUIT
+27 ; delete acct type nic
KILL BZSATTBL(BZSAT)
+28 QUIT
End DoDot:1
+29 SET BZSAT=""
+30 FOR BZSACCTT=1:1
SET BZSAT=$ORDER(BZSATTBL(BZSAT))
IF BZSAT=""
QUIT
+31 SET BZSACCTT=BZSACCTT-1
+32 KILL BZSATL,BZSTMP
+33 QUIT
+34 ;
CONFAT ; CONFIRM ACCOUNT TYPES
+1 ; loop control flag to end
SET BZSLQF=1
+2 WRITE !,"Allowance Category: ",BZSACATN,!!
+3 FOR BZSSN=1:1
SET BZSAT=$PIECE(BZSATL(BZSSN),U)
Begin DoDot:1
+4 WRITE ?1,BZSSN,?5,$PIECE(BZSATL(BZSSN),U,2),?10,BZSAT,!
+5 QUIT
End DoDot:1
IF BZSSN=BZSATC
QUIT
+6 SET DIR(0)="NO^1:"_BZSATC
SET DIR("A")="Select item number to toggle in/out of allowance category"
KILL DA
DO ^DIR
KILL DIR
+7 ; ^ or time out
IF $DATA(DIRUT)
QUIT
+8 ; user thru
IF Y=""
QUIT
+9 ; get cat flag
NEW X
SET X=$PIECE(BZSATL(Y),U,2)
+10 ;toggle value
SET $PIECE(BZSATL(Y),U,2)=$SELECT(X="In":"Out",1:"In")
+11 ; loop control flag to go
SET BZSLQF=0
+12 QUIT
+13 ;
+14 ;--------------------
BLDACCTL ; BUILD ACCOUNT LIST
+1 KILL BZS
+2 SET BZSAT=""
+3 FOR
SET BZSAT=$ORDER(BZSATTBL(BZSAT))
IF BZSAT=""
QUIT
Begin DoDot:1
+4 SET BZSACCT=0
+5 FOR
SET BZSACCT=$ORDER(BZSATTBL(BZSAT,BZSACCT))
IF 'BZSACCT
QUIT
Begin DoDot:2
+6 SET BZS("ACCT",BZSACCT)=BZSATTBL(BZSAT,BZSACCT)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 KILL BZSATTBL
+10 QUIT
+11 ;
+12 ;--------------------
ASKDOS ; ASK DATE OF SERVICE
+1 IF $GET(BZSACAT)
SET BZSDYS=$SELECT(BZSACAT=1:((365*2)+180),BZSACAT=2:365,BZSACAT=3:(365+90),1:"")
IF 1
+2 ; for selected accts default long
IF '$TEST
SET BZSDYS=((365*2)+180)
+3 ; latest end date
SET BZSDOS2=$$FMADD^XLFDT(DT,-BZSDYS)
+4 SET Y=BZSDOS2
+5 DO DD^%DT
+6 SET BZSDOSE=Y
+7 WRITE !!,"Enter a date, preferably less than or equal to "_BZSDOSE_".",!
+8 WRITE "Dates up to and including the one entered will be written off.",!
+9 KILL DIR
+10 SET DIR("?")="Enter a date, preferably less than or equal to "_BZSDOSE_"."
+11 SET DIR("?",1)="Dates up to and including the one entered will be written off."
+12 SET DIR(0)="DO^::EP"
SET DIR("A")="Enter ending date of time frame"
KILL DA
DO ^DIR
KILL DIR
+13 IF '+Y
QUIT
+14 SET BZSEDOS=Y
+15 SET BZSDOS("E")=Y(0)
+16 ; quit if no end date
IF BZSEDOS>BZSDOS2
Begin DoDot:1
+17 WRITE !!,IORVON_"Ending date of time frame is after "_BZSDOSE_"."_IORVOFF,!
+18 WRITE IORVON_"Are you absolutely certain you want this date?"_IORVOFF,!
+19 SET DIR(0)="YO"
SET DIR("B")="NO"
KILL DA
DO ^DIR
KILL DIR
+20 ; user said no
IF 'Y
KILL BZSDOS,BZSEDOS
+21 QUIT
End DoDot:1
IF '$DATA(BZSEDOS)
QUIT
+22 SET BZSBDOS=""
+23 WRITE !
+24 SET DIR(0)="DO^:"_BZSEDOS_":EP"
SET DIR("A")="Enter beginning date of time frame"
KILL DA
DO ^DIR
KILL DIR
+25 SET BZSBDOS=Y
+26 SET BZSDOS("B")=$GET(Y(0))
+27 QUIT
+28 ;
+29 ;--------------------
CONTINUE ; DISPLAY CHOICES AND ASK IF THEY WISH TO CONTINUE
+1 ; Tell them bills written off will scroll on the screen if they wish to
+2 ; capture.
+3 SET BZSX=$SELECT(BZSDOS("B")="":"up to and including "_BZSDOS("E"),1:"between "_BZSDOS("B")_" and "_BZSDOS("E")_" inclusively")
+4 WRITE !!,"You have chosen to write off bills for dates of service ",!
+5 WRITE BZSX,!
+6 ;W !!,"for the following Locations: "
+7 ;I '$D(BZS("LOC")) W ?40,"ALL"
+8 ;I $D(BZS("LOC")) D
+9 ;. S BZSTMP=0
+10 ;. F S BZSTMP=$O(BZS("LOC",BZSTMP)) Q:'+BZSTMP D
+11 ;. . W ?40,$P(^DIC(4,BZSTMP,0),U),!
+12 WRITE !,"for the following A/R accounts: "
+13 IF '$DATA(BZS("ACCT"))
WRITE ?40,"ALL"
+14 IF $DATA(BZS("ACCT"))
Begin DoDot:1
+15 SET BZSTMP=0
+16 FOR
SET BZSTMP=$ORDER(BZS("ACCT",BZSTMP))
IF '+BZSTMP
QUIT
Begin DoDot:2
+17 WRITE ?40,$$VAL^XBDIQ1(90050.02,BZSTMP,.01),!
End DoDot:2
End DoDot:1
+18 WRITE !!,"The bill number and amount written off will scroll by on the screen"
+19 WRITE !,"if you wish to capture this information.",!
+20 ;
+21 KILL DIR
+22 SET DIR(0)="Y"
+23 SET DIR("A")="Continue"
+24 SET DIR("B")="No"
+25 DO ^DIR
+26 KILL DIR
+27 IF Y=1
SET BZSCONT=1
+28 QUIT
+29 ;
+30 ;--------------------
PAUSE ; PAUSE FOR USER
+1 SET DIR(0)="EO"
SET DIR("A")="Press RETURN to continue"
+2 KILL DA
+3 DO ^DIR
+4 KILL DIR
+5 QUIT
+6 ;
+7 ;====================
WRITEOFF ; WRITE OFF BILLS
+1 SET BZSCNT=0
+2 ; write off bills matching criteria
DO ^BZSMAWO2
+3 WRITE !!,BZSCNT," Bills written off to Auto Write-off 1003."
+4 QUIT
+5 ;
+6 ;====================
EOJ ; EOJ CLEAN UP
+1 SET DUZ(2)=BZSHOLD
+2 ; Kill local variables
DO EN^XBVK("BZS")
+3 QUIT
