400 lines
7.3 KiB
Mathematica
400 lines
7.3 KiB
Mathematica
FBXIP33B ;WCIOFO/MJE-IMPORT DOL CPT DATA ;9/18/2001
|
|
;;3.5;FEE BASIS;**33**;JAN 30, 1995
|
|
Q
|
|
;
|
|
; load data into 162.97
|
|
MRGDOL ; MERGE HFCA RVU DATA
|
|
N CPT,DOL,FBI,HCDATA,TBLN,X
|
|
D BMES^XPDUTL("--Updating file 162.97")
|
|
F FBI=1:1 S HCDATA=$P($T(DATA1+FBI),";;",2) Q:HCDATA="END" D
|
|
.S CPT=$P(HCDATA,U)
|
|
.S Y=$O(^FB(162.97,"B",CPT,0))
|
|
.I 'Y D Q:Y'>0
|
|
..K DA,DIC
|
|
..S DIC="^FB(162.97,",DLAYGO=162.97,DIC(0)="L",X=CPT
|
|
..K DD,DO D FILE^DICN I Y'>0 D BMES^XPDUTL("ERROR ADDING NEW CPT "_CPT)
|
|
..K DIC,DLAYGO
|
|
.;
|
|
.K DA,DIC
|
|
.S DA(1)=+Y
|
|
.S Y=$O(^FB(162.97,DA(1),"CY","B",2001,0))
|
|
.I 'Y D Q:Y'>0
|
|
..S DIC="^FB(162.97,"_DA(1)_",""CY"",",DIC(0)="L",DIC("P")="162.971A"
|
|
..S X=2001
|
|
..K DD,DO D FILE^DICN I Y'>0 D BMES^XPDUTL("ERROR ADDING 2001 RVU'S for "_CPT)
|
|
..K DIC,DLAYGO
|
|
.S DA=+Y
|
|
.S DIE="^FB(162.97,"_DA(1)_",""CY"","
|
|
.S DR=""
|
|
.S:$P(HCDATA,U,2)'="" DR=DR_".03///"_$P(HCDATA,U,2)
|
|
.S:$P(HCDATA,U,3)'="" DR=DR_";"_".04///"_$P(HCDATA,U,3)
|
|
.S:$P(HCDATA,U,4)'="" DR=DR_";"_".05///"_$P(HCDATA,U,4)
|
|
.S:$P(HCDATA,U,5)'="" DR=DR_";"_".06///"_$P(HCDATA,U,5)
|
|
.I $E(DR)=";" S DR=$E(DR,2,999)
|
|
.D ^DIE K DIE,DA,DR
|
|
;
|
|
;MERGE DOL DATA INTO FILED HFCA DATA
|
|
;
|
|
F FBI=1:1 S DOL=$P($T(DATA+FBI),";;",2) Q:DOL="END" D
|
|
.S TBLN="2001"_"-"_$P(DOL,U,2)
|
|
.Q:$P(DOL,U,2)='""&('$D(^FB(162.98,"B",TBLN)))
|
|
.S CPT=$P(DOL,U,3)
|
|
.I '$O(^FB(162.97,"B",CPT,0)) D BMES^XPDUTL("CPT NOT IN FILE SKIPPING CPT "_CPT) Q
|
|
.S DA(1)=+($O(^FB(162.97,"B",CPT,0)))
|
|
.I '$O(^FB(162.97,DA(1),"CY","B",2001,0)) D BMES^XPDUTL("CY NOT IN FILE SKIPPING CPT "_CPT) Q
|
|
.S DA=+($O(^FB(162.97,DA(1),"CY","B",2001,0)))
|
|
.S DIE="^FB(162.97,"_DA(1)_",""CY"","
|
|
.S:$P(DOL,U,2)'="" DR=".02///"_$P(DOL,U,2)
|
|
.S:$P(DOL,U,2)="" DR=".02///@"
|
|
.D ^DIE K DIE,DA,DR
|
|
;
|
|
;
|
|
;
|
|
D BMES^XPDUTL("---Update of file 162.97 complete")
|
|
Q
|
|
;
|
|
DATA ;This is the DOL MOD LVL data tablenumber^mod^%
|
|
;;60^61^78320
|
|
;;60^61^78803
|
|
;;60^61^78320-26
|
|
;;60^61^78320-TC
|
|
;;60^61^78803-26
|
|
;;60^61^78803-TC
|
|
;;14^^G0002
|
|
;;13^^G0004
|
|
;;12^^G0005
|
|
;;12^^G0006
|
|
;;10^^G0007
|
|
;;10^^G0015
|
|
;;13^^G0016
|
|
;;71^^G0025
|
|
;;50^^G0030-26
|
|
;;50^^G0031-26
|
|
;;50^^G0032-26
|
|
;;50^^G0033-26
|
|
;;50^^G0034-26
|
|
;;50^^G0035-26
|
|
;;50^^G0036-26
|
|
;;50^^G0037-26
|
|
;;50^^G0038-26
|
|
;;50^^G0039-26
|
|
;;50^^G0040-26
|
|
;;50^^G0041-26
|
|
;;50^^G0042-26
|
|
;;50^^G0043-26
|
|
;;50^^G0044-26
|
|
;;50^^G0045-26
|
|
;;50^^G0046-26
|
|
;;50^^G0047-26
|
|
;;52^^G0050
|
|
;;14^^G0101
|
|
;;31^^G0104
|
|
;;31^^G0105
|
|
;;20^^G0106
|
|
;;30^^G0106-26
|
|
;;30^^G0106-TC
|
|
;;14^^G0108
|
|
;;14^^G0109
|
|
;;14^^G0110
|
|
;;14^^G0111
|
|
;;14^^G0112
|
|
;;14^^G0113
|
|
;;14^^G0114
|
|
;;14^^G0115
|
|
;;14^^G0116
|
|
;;20^^G0120
|
|
;;20^^G0120-26
|
|
;;20^^G0120-TC
|
|
;;71^^G0124
|
|
;;52^^G0125
|
|
;;52^^G0125-26
|
|
;;52^^G0125-TC
|
|
;;52^^G0126
|
|
;;52^^G0126-26
|
|
;;52^^G0126-TC
|
|
;;31^^G0127
|
|
;;13^^G0128
|
|
;;52^^G0130
|
|
;;52^^G0130-26
|
|
;;52^^G0130-TC
|
|
;;52^^G0131
|
|
;;52^^G0131-26
|
|
;;52^^G0131-TC
|
|
;;52^^G0132
|
|
;;52^^G0132-26
|
|
;;52^^G0132-TC
|
|
;;71^^G0141
|
|
;;13^^M0064
|
|
;;71^^P3001
|
|
;;15^^Q0035
|
|
;;15^^Q0035-26
|
|
;;15^^Q0035-TC
|
|
;;20^^Q0091
|
|
;;50^^Q0092
|
|
;;14^^G0102
|
|
;;55^^G0163
|
|
;;55^^G0163-26
|
|
;;55^^G0163-TC
|
|
;;55^^G0164
|
|
;;55^^G0164-26
|
|
;;55^^G0164-TC
|
|
;;55^^G0165
|
|
;;55^^G0165-26
|
|
;;55^^G0165-TC
|
|
;;13^^G0166
|
|
;;31^^G0168
|
|
;;^12^94760
|
|
;;^12^94761
|
|
;;^31^15342
|
|
;;^21^15343
|
|
;;^31^16036
|
|
;;^33^19102
|
|
;;^33^19103
|
|
;;^50^19295
|
|
;;^21^20979
|
|
;;^38^21199
|
|
;;^10^22520
|
|
;;^10^22521
|
|
;;^10^22522
|
|
;;^30^30465
|
|
;;^30^33141
|
|
;;^30^34800
|
|
;;^35^34802
|
|
;;^30^34804
|
|
;;^35^34808
|
|
;;^35^34812
|
|
;;^35^34813
|
|
;;^35^34820
|
|
;;^35^34825
|
|
;;^35^34826
|
|
;;^35^34830
|
|
;;^35^34831
|
|
;;^35^34832
|
|
;;^30^35600
|
|
;;^31^36870
|
|
;;^46^43231
|
|
;;^46^43232
|
|
;;^46^43240
|
|
;;^46^43242
|
|
;;^46^43256
|
|
;;^46^44370
|
|
;;^46^44379
|
|
;;^46^44383
|
|
;;^46^44397
|
|
;;^46^45327
|
|
;;^46^45341
|
|
;;^46^45342
|
|
;;^46^45345
|
|
;;^46^45387
|
|
;;^30^50545
|
|
;;^30^50947
|
|
;;^30^50948
|
|
;;^31^52341
|
|
;;^31^52342
|
|
;;^31^52343
|
|
;;^31^52344
|
|
;;^31^52345
|
|
;;^31^52346
|
|
;;^31^52351
|
|
;;^31^52352
|
|
;;^31^52353
|
|
;;^31^52354
|
|
;;^31^52355
|
|
;;^31^52400
|
|
;;^36^54512
|
|
;;^36^54522
|
|
;;^38^55873
|
|
;;^30^57022
|
|
;;^30^57023
|
|
;;^38^57287
|
|
;;^32^58353
|
|
;;^38^61697
|
|
;;^38^61698
|
|
;;^38^62252
|
|
;;^33^64614
|
|
;;^34^66982
|
|
;;^33^67221
|
|
;;^38^69714
|
|
;;^38^69715
|
|
;;^38^69717
|
|
;;^38^69718
|
|
;;^50^70496
|
|
;;^50^70498
|
|
;;^50^70542
|
|
;;^50^70543
|
|
;;^50^70544
|
|
;;^50^70545
|
|
;;^50^70546
|
|
;;^50^70547
|
|
;;^50^70548
|
|
;;^50^70549
|
|
;;^50^71275
|
|
;;^50^71551
|
|
;;^50^71552
|
|
;;^50^72191
|
|
;;^50^72195
|
|
;;^50^72197
|
|
;;^50^73206
|
|
;;^50^73218
|
|
;;^50^73219
|
|
;;^50^73222
|
|
;;^50^73223
|
|
;;^50^73706
|
|
;;^50^73718
|
|
;;^50^73719
|
|
;;^50^73722
|
|
;;^50^73723
|
|
;;^50^74175
|
|
;;^50^74182
|
|
;;^50^74183
|
|
;;^50^75635
|
|
;;^50^75952
|
|
;;^50^75953
|
|
;;^50^76012
|
|
;;^50^76013
|
|
;;^50^76393
|
|
;;^50^76819
|
|
;;^15^92586
|
|
;;^15^93660
|
|
;;^15^93662
|
|
;;^05^97532
|
|
;;^05^97533
|
|
;;^05^97601
|
|
;;^38^62252-26
|
|
;;^38^62252-TC
|
|
;;^50^70496-26
|
|
;;^50^70496-TC
|
|
;;^50^70498-26
|
|
;;^50^70498-TC
|
|
;;^50^70542-26
|
|
;;^50^70542-TC
|
|
;;^50^70543-26
|
|
;;^50^70543-TC
|
|
;;^50^70544-26
|
|
;;^50^70544-TC
|
|
;;^50^70545-26
|
|
;;^50^70545-TC
|
|
;;^50^70546-26
|
|
;;^50^70546-TC
|
|
;;^50^70547-26
|
|
;;^50^70547-TC
|
|
;;^50^70548-26
|
|
;;^50^70548-TC
|
|
;;^50^70549-26
|
|
;;^50^70549-TC
|
|
;;^50^71275-26
|
|
;;^50^71275-TC
|
|
;;^50^71551-26
|
|
;;^50^71551-TC
|
|
;;^50^71552-26
|
|
;;^50^71552-TC
|
|
;;^50^72191-26
|
|
;;^50^72191-TC
|
|
;;^50^72195-26
|
|
;;^50^72195-TC
|
|
;;^50^72197-26
|
|
;;^50^72197-TC
|
|
;;^50^73206-26
|
|
;;^50^73206-TC
|
|
;;^50^73218-26
|
|
;;^50^73218-TC
|
|
;;^50^73219-26
|
|
;;^50^73219-TC
|
|
;;^50^73222-26
|
|
;;^50^73222-TC
|
|
;;^50^73223-26
|
|
;;^50^73223-TC
|
|
;;^50^73706-26
|
|
;;^50^73706-TC
|
|
;;^50^73718-26
|
|
;;^50^73718-TC
|
|
;;^50^73719-26
|
|
;;^50^73719-TC
|
|
;;^50^73722-26
|
|
;;^50^73722-TC
|
|
;;^50^73723-26
|
|
;;^50^73723-TC
|
|
;;^50^74175-26
|
|
;;^50^74175-TC
|
|
;;^50^74182-26
|
|
;;^50^74182-TC
|
|
;;^50^74183-26
|
|
;;^50^74183-TC
|
|
;;^50^75635-26
|
|
;;^50^75635-TC
|
|
;;^50^76393-26
|
|
;;^50^76393-TC
|
|
;;^50^76819-26
|
|
;;^50^76819-TC
|
|
;;^15^93660-TC
|
|
;;^15^93662-26
|
|
;;^15^93662-TC
|
|
;;END
|
|
;
|
|
DATA1 ;This is the HCFA data CPT^work rvu^non-fac rvu^fac rvu^mp rvu
|
|
;;59150^11.2^5.79^5.79^
|
|
;;59151^11.1^6.53^6.53^
|
|
;;70540^1.1^11.72^11.72^
|
|
;;70542^1.33^13.81^13.81^
|
|
;;70543^1.76^25.34^25.34^
|
|
;;71550^1.22^11.77^11.77^
|
|
;;71551^1.44^13.85^13.85^
|
|
;;71552^1.89^25.38^25.38^
|
|
;;72195^1.22^11.56^11.56^
|
|
;;72196^1.44^13.48^13.48^
|
|
;;72197^1.89^25.38^25.38^
|
|
;;73218^1.1^11.52^11.52^
|
|
;;73219^1.33^13.82^13.82^
|
|
;;73220^1.76^22.08^22.08^
|
|
;;73221^1.1^11.66^11.66^
|
|
;;73222^1.33^13.81^13.81^
|
|
;;73223^1.76^25.34^25.34^
|
|
;;73718^1.1^11.52^11.52^
|
|
;;73719^1.33^13.81^13.81^
|
|
;;73720^1.76^22.08^22.08^
|
|
;;73721^1.1^11.66^11.66^
|
|
;;73722^1.33^13.82^13.82^
|
|
;;73723^1.76^25.34^25.34^
|
|
;;74181^1.22^11.77^11.77^
|
|
;;74182^1.44^13.85^13.85^
|
|
;;74183^1.89^25.38^25.38^
|
|
;;76012^^^^.23
|
|
;;99234^2.56^.88^.88^
|
|
;;99235^3.42^1.19^1.19^
|
|
;;99236^4.27^1.41^1.41^
|
|
;;70540-26^1.1^.47^.47^
|
|
;;70542-26^1.33^.47^.47^
|
|
;;70543-26^1.76^.63^.63^
|
|
;;71550-26^1.22^.52^.52^
|
|
;;71551-26^1.44^.51^.51^
|
|
;;71552-26^1.89^.67^.67^
|
|
;;72195-26^1.22^.43^.43^
|
|
;;72196-26^1.44^.58^.58^
|
|
;;72197-26^1.89^.67^.67^
|
|
;;73218-26^1.1^.39^.39^
|
|
;;73219-26^1.33^.48^.48^
|
|
;;73220-26^1.76^.65^.65^
|
|
;;73221-26^1.1^.41^.41^
|
|
;;73222-26^1.33^.47^.47^
|
|
;;73223-26^1.76^.63^.63^
|
|
;;73718-26^1.1^.39^.39^
|
|
;;73719-26^1.33^.47^.47^
|
|
;;73720-26^1.76^.65^.65^
|
|
;;73721-26^1.1^.41^.41^
|
|
;;73722-26^1.33^.48^.48^
|
|
;;73723-26^1.76^.63^.63^
|
|
;;74181-26^1.22^.52^.52^
|
|
;;74182-26^1.44^.51^.51^
|
|
;;74183-26^1.89^.67^.67^
|
|
;;G0195^1.50^1.64^0.86^0.07
|
|
;;G0196^1.50^1.64^0.86^0.07
|
|
;;G0206^0.58^1.25^1.25^0.08
|
|
;;G0206-26^0.58^0.19^0.19^0.03
|
|
;;G0206-TC^0.00^1.06^1.06^0.05
|
|
;;G0207^0.58^1.25^1.25^0.08
|
|
;;G0207-26^0.58^0.19^0.19^0.03
|
|
;;G0207-TC^0.00^1.06^1.06^0.05
|
|
;;END
|
|
;
|
|
;FBXIP33B
|