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