| 1 | RCXFMSUF ;WISC/RFJ-calculate fms fund code for a bill ;1 Oct 97
 | 
|---|
| 2 |  ;;4.5;Accounts Receivable;**90,101,135,157,160,165,170,203,207,173,211,192,220,235**;Mar 20, 1995
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  Q
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | GETFUNDO(TYPE) ;  return the fund for other type associated collections
 | 
|---|
| 8 |  ;  type can equal:
 | 
|---|
| 9 |  ;  I for interest         A for admin
 | 
|---|
| 10 |  ;  M for marshall fee     C for court cost
 | 
|---|
| 11 |  I TYPE="I" Q "1435"
 | 
|---|
| 12 |  I TYPE="A" Q "3220"
 | 
|---|
| 13 |  I TYPE="M" Q "0869"
 | 
|---|
| 14 |  I TYPE="C" Q "0869"
 | 
|---|
| 15 |  Q ""
 | 
|---|
| 16 |  ;
 | 
|---|
| 17 |  ;
 | 
|---|
| 18 | GETFUNDB(BILLDA,DONTSTOR,RCEFT) ;  return a bills fms fund code
 | 
|---|
| 19 |  ;  pass DONTSTOR equal 1 to prevent storing the fund code
 | 
|---|
| 20 |  ;  cannot rely on data in the fund field since it may reference the
 | 
|---|
| 21 |  ;  old funds S FUND=$P($G(^PRCA(430,BILLDA,11)),"^",17).  since there
 | 
|---|
| 22 |  ;  are reports which use 11;17, set it for a bill once its computed
 | 
|---|
| 23 |  ;  until all references to the fund are eliminated.
 | 
|---|
| 24 |  ;  rceft = 1 if processing an EFT deposit
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 |  N ACTDATE,CATEGDA,FUND
 | 
|---|
| 27 |  ;
 | 
|---|
| 28 |  ;  calculate a bills fund
 | 
|---|
| 29 |  I $G(RCEFT)=1 S FUND="5287"_$S(DT<3030926:"",DT'<3030926&(DT<$$ADDPTEDT^PRCAACC()):".4",1:"04") Q FUND
 | 
|---|
| 30 |  S CATEGDA=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
 | 
|---|
| 31 |  I CATEGDA>44 Q ""
 | 
|---|
| 32 |  ;
 | 
|---|
| 33 |  ;  piece 5 is new fund, remove spaces
 | 
|---|
| 34 |  S FUND=$P($TR($T(@CATEGDA)," "),";",5)
 | 
|---|
| 35 |  ;
 | 
|---|
| 36 |  ;  if category is vendor(17), ex-employee(15), current employee(16)
 | 
|---|
| 37 |  ;  federal agency refund(13), federal agency reimb(14), military(12)
 | 
|---|
| 38 |  ;  set the fund to what is stored in the file.  This was entered
 | 
|---|
| 39 |  ;  by the user during the audit process.  If fund is in the file
 | 
|---|
| 40 |  ;  already, do not need to store it again.
 | 
|---|
| 41 |  ;  if category is nursing home proceeds (40), parking fees (41),
 | 
|---|
| 42 |  ;  cwt proceeds (42), comp & pen proceeds (43), enhanced use lease
 | 
|---|
| 43 |  ;  proceeds (44), set the fund to what is stored in the file.
 | 
|---|
| 44 |  ;  This was generated by the software at the time of bill enter.
 | 
|---|
| 45 |  I CATEGDA=17!(CATEGDA=15)!(CATEGDA=16)!(CATEGDA=13)!(CATEGDA=14)!(CATEGDA=12)!(CATEGDA=40)!(CATEGDA=41)!(CATEGDA=42)!(CATEGDA=43)!(CATEGDA=44) D
 | 
|---|
| 46 |  .   I $P($G(^PRCA(430,BILLDA,11)),"^",17)'="" S FUND=$P(^(11),"^",17),DONTSTOR=1
 | 
|---|
| 47 |  ;
 | 
|---|
| 48 |  ;  public law states that bills in the category ineligible (1),
 | 
|---|
| 49 |  ;  emerg/human (2), torts (10), or medicare (21) which are older 
 | 
|---|
| 50 |  ;  than oct 1, 1992 should be reported under fund 3220.
 | 
|---|
| 51 |  I CATEGDA=1!(CATEGDA=2)!(CATEGDA=10)!(CATEGDA=21) D
 | 
|---|
| 52 |  .   S ACTDATE=$P($G(^PRCA(430,BILLDA,6)),"^",21)
 | 
|---|
| 53 |  .   I ACTDATE,ACTDATE<2921001 S FUND=3220 Q
 | 
|---|
| 54 |  .   ;
 | 
|---|
| 55 |  .   ;  patch157 changes ineligibles.  an ineligible activated before
 | 
|---|
| 56 |  .   ;  oct 1, 1992 or after sep 30, 2000 will be recorded in fund 0160A1.
 | 
|---|
| 57 |  .   ;  otherwise it will be recorded in fund 5287.3 if before 3040928
 | 
|---|
| 58 |  .   ; if 3040928 or after,  fund should be 528703
 | 
|---|
| 59 |  .   I CATEGDA=1,ACTDATE,ACTDATE<3001001 S FUND=$S(DT<$$ADDPTEDT^PRCAACC():"5287.3",1:528703)
 | 
|---|
| 60 |  ;
 | 
|---|
| 61 |  ;  set the fund for the bill
 | 
|---|
| 62 |  I $G(DONTSTOR)'=1 D STORE^RCXFMSUR(BILLDA,"",FUND)
 | 
|---|
| 63 |  ;
 | 
|---|
| 64 |  I FUND>528704,FUND<528709!(FUND=528710) Q FUND
 | 
|---|
| 65 |  I $G(REPRODT),REPRODT<3030926,$E(FUND,1,4)=5287 Q 5287
 | 
|---|
| 66 |  I $G(REPRODT),REPRODT<3031001,$E(FUND,1,4)=5287,$G(REFMS) Q 5287
 | 
|---|
| 67 |  I DT<3030926,$E(FUND,1,4)=5287 Q 5287 ; Effective date
 | 
|---|
| 68 |  I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528709 Q 4032 ;Effective date-528709
 | 
|---|
| 69 |  I $G(REPRODT),REPRODT<3041001,FUND=528709,$G(REFMS) Q 4032 ;Resubmitted documents not held
 | 
|---|
| 70 |  I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528709 Q 4032
 | 
|---|
| 71 |  I DT<$$ADDPTEDT^PRCAACC(),FUND=528709 Q 4032
 | 
|---|
| 72 |  I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528701 Q 5287.1 ;Effective date-528701
 | 
|---|
| 73 |  I $G(REPRODT),REPRODT<3041001,FUND=528701,$G(REFMS) Q 5287.1 ;Resubmitted documents not held
 | 
|---|
| 74 |  I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528701 Q 5287.1
 | 
|---|
| 75 |  I DT<$$ADDPTEDT^PRCAACC(),FUND=528701 Q 5287.1
 | 
|---|
| 76 |  I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528703 Q 5287.3 ;Effective date-528703
 | 
|---|
| 77 |  I $G(REPRODT),REPRODT<3041001,FUND=528703,$G(REFMS) Q 5287.3 ;Resubmitted documents not held
 | 
|---|
| 78 |  I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528703 Q 5287.3
 | 
|---|
| 79 |  I DT<$$ADDPTEDT^PRCAACC(),FUND=528703 Q 5287.3
 | 
|---|
| 80 |  I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528704 Q 5287.4 ;Effective date-528704
 | 
|---|
| 81 |  I $G(REPRODT),REPRODT<3041001,FUND=528704,$G(REFMS) Q 5287.4 ;Resubmitted documents not held
 | 
|---|
| 82 |  I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528704 Q 5287.4
 | 
|---|
| 83 |  I DT<$$ADDPTEDT^PRCAACC(),FUND=528704 Q 5287.4
 | 
|---|
| 84 |  Q FUND
 | 
|---|
| 85 |  ;
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 |  ;  this is a listing of all categories and associated funds
 | 
|---|
| 88 |  ;  the label is from the internal entry number in the category
 | 
|---|
| 89 |  ;  file 430.2.  piece 3 is a description, piece 4 is the old fund,
 | 
|---|
| 90 |  ;  piece 5 is the new fund
 | 
|---|
| 91 | 0 ;;no fund                       ;       ;    
 | 
|---|
| 92 | 1 ;;INELIGIBLE HOSP.              ;3220   ;0160A1
 | 
|---|
| 93 | 2 ;;EMERGENCY/HUMANITARIAN        ;0160A1 ;528703
 | 
|---|
| 94 | 3 ;;NURSING HOME CARE(NSC)        ;2431   ;528703
 | 
|---|
| 95 | 4 ;;OUTPATIENT CARE(NSC)          ;2431   ;528703
 | 
|---|
| 96 | 5 ;;HOSPITAL CARE (NSC)           ;2431   ;528703
 | 
|---|
| 97 | 6 ;;WORKMAN'S COMP.               ;5014   ;528704
 | 
|---|
| 98 | 7 ;;NO-FAULT AUTO ACC.            ;5014   ;528704
 | 
|---|
| 99 | 8 ;;CRIME OF PER.VIO.             ;5014   ;528704
 | 
|---|
| 100 | 9 ;;REIMBURS.HEALTH INS.          ;5014   ;528704
 | 
|---|
| 101 | 10 ;;TORT FEASOR                   ;0160A1 ;528704
 | 
|---|
| 102 | 11 ;;no entry                      ;       ;
 | 
|---|
| 103 | 12 ;;MILITARY                      ;0160A1 ;0160A1
 | 
|---|
| 104 | 13 ;;FEDERAL AGENCIES-REFUND       ;0160A1 ;0160A1
 | 
|---|
| 105 | 14 ;;FEDERAL AGENCIES-REIMB.       ;0160A1 ;0160A1
 | 
|---|
| 106 | 15 ;;EX-EMPLOYEE                   ;0160A1 ;0160A1
 | 
|---|
| 107 | 16 ;;CURRENT EMP.                  ;0160A1 ;0160A1
 | 
|---|
| 108 | 17 ;;VENDOR                        ;0160A1 ;0160A1
 | 
|---|
| 109 | 18 ;;C (MEANS TEST)                ;2431   ;528703
 | 
|---|
| 110 | 19 ;;SHARING AGREEMENTS            ;0160A1 ;0160A1
 | 
|---|
| 111 | 20 ;;INTERAGENCY                   ;0160A1 ;0160A1
 | 
|---|
| 112 | 21 ;;MEDICARE                      ;5014   ;528704
 | 
|---|
| 113 | 22 ;;RX CO-PAYMENT/SC VET          ;5014   ;528701
 | 
|---|
| 114 | 23 ;;RX CO-PAYMENT/NSC VET         ;5014   ;528701
 | 
|---|
| 115 | 24 ;;NURSING HOME CARE PER DIEM    ;2431   ;528703
 | 
|---|
| 116 | 25 ;;HOSPITAL CARE PER DIEM        ;2431   ;528703
 | 
|---|
| 117 | 26 ;;PREPAYMENT                    ;5014   ;528703
 | 
|---|
| 118 | 27 ;;CHAMPVA SUBSISTENCE           ;3220   ;3220
 | 
|---|
| 119 | 28 ;;CHAMPVA THIRD PARTY           ;3220   ;0160A1
 | 
|---|
| 120 | 29 ;;CHAMPVA                       ;0160A1 ;0160A1
 | 
|---|
| 121 | 30 ;;TRICARE                       ;0160A1 ;0160A1
 | 
|---|
| 122 | 31 ;;TRICARE PATIENT               ;0160A1 ;0160A1
 | 
|---|
| 123 | 32 ;;TRICARE THIRD PARTY           ;0160A1 ;0160A1
 | 
|---|
| 124 | 33 ;;ADULT DAY HEALTH CARE         ;4032   ;528709
 | 
|---|
| 125 | 34 ;;DOMICILIARY                   ;4032   ;528709
 | 
|---|
| 126 | 35 ;;RESPITE CARE-INSTITUTIONAL    ;4032   ;528709
 | 
|---|
| 127 | 36 ;;RESPITE CARE-NON-INSTITUTIONAL;4032   ;528709
 | 
|---|
| 128 | 37 ;;GERIATRIC EVAL-INSTITUTIONAL  ;4032   ;528709
 | 
|---|
| 129 | 38 ;;GERIATRIC EVAL-NON-INSTITUTION;4032   ;528709
 | 
|---|
| 130 | 39 ;;NURSING HOME CARE-LTC         ;4032   ;528709
 | 
|---|
| 131 | 40 ;;NURSING HOME PROCEEDS         ;       ;528705
 | 
|---|
| 132 | 41 ;;PARKING FEES                  ;       ;528706
 | 
|---|
| 133 | 42 ;;CWT PROCEEDS                  ;       ;528707
 | 
|---|
| 134 | 43 ;;COMP & PEN PROCEEDS           ;       ;528708
 | 
|---|
| 135 | 44 ;;ENHANCED USE LEASE PROCEEDS   ;5358.3 ;528710
 | 
|---|