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

RCXFMSUR.m

Go to the documentation of this file.
  1. RCXFMSUR ;WISC/RFJ-revenue source codes ;10/19/10 1:47pm
  1. ;;4.5;Accounts Receivable;**90,101,170,203,173,220,231,273,310,315,338,360,435**;Mar 20, 1995;Build 3
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;Read ^DGCR(399) via IA 3820
  1. Q
  1. ;
  1. ;
  1. CALCRSC(BILLDA,RCEFT) ; calculate the revenue source code for a bill
  1. ; rceft = 1 if processing an EFT deposit
  1. ; returns the 4 column (character) rsc
  1. N CATEGDA,COLUMN1,COLUMN2,COLUMN3,COLUMN4,RSC
  1. ; if rsc already calculated, return it
  1. I $G(RCEFT)=1 S RSC="8NZZ" Q RSC
  1. S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",23)
  1. I $L(RSC)=4,RSC'="ARRV" Q RSC
  1. ;
  1. ; calculate it and store it
  1. S CATEGDA=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
  1. ;
  1. ;PRCA$4.5*338 If a Community Care Category, retrieve RSC, store it and exit.
  1. I CATEGDA>47,(CATEGDA<75) D Q RSC
  1. . S RSC=$$GETCCRSC(CATEGDA,BILLDA)
  1. . D STORE(BILLDA,RSC)
  1. I CATEGDA>80,(CATEGDA<86) D Q RSC ; prca*4.5*360 added CC UC
  1. . S RSC=$$GETCCRSC(CATEGDA,BILLDA)
  1. . D STORE(BILLDA,RSC)
  1. ;
  1. ; if prepayment, send ARRV
  1. I CATEGDA=26 D STORE(BILLDA,"ARRV") Q "ARRV"
  1. ;
  1. S COLUMN1=$$COLUMN1
  1. ;
  1. ; check for 3rd party RX bills after 4/27/2011 for col 2
  1. N RX3P S RX3P=0
  1. I ("PH"=$$TYP^IBRFN(BILLDA)) D
  1. . S RX3P=$$CHECKRXS^RCXFMSUF(BILLDA)
  1. ;
  1. S COLUMN2=$$COLUMN2
  1. ;
  1. ; if column2 cannot be determined, return the rsc of ARRV
  1. I COLUMN2="" D STORE(BILLDA,"ARRV") Q "ARRV"
  1. ;
  1. ; if column2 is not a 5 for reimbursable health insurance, or category not 45 (FEE REIMB INS)
  1. ; return ZZ in columns 3 and 4
  1. I COLUMN2'=5,CATEGDA'=45 D STORE(BILLDA,COLUMN1_COLUMN2_"ZZ") Q COLUMN1_COLUMN2_"ZZ"
  1. ;
  1. ; for reimbursable health insurance, compute columns 3 and 4
  1. S COLUMN3=$$COLUMN3
  1. S COLUMN4=$$COLUMN4
  1. ;
  1. D STORE(BILLDA,COLUMN1_COLUMN2_COLUMN3_COLUMN4)
  1. Q COLUMN1_COLUMN2_COLUMN3_COLUMN4
  1. ;
  1. ;
  1. STORE(DA,RSC,FUND) ; store the revenue source code or fund in the file
  1. I $G(^PRCA(430,DA,0))="" Q
  1. N D,D0,DI,DIC,DIE,DQ,DR,X,Y
  1. S DR=""
  1. I $G(RSC)'="" S DR="255.1////"_RSC_";"
  1. I $G(FUND)'="" S DR=DR_"203////"_FUND_";"
  1. S (DIC,DIE)="^PRCA(430,"
  1. D ^DIE
  1. Q
  1. ;
  1. ;
  1. COLUMN1() ; return column 1 number
  1. Q 8
  1. ;
  1. ;
  1. COLUMN2() ; return column 2 number
  1. I CATEGDA=5 Q 1 ; hospital care (nsc)
  1. I CATEGDA=4 Q 2 ; outpatient care (nsc)
  1. I CATEGDA=3 Q 3 ; nursing home care (nsc)
  1. I CATEGDA=1 Q 4 ; ineligible hospital
  1. I CATEGDA=9&$G(RX3P) Q "R" ; pharmacy reimbursable health insurance
  1. I CATEGDA=9 Q 5 ; reimbursable health insurance
  1. I CATEGDA=10&$G(RX3P) Q "S" ; pharmacy tort feasor
  1. I CATEGDA=10 Q 6 ; tort feasor
  1. I CATEGDA=6&$G(RX3P) Q "T" ;pharmacy workman's comp
  1. I CATEGDA=6 Q 7 ; workmans comp
  1. I CATEGDA=18 Q 8 ; c (means test)
  1. I CATEGDA=2 Q 9 ; emergency/humanitarian
  1. I CATEGDA=7&$G(RX3P) Q "Q" ;pharmacy no fault auto acc
  1. I CATEGDA=7 Q "A" ; no fault auto accident
  1. I CATEGDA=22 Q "B" ; rx copay/sc vet
  1. I CATEGDA=23 Q "C" ; rx copay/nsc vet
  1. I CATEGDA=24 Q "D" ; nursing home care per diem
  1. I CATEGDA=25 Q "E" ; hospital care per diem
  1. I CATEGDA=21 Q "F" ; medicare
  1. I CATEGDA=33 Q "G" ; adult day health care
  1. I CATEGDA=34 Q "H" ; domiciliary
  1. I CATEGDA=35 Q "I" ; respite care - institutional
  1. I CATEGDA=36 Q "J" ; respite care - non-institutional
  1. I CATEGDA=37 Q "K" ; geriatric evaluation - institutional
  1. I CATEGDA=38 Q "L" ; geriatric evaluation - non-institutional
  1. I CATEGDA=39 Q "M" ; nursing home care - ltc
  1. I CATEGDA=45 Q "F" ; Fee Basis
  1. I CATEGDA=46 D Q COLUMN2
  1. . N COL
  1. . D DIQ399(BILLDA)
  1. . S COL=$G(IBCNDATA(399,BILLDA,.05,"I"))
  1. . S COLUMN2=$S(COL=1:"U",COL=2:"U",COL=3:"V",1:"V")
  1. Q ""
  1. ;
  1. ;
  1. COLUMN3() ; return the column 3 number
  1. N AGE,DECIMAL,DFN,IBCNDATA,TYPEAGE,TYPECARE,TYPEMEAN,TYPESERV,VA,VADM,VAERR
  1. ;
  1. D DIQ399(BILLDA)
  1. ;
  1. ; PRCA*4.5*310/DRF
  1. ; for Fee Basis, column3 = 1 (inpatient) or 2 (outpatient)
  1. I CATEGDA=45 S COLUMN3=$S($G(IBCNDATA(399,BILLDA,.05,"I"))=1:1,$G(IBCNDATA(399,BILLDA,.05,"I"))=2:2,1:2) Q COLUMN3
  1. ;
  1. D TYPECARE
  1. ;
  1. ; compute service connected at time of care (1 digit binary)
  1. ; type of service connected is set as follows:
  1. ; 0 = SC Vet 1 = NSC Vet
  1. S TYPESERV=1
  1. ; service connected at time of care (.18) = yes (1)
  1. I $G(IBCNDATA(399,BILLDA,.18,"I"))=1 S TYPESERV=0
  1. ;
  1. S DFN=$P($G(^PRCA(430,BILLDA,0)),"^",7)
  1. D DEM^VADPT
  1. ;
  1. ; compute means test at time of care (1 digit binary)
  1. ; type of means test is set as follows:
  1. ; 0 = Cat A 1 = Cat C
  1. S TYPEMEAN=0
  1. I $$BIL^DGMTUB(DFN,$G(IBCNDATA(399,BILLDA,151,"I")))=1 S TYPEMEAN=1
  1. ;
  1. ; compute patient age at time of care (1 digit binary)
  1. ; type of age is set as follows:
  1. ; 0 = under 65 1 = 65 and older
  1. S AGE=$$FMDIFF^XLFDT($G(IBCNDATA(399,BILLDA,151,"I")),$P($G(VADM(3)),"^"))\365.25
  1. S TYPEAGE=1
  1. I AGE<65 S TYPEAGE=0
  1. ;
  1. ; convert to decimal typecare typeserv typemean typeage
  1. ; binary= 1 1 1 1 1
  1. ; decimal= 16 + 8 + 4 + 2 + 1
  1. S DECIMAL=$S(TYPECARE="11":24,TYPECARE="10":16,TYPECARE="01":8,1:0)
  1. I TYPESERV S DECIMAL=DECIMAL+4
  1. I TYPEMEAN S DECIMAL=DECIMAL+2
  1. I TYPEAGE S DECIMAL=DECIMAL+1
  1. I DECIMAL<10 Q DECIMAL
  1. Q $C(65+DECIMAL-10)
  1. ;
  1. ;
  1. COLUMN4() ; return the column 4 number (reserved for future expansion)
  1. Q "Z"
  1. ;
  1. ;
  1. DIQ399(DA) ; get data from file 399
  1. N D0,DIC,DIQ,DIQ2,DR
  1. K IBCNDATA
  1. S DIQ(0)="IE",DIC="^DGCR(399,",DIQ="IBCNDATA",DR=".04;.05;.18;151;" D EN^DIQ1
  1. Q
  1. ;
  1. ;
  1. TYPECARE ; compute type of care (2 digit binary)
  1. ; type of care is set as follows:
  1. ; 00 = inpatient (hospital) 01 = outpatient
  1. ; 10 = nursing home 11 = other
  1. ; default is other if it cannot be computed
  1. S TYPECARE="11"
  1. ; bill classification (.05) = outpatient (3) or human.emerg(opt) (4)
  1. I $G(IBCNDATA(399,BILLDA,.05,"I"))=3!($G(IBCNDATA(399,BILLDA,.05,"I"))=4) S TYPECARE="01" Q
  1. ; location of care (.04) = hospital inpt or outpt (1)
  1. I $G(IBCNDATA(399,BILLDA,.04,"I"))=1 S TYPECARE="00" Q
  1. ; location of care (.04) = skilled nursing (nhcu) (2)
  1. I $G(IBCNDATA(399,BILLDA,.04,"I"))=2 S TYPECARE="10"
  1. Q
  1. ;
  1. ;
  1. ADDEDIT ; enter/edit revenue source codes for fund 0160A1 bills. These
  1. ; bills have the rsc entered by the user. The user can select
  1. ; from rscs in file 347.3
  1. W !!,"This option should be used with CAUTION. This option will allow the"
  1. W !,"user owning the PRCASVC supervisor security key, to add or edit the"
  1. W !,"Revenue Source Codes selectable for non MCCF bills. If an invalid"
  1. W !,"Revenue Source Code is entered or changed, all code sheets sent to"
  1. W !,"FMS referencing the invalid Revenue Source Code will reject. Be"
  1. W !,"cautious when entering new Revenue Source Codes or editing existing"
  1. W !,"Revenue Source Codes. New Revenue Source Codes should only be added"
  1. W !,"after they have been added in FMS."
  1. ;
  1. I '$D(^XUSEC("PRCASVC",DUZ)) W !!,"You are not an owner of the PRCASVC security key." Q
  1. ;
  1. N %,%Y,C,D,D0,DA,DI,DIC,DIE,DLAYGO,DQ,DR,RCRJFLAG,X,X1,X2,X3,Y
  1. ;
  1. F D Q:$G(RCRJFLAG)
  1. . S (DIC,DIE)="^RC(347.3,",DIC(0)="QEL",DLAYGO=347.3
  1. . R !!,"Select REVENUE SOURCE CODE: ",X:DTIME
  1. . S X1=X,X=$$UPPER^VALM1(X)
  1. . I $E(X)="?",X?."?" D ^DIC Q:Y<1
  1. . I X=""!($E(X)=U) S RCRJFLAG=1 Q
  1. . I $D(^RC(347.3,"B",X)) S Y=+$O(^(X,0)) W " ",X," ",$P($G(^RC(347.3,Y,0)),U,2) W:$P(^(0),U,3) " INACTIVE" D UPD Q
  1. . S X2=$L(X1),X3=$C($A($E(X1,X2))-1),X3=$E(X1,1,X2-1)_X3,X3=$O(^RC(347.3,"C",X3)) I $E(X3,1,X2)=X1 S X=X1
  1. . S D="C" D IX^DIC Q:Y<1 D UPD Q
  1. Q
  1. UPD S DIE="^RC(347.3,",DA=+Y,DR=".02;.03" D ^DIE
  1. Q
  1. ;
  1. ;
  1. RSC ;revenue code (#430/255)
  1. I $P($G(^RC(347.3,X,0)),"^",3) D EN^DDIOL("THIS REVENUE SOURCE CODE IS INACTIVE.") K X Q
  1. S X=$P(^RC(347.3,X,0),"^")
  1. Q
  1. ;
  1. SHOW ; show/calculate revenue source code for a selected bill
  1. W !!,"This option will show the calculated Revenue Source Code for a selected"
  1. W !,"bill. The Revenue Source Code is only calculated for accrued bills in"
  1. I DT'<$$ADDPTEDT^PRCAACC() W !,"funds 528701,528703,528704,528709/4032,528711,528713,528714"
  1. I DT<$$ADDPTEDT^PRCAACC() W !,"funds 5287.1,5287.3,5287.4,4032"
  1. ;
  1. N %,%Y,BILLDA,C,DIC,FUND,I,RCRJFLAG,RSC,X,Y
  1. N CATEG ;PRCA*4.5*435 Temporary fix
  1. ;
  1. F D Q:$G(RCRJFLAG)
  1. . S DIC="^PRCA(430,",DIC(0)="QEAM"
  1. . W ! D ^DIC
  1. . I Y<1 S RCRJFLAG=1 Q
  1. . S BILLDA=+Y
  1. . ;PRCA*4.5*338 - prevent Non-accrued funds from recalculating Fund Number)
  1. . ; look for an existing fund number
  1. . S FUND=$P($G(^PRCA(430,BILLDA,11)),"^",17)
  1. . ; only recalculate fund number if Accrued fund
  1. . I $$PTACCT^PRCAACC(FUND) S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
  1. . ;end PRCA*4.5*338
  1. . ;
  1. . ;PRCA*4.5*435 - Temporary fix for Manual BOCs (cat = 18,22,23) that may not have a fund
  1. . ;A permanent fix for both the fund and RSC will occur as a future enhancement
  1. . I $G(FUND)="" D
  1. . . S CATEG=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
  1. . . ;Valid categories are: 18 - C (MEANS TEST), 22 - RX CO-PAYMENT/SC VET, 23 - RX CO-PAYMENT/NSC VET
  1. . . I CATEG'=18&(CATEG'=22)&(CATEG'=23) Q
  1. . . ;Calculate and store the fund
  1. . . S FUND=$$GETFUNDB^RCXFMSUF(BILLDA)
  1. . ;end PRCA*4.5*435
  1. . ;
  1. . W !!," Bill Number: ",$P($G(^PRCA(430,BILLDA,0)),"^")
  1. . W !," Fund: ",FUND
  1. . I '$$PTACCT^PRCAACC(FUND),FUND'=4032 D Q
  1. . . W !," The Revenue Source Code cannot be calculated for non-accrued bills."
  1. . . W !," The Revenue Source Code for non-accrued bills are input by the user."
  1. . . W !," The Revenue Source Code is currently entered as: "
  1. . . S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
  1. . . W $S(RSC="":"<not entered>",1:RSC)
  1. . ;
  1. . S RSC=$$CALCRSC(BILLDA)
  1. . W !,"Revenue Source Code: ",RSC
  1. Q
  1. ;
  1. ;PRCA*4.5*338
  1. GETCCRSC(CATEGDA,BILLDA) ;Retrieve the RSC for Community Care Categories
  1. N RCRSC,IBCNDATA,RCIOPFLG,RX3P
  1. S RCRSC=""
  1. Q:CATEGDA=52 "84CC" ;Choice No-Fault Auto AR Category
  1. Q:CATEGDA=53 "85CC" ;Choice TORT Feasor AR Category
  1. Q:CATEGDA=60 "86CC" ;Choice Workers' Comp AR Category
  1. Q:CATEGDA=54 "8CNW" ;CCN Workers' Comp AR Category
  1. Q:CATEGDA=56 "8CN9" ;CCN TORT Feasor AR Category
  1. Q:CATEGDA=55 "8CN8" ;CCN No-Fault Auto AR Category
  1. Q:CATEGDA=57 "8C6C" ;CC Workers' Comp AR Category
  1. Q:CATEGDA=59 "8C5C" ;CC TORT Feasor AR Category
  1. Q:CATEGDA=58 "8C4C" ;CC No-Fault Auto AR Category
  1. Q:CATEGDA=61 "8CC5" ;CHOICE Inpatient Copay
  1. Q:CATEGDA=62 "8CC7" ;CHOICE RX CO-PAYMENT Copay
  1. Q:CATEGDA=63 "8CC1" ;CC Inpatient Copay
  1. Q:CATEGDA=64 "8CC3" ;CC RX CO-PAYMENT
  1. Q:CATEGDA=65 "8CN1" ;CCN Inpatient Copay
  1. Q:CATEGDA=66 "8CN3" ;CCN RX CO-PAYMENT
  1. Q:CATEGDA=67 "8CD1" ;CC MTF C (MEANS TEST)
  1. Q:CATEGDA=68 "8CD3" ;CC MTF RX CO-PAYMENT
  1. Q:CATEGDA=69 "8CC4" ;CC NURSING HOME CARE - LTC
  1. Q:CATEGDA=70 "8CC4" ;CC RESPITE CARE
  1. Q:CATEGDA=71 "8CN4" ;CCN NURSING HOME CARE - LTC
  1. Q:CATEGDA=72 "8CN4" ;CCN RESPITE CARE
  1. Q:CATEGDA=73 "8CC8" ;CHOICE NURSING HOME CARE - LTC
  1. Q:CATEGDA=74 "8CC8" ;CHOICE RESPITE CARE
  1. Q:CATEGDA=81 "8CC6" ;CHOICE OPT
  1. Q:CATEGDA=82 "8CC2" ;CC OPT
  1. Q:CATEGDA=83 "8CN2" ;CCN OPT
  1. Q:CATEGDA=84 "8CD2" ;CC MTF OPT
  1. Q:CATEGDA=85 "8CCU" ;CC URGENT CARE prca*4.5*360
  1. I (CATEGDA>47),(CATEGDA<52) D Q RCRSC
  1. . S RCIOPFLG=""
  1. . S RX3P=0
  1. . I ("PH"=$$TYP^IBRFN(BILLDA)) D
  1. . . S RX3P=$$CHECKRXS^RCXFMSUF(BILLDA)
  1. . D DIQ399(BILLDA)
  1. . ; for Community Care, 1 (inpatient) or 2 (outpatient -everything else)
  1. . S RCIOPFLG=$S($G(IBCNDATA(399,BILLDA,.05,"I"))=1:1,1:2)
  1. . I (CATEGDA=48),RX3P S RCRSC="83CC" Q ;CHOICE INS RX
  1. . I (CATEGDA=48),(RCIOPFLG=1) S RCRSC="81CC" Q ;CHOICE INS INPATIENT
  1. . I (CATEGDA=48),(RCIOPFLG=2) S RCRSC="82CC" Q ;CHOICE INS OUTPATIENT
  1. . I (CATEGDA=49),RX3P S RCRSC="8C3C" Q ;CC INS RX
  1. . I (CATEGDA=49),(RCIOPFLG=1) S RCRSC="8C1C" Q ;CC INS INPATIENT
  1. . I (CATEGDA=49),(RCIOPFLG=2) S RCRSC="8C2C" Q ;CC INS OUTPATIENT
  1. . I (CATEGDA=50),RX3P S RCRSC="8CN7" Q ;CCN INS RX
  1. . I (CATEGDA=50),(RCIOPFLG=1) S RCRSC="8CN5" Q ;CCN INS INPATIENT
  1. . I (CATEGDA=50),(RCIOPFLG=2) S RCRSC="8CN6" Q ;CCN INS OUTPATIENT
  1. . I (CATEGDA=51),RX3P S RCRSC="8CD6" Q ;CC MTF INS RX
  1. . I (CATEGDA=51),(RCIOPFLG=1) S RCRSC="8CD4" Q ;CC MTF INS INPATIENT
  1. . I (CATEGDA=51),(RCIOPFLG=2) S RCRSC="8CD5" Q ;CC MTF INS OUTPATIENT
  1. Q 0