136 lines
6.6 KiB
Mathematica
136 lines
6.6 KiB
Mathematica
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
|