Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BZSMAWO

BZSMAWO.m

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