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

Last change on this file since 1375 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.6 KB
Line 
1RCXFMSUF ;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 ;
7GETFUNDO(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 ;
18GETFUNDB(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
910 ;;no fund ; ;
921 ;;INELIGIBLE HOSP. ;3220 ;0160A1
932 ;;EMERGENCY/HUMANITARIAN ;0160A1 ;528703
943 ;;NURSING HOME CARE(NSC) ;2431 ;528703
954 ;;OUTPATIENT CARE(NSC) ;2431 ;528703
965 ;;HOSPITAL CARE (NSC) ;2431 ;528703
976 ;;WORKMAN'S COMP. ;5014 ;528704
987 ;;NO-FAULT AUTO ACC. ;5014 ;528704
998 ;;CRIME OF PER.VIO. ;5014 ;528704
1009 ;;REIMBURS.HEALTH INS. ;5014 ;528704
10110 ;;TORT FEASOR ;0160A1 ;528704
10211 ;;no entry ; ;
10312 ;;MILITARY ;0160A1 ;0160A1
10413 ;;FEDERAL AGENCIES-REFUND ;0160A1 ;0160A1
10514 ;;FEDERAL AGENCIES-REIMB. ;0160A1 ;0160A1
10615 ;;EX-EMPLOYEE ;0160A1 ;0160A1
10716 ;;CURRENT EMP. ;0160A1 ;0160A1
10817 ;;VENDOR ;0160A1 ;0160A1
10918 ;;C (MEANS TEST) ;2431 ;528703
11019 ;;SHARING AGREEMENTS ;0160A1 ;0160A1
11120 ;;INTERAGENCY ;0160A1 ;0160A1
11221 ;;MEDICARE ;5014 ;528704
11322 ;;RX CO-PAYMENT/SC VET ;5014 ;528701
11423 ;;RX CO-PAYMENT/NSC VET ;5014 ;528701
11524 ;;NURSING HOME CARE PER DIEM ;2431 ;528703
11625 ;;HOSPITAL CARE PER DIEM ;2431 ;528703
11726 ;;PREPAYMENT ;5014 ;528703
11827 ;;CHAMPVA SUBSISTENCE ;3220 ;3220
11928 ;;CHAMPVA THIRD PARTY ;3220 ;0160A1
12029 ;;CHAMPVA ;0160A1 ;0160A1
12130 ;;TRICARE ;0160A1 ;0160A1
12231 ;;TRICARE PATIENT ;0160A1 ;0160A1
12332 ;;TRICARE THIRD PARTY ;0160A1 ;0160A1
12433 ;;ADULT DAY HEALTH CARE ;4032 ;528709
12534 ;;DOMICILIARY ;4032 ;528709
12635 ;;RESPITE CARE-INSTITUTIONAL ;4032 ;528709
12736 ;;RESPITE CARE-NON-INSTITUTIONAL;4032 ;528709
12837 ;;GERIATRIC EVAL-INSTITUTIONAL ;4032 ;528709
12938 ;;GERIATRIC EVAL-NON-INSTITUTION;4032 ;528709
13039 ;;NURSING HOME CARE-LTC ;4032 ;528709
13140 ;;NURSING HOME PROCEEDS ; ;528705
13241 ;;PARKING FEES ; ;528706
13342 ;;CWT PROCEEDS ; ;528707
13443 ;;COMP & PEN PROCEEDS ; ;528708
13544 ;;ENHANCED USE LEASE PROCEEDS ;5358.3 ;528710
Note: See TracBrowser for help on using the repository browser.