source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXFMSUF.m@ 1005

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