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
|
---|