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

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