Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCXFMSUF

RCXFMSUF.m

Go to the documentation of this file.
RCXFMSUF ;WISC/RFJ-calculate fms fund code for a bill ; 10/20/10 10:37am
 ;;4.5;Accounts Receivable;**90,101,135,157,160,165,170,203,207,173,211,192,220,235,273,310,315,338,351,360**;Mar 20, 1995;Build 10
 ;;Per VA Directive 6402, 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,NEWFUND
 ;
 ;  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)
 ;
 ;PRCA*4.5*360 - increased CATEGDA check for CC URGENT CARE
 I CATEGDA>85 Q ""
 ;
 ;  piece 5 is new fund, remove spaces
 S FUND=$P($TR($T(@CATEGDA)," "),";",5)
 ;
 ;  set fund 528711 for 3rd party RX bills after 4/27/2011
 I $$TYP^IBRFN(BILLDA)="PH" D
 . I (CATEGDA=6)!(CATEGDA=7)!(CATEGDA=9)!(CATEGDA=10),$$CHECKRXS(BILLDA) S FUND=528711
 ;
 ;  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
 ; PRCA*4.5*310/DRF Add Non-VA fund 528713
 ;
 I $G(DONTSTOR)'=1 D STORE^RCXFMSUR(BILLDA,"",FUND)
 ; 
 ; PRCA*4.5*338 Added funds for Community Care 
 I FUND>528704,FUND<528709!(FUND=528710)!(FUND=528711) Q FUND
 I FUND=528713 Q FUND
 I FUND=528714 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
 ;
CHECKRXS(BILLDA) ; returns true (1) if bill has any scripts on or after 4/27/11
 N RXNUM,NEWFUND,FILLDT,ARRXS
 S NEWFUND=0
 D SET^IBCSC5A(BILLDA,.ARRXS,)
 S RXNUM=0,FILLDT=""
 F  S RXNUM=$O(ARRXS(RXNUM)) Q:RXNUM'>0!(NEWFUND)  D
 .  S FILLDT=$O(ARRXS(RXNUM,0))
 .  I FILLDT'<3110427 S NEWFUND=1
 Q NEWFUND
 ;
 ;  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
 ;  PRCA*4.5*310/DRF Added 45 - FEE REIMB INS to routine.
0 ;;no fund                        ;       ;
1 ;;INELIGIBLE HOSP.               ;3220   ;0160R1
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 ;0160R1
13 ;;FEDERAL AGENCIES-REFUND       ;0160A1 ;0160A1
14 ;;FEDERAL AGENCIES-REIMB.       ;0160R1 ;0160R1
15 ;;EX-EMPLOYEE                   ;0160A1 ;0160A1
16 ;;CURRENT EMP.                  ;0160A1 ;0160A1
17 ;;VENDOR                        ;0160A1 ;0160A1
18 ;;C (MEANS TEST)                ;2431   ;528703
19 ;;SHARING AGREEMENTS            ;0160A1 ;0160R1
20 ;;INTERAGENCY                   ;0160A1 ;0160R1
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   ;0160R1
29 ;;CHAMPVA                       ;0160A1 ;0160R1
30 ;;TRICARE                       ;0160A1 ;0160R1
31 ;;TRICARE PATIENT               ;0160A1 ;0160R1
32 ;;TRICARE THIRD PARTY           ;0160A1 ;0160R1
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
45 ;;FEE REIMB INS                 ;       ;528713
46 ;;EMERGENCY/HUMANITARIAN REIMB. ;       ;528704  ;315
47 ;;INELIGIBLE REIMB. INS.        ;       ;0160R1  ;315
48 ;;CHOICE THIRD PARTY            ;       ;528713
49 ;;CC THIRD PARTY                ;       ;528713
50 ;;CCN THIRD PARTY               ;       ;528713
51 ;;CC MTF THIRD PARTY            ;       ;528713
52 ;;CHOICE NO-FAULT AUTO          ;       ;528713
53 ;;CHOICE TORT FEASOR            ;       ;528713
54 ;;CCN WORKERS' COMP             ;       ;528713
55 ;;CCN NO-FAULT AUTO             ;       ;528713
56 ;;CCN TORT FEASOR               ;       ;528713
57 ;;CC WORKERS' COMP              ;       ;528713
58 ;;CC NO-FAULT AUTO              ;       ;528713
59 ;;CC TORT FEASOR                ;       ;528713
60 ;;CHOICE WORKERS' COMP          ;       ;528713
61 ;;CHOICE INPT                   ;       ;528714
62 ;;CHOICE RX CO-PAYMENT          ;       ;528714
63 ;;CC INPT                       ;       ;528714
64 ;;CC RX CO-PAYMENT              ;       ;528714
65 ;;CCN INPT                      ;       ;528714
66 ;;CCN RX CO-PAYMENT             ;       ;528714
67 ;;CC MTF INPT                   ;       ;528714
68 ;;CC MTF RX CO-PAYMENT          ;       ;528714
69 ;;CC NURSING HOME CARE - LTC    ;       ;528714
70 ;;CC RESPITE CARE               ;       ;528714
71 ;;CCN NURSING HOME CARE - LTC   ;       ;528714
72 ;;CCN RESPITE CARE              ;       ;528714
73 ;;CHOICE NURSING HOME CARE - LTC ;      ;528714
74 ;;CHOICE RESPITE CARE           ;       ;528714
75 ;;TRICARE DES                   ;       ;0160R1
76 ;;TRICARE SCI                   ;       ;0160R1
77 ;;TRICARE TBI                   ;       ;0160R1
78 ;;TRICARE BLIND REHABILITATION  ;       ;0160R1
79 ;;TRICARE DENTAL                ;       ;0160R1
80 ;;TRICARE PHARMACY              ;       ;0160R1
81 ;;CHOICE OPT                    ;       ;528714
82 ;;CC OPT                        ;       ;528714
83 ;;CCN OPT                       ;       ;528714
84 ;;CC MTF OPT                    ;       ;528714
85 ;;CC URGENT CARE                ;       ;528714  ;PRCA*4.5*360