source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXFMSUR.m@ 717

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

initial load of WorldVistAEHR
File size: 7.4 KB
Line 
1RCXFMSUR ;WISC/RFJ-revenue source codes ;1 Oct 97
2 ;;4.5;Accounts Receivable;**90,101,170,203,173,220,231**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7CALCRSC(BILLDA,RCEFT) ; calculate the revenue source code for a bill
8 ; rceft = 1 if processing an EFT deposit
9 ; returns the 4 column (character) rsc
10 N CATEGDA,COLUMN1,COLUMN2,COLUMN3,COLUMN4,RSC
11 ; if rsc already calculated, return it
12 I $G(RCEFT)=1 S RSC="8NZZ" Q RSC
13 S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",23)
14 I $L(RSC)=4,RSC'="ARRV" Q RSC
15 ;
16 ; calculate it and store it
17 S CATEGDA=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
18 ;
19 ; if prepayment, send ARRV
20 I CATEGDA=26 D STORE(BILLDA,"ARRV") Q "ARRV"
21 ;
22 S COLUMN1=$$COLUMN1
23 S COLUMN2=$$COLUMN2
24 ;
25 ; if column2 cannot be determined, return the rsc of ARRV
26 I COLUMN2="" D STORE(BILLDA,"ARRV") Q "ARRV"
27 ;
28 ; if column2 is not a 5 for reimbursable health insurance,
29 ; return ZZ in columns 3 and 4
30 I COLUMN2'=5 D STORE(BILLDA,COLUMN1_COLUMN2_"ZZ") Q COLUMN1_COLUMN2_"ZZ"
31 ;
32 ; for reimbursable health insurance, compute columns 3 and 4
33 S COLUMN3=$$COLUMN3
34 S COLUMN4=$$COLUMN4
35 ;
36 D STORE(BILLDA,COLUMN1_COLUMN2_COLUMN3_COLUMN4)
37 Q COLUMN1_COLUMN2_COLUMN3_COLUMN4
38 ;
39 ;
40STORE(DA,RSC,FUND) ; store the revenue source code or fund in the file
41 I $G(^PRCA(430,DA,0))="" Q
42 N D,D0,DI,DIC,DIE,DQ,DR,X,Y
43 S DR=""
44 I $G(RSC)'="" S DR="255.1////"_RSC_";"
45 I $G(FUND)'="" S DR=DR_"203////"_FUND_";"
46 S (DIC,DIE)="^PRCA(430,"
47 D ^DIE
48 Q
49 ;
50 ;
51COLUMN1() ; return column 1 number
52 Q 8
53 ;
54 ;
55COLUMN2() ; return column 2 number
56 I CATEGDA=5 Q 1 ; hospital care (nsc)
57 I CATEGDA=4 Q 2 ; outpatient care (nsc)
58 I CATEGDA=3 Q 3 ; nursing home care (nsc)
59 I CATEGDA=1 Q 4 ; ineligible hospital
60 I CATEGDA=9 Q 5 ; reimbursable health insurance
61 I CATEGDA=10 Q 6 ; tort fesor
62 I CATEGDA=6 Q 7 ; workmans comp
63 I CATEGDA=18 Q 8 ; c (means test)
64 I CATEGDA=2 Q 9 ; emergency/humanitarian
65 I CATEGDA=7 Q "A" ; no fault auto accident
66 I CATEGDA=22 Q "B" ; rx copay/sc vet
67 I CATEGDA=23 Q "C" ; rx copay/nsc vet
68 I CATEGDA=24 Q "D" ; nursing home care per diem
69 I CATEGDA=25 Q "E" ; hospital care per diem
70 I CATEGDA=21 Q "F" ; medicare
71 I CATEGDA=33 Q "G" ; adult day health care
72 I CATEGDA=34 Q "H" ; domiciliary
73 I CATEGDA=35 Q "I" ; respite care - institutional
74 I CATEGDA=36 Q "J" ; respite care - non-institutional
75 I CATEGDA=37 Q "K" ; geriatric evaluation - institutional
76 I CATEGDA=38 Q "L" ; geriatric evaluation - non-institutional
77 I CATEGDA=39 Q "M" ; nursing home care - ltc
78 Q ""
79 ;
80 ;
81COLUMN3() ; return the column 3 number
82 N AGE,DECIMAL,DFN,IBCNDATA,TYPEAGE,TYPECARE,TYPEMEAN,TYPESERV,VA,VADM,VAERR
83 D DIQ399(BILLDA)
84 ;
85 D TYPECARE
86 ;
87 ; compute service connected at time of care (1 digit binary)
88 ; type of service connected is set as follows:
89 ; 0 = SC Vet 1 = NSC Vet
90 S TYPESERV=1
91 ; service connected at time of care (.18) = yes (1)
92 I $G(IBCNDATA(399,BILLDA,.18,"I"))=1 S TYPESERV=0
93 ;
94 S DFN=$P($G(^PRCA(430,BILLDA,0)),"^",7)
95 D DEM^VADPT
96 ;
97 ; compute means test at time of care (1 digit binary)
98 ; type of means test is set as follows:
99 ; 0 = Cat A 1 = Cat C
100 S TYPEMEAN=0
101 I $$BIL^DGMTUB(DFN,$G(IBCNDATA(399,BILLDA,151,"I")))=1 S TYPEMEAN=1
102 ;
103 ; compute patient age at time of care (1 digit binary)
104 ; type of age is set as follows:
105 ; 0 = under 65 1 = 65 and older
106 S AGE=$$FMDIFF^XLFDT($G(IBCNDATA(399,BILLDA,151,"I")),$P($G(VADM(3)),"^"))\365.25
107 S TYPEAGE=1
108 I AGE<65 S TYPEAGE=0
109 ;
110 ; convert to decimal typecare typeserv typemean typeage
111 ; binary= 1 1 1 1 1
112 ; decimal= 16 + 8 + 4 + 2 + 1
113 S DECIMAL=$S(TYPECARE="11":24,TYPECARE="10":16,TYPECARE="01":8,1:0)
114 I TYPESERV S DECIMAL=DECIMAL+4
115 I TYPEMEAN S DECIMAL=DECIMAL+2
116 I TYPEAGE S DECIMAL=DECIMAL+1
117 I DECIMAL<10 Q DECIMAL
118 Q $C(65+DECIMAL-10)
119 ;
120 ;
121COLUMN4() ; return the column 4 number (reserved for future expansion)
122 Q "Z"
123 ;
124 ;
125DIQ399(DA) ; get data from file 399
126 N D0,DIC,DIQ,DIQ2,DR
127 K IBCNDATA
128 S DIQ(0)="IE",DIC="^DGCR(399,",DIQ="IBCNDATA",DR=".04;.05;.18;151;" D EN^DIQ1
129 Q
130 ;
131 ;
132TYPECARE ; compute type of care (2 digit binary)
133 ; type of care is set as follows:
134 ; 00 = inpatient (hospital) 01 = outpatient
135 ; 10 = nursing home 11 = other
136 ; default is other if it cannot be computed
137 S TYPECARE="11"
138 ; bill classification (.05) = outpatient (3) or human.emerg(opt) (4)
139 I $G(IBCNDATA(399,BILLDA,.05,"I"))=3!($G(IBCNDATA(399,BILLDA,.05,"I"))=4) S TYPECARE="01" Q
140 ; location of care (.04) = hospital inpt or outpt (1)
141 I $G(IBCNDATA(399,BILLDA,.04,"I"))=1 S TYPECARE="00" Q
142 ; location of care (.04) = skilled nursing (nhcu) (2)
143 I $G(IBCNDATA(399,BILLDA,.04,"I"))=2 S TYPECARE="10"
144 Q
145 ;
146 ;
147ADDEDIT ; enter/edit revenue source codes for fund 0160A1 bills. These
148 ; bills have the rsc entered by the user. The user can select
149 ; from rscs in file 347.3
150 W !!,"This option should be used with CAUTION. This option will allow the"
151 W !,"user owning the PRCASVC supervisor security key, to add or edit the"
152 W !,"Revenue Source Codes selectable for non MCCF bills. If an invalid"
153 W !,"Revenue Source Code is entered or changed, all code sheets sent to"
154 W !,"FMS referencing the invalid Revenue Source Code will reject. Be"
155 W !,"cautious when entering new Revenue Source Codes or editing existing"
156 W !,"Revenue Source Codes. New Revenue Source Codes should only be added"
157 W !,"after they have been added in FMS."
158 ;
159 I '$D(^XUSEC("PRCASVC",DUZ)) W !!,"You are not an owner of the PRCASVC security key." Q
160 ;
161 N %,%Y,C,D,D0,DA,DI,DIC,DIE,DLAYGO,DQ,DR,RCRJFLAG,X,X1,X2,X3,Y
162 ;
163 F D Q:$G(RCRJFLAG)
164 . S (DIC,DIE)="^RC(347.3,",DIC(0)="QEL",DLAYGO=347.3
165 . R !!,"Select REVENUE SOURCE CODE: ",X:DTIME
166 . S X1=X,X=$$UPPER^VALM1(X)
167 . I $E(X)="?",X?."?" D ^DIC Q:Y<1
168 . I X=""!($E(X)=U) S RCRJFLAG=1 Q
169 . 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
170 . 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
171 . S D="C" D IX^DIC Q:Y<1 D UPD Q
172 Q
173UPD S DIE="^RC(347.3,",DA=+Y,DR=".02;.03" D ^DIE
174 Q
175 ;
176 ;
177RSC ;revenue code (#430/255)
178 I $P($G(^RC(347.3,X,0)),"^",3) D EN^DDIOL("THIS REVENUE SOURCE CODE IS INACTIVE.") K X Q
179 S X=$P(^RC(347.3,X,0),"^")
180 Q
181 ;
182SHOW ; show/calculate revenue source code for a selected bill
183 W !!,"This option will show the calculated Revenue Source Code for a selected"
184 W !,"bill. The Revenue Source Code is only calculated for accrued bills in"
185 I DT'<$$ADDPTEDT^PRCAACC() W !,"funds 528701,528703,528704,528709/4032"
186 I DT<$$ADDPTEDT^PRCAACC() W !,"funds 5287.1,5287.3,5287.4,4032"
187 ;
188 N %,%Y,BILLDA,C,DIC,FUND,I,RCRJFLAG,RSC,X,Y
189 ;
190 F D Q:$G(RCRJFLAG)
191 . S DIC="^PRCA(430,",DIC(0)="QEAM"
192 . W ! D ^DIC
193 . I Y<1 S RCRJFLAG=1 Q
194 . S BILLDA=+Y
195 . S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
196 . W !!," Bill Number: ",$P($G(^PRCA(430,BILLDA,0)),"^")
197 . W !," Fund: ",FUND
198 . I '$$PTACCT^PRCAACC(FUND),FUND'=4032 D Q
199 . . W !," The Revenue Source Code cannot be calculated for non-accrued bills."
200 . . W !," The Revenue Source Code for non-accrued bills are input by the user."
201 . . W !," The Revenue Source Code is currently entered as: "
202 . . S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
203 . . W $S(RSC="":"<not entered>",1:RSC)
204 . ;
205 . S RSC=$$CALCRSC(BILLDA)
206 . W !,"Revenue Source Code: ",RSC
207 Q
Note: See TracBrowser for help on using the repository browser.