82 lines
2.5 KiB
Mathematica
82 lines
2.5 KiB
Mathematica
RMPRPST3 ;HISC/ODJ - POST INIT FOR +AL HCPCS;8/1/00
|
|
;;3.0;PROSTHETICS;**50**;Aug 01,2000
|
|
W !!,"Must use correct line label - review source code.",!!
|
|
Q
|
|
START ;Populate the 661.1 HCPC File with additional codes
|
|
N I,RMPRIEN,RMPRDAT,RMPRDES
|
|
S U="^"
|
|
W !!,"Entering Additional HCPCs......."
|
|
F I=1:2 Q:$P($T(DAT+I),";",3)="END" D
|
|
. S RMPRDAT=$P($T(DAT+I),";",3)
|
|
. S RMPRIEN=$P(RMPRDAT,"=",1)
|
|
. S RMPRDAT=$P(RMPRDAT,"=",2)
|
|
. W !,RMPRIEN," ",RMPRDAT
|
|
. S RMPRDES=$P($P($T(DAT+I+1),";",3),"=",2)
|
|
. D UPD(RMPRIEN,RMPRDAT,RMPRDES)
|
|
. Q
|
|
W !,"Finished entering Additional HCPCs",!
|
|
W !,"Adding RR modifier to HCPC E0434"
|
|
D E0434
|
|
W !,"Finished adding modifier to HCPC E0434",!
|
|
W !,"Amending HCPC V5299"
|
|
D V5299
|
|
W !,"Finished amending V5299"
|
|
W !,"Finished post init",!
|
|
Q
|
|
UPD(RMPRIEN,RMPRDAT,RMPRDES) ;
|
|
N RMPRFDA,RMPRIA
|
|
S RMPRIA(1)=RMPRIEN,RMPRIEN=RMPRIEN_","
|
|
S:'$D(^RMPR(661.1,RMPRIA(1))) RMPRIEN="+1,"
|
|
S RMPRFDA(661.1,RMPRIEN,.01)=$P(RMPRDAT,U,1)
|
|
S RMPRFDA(661.1,RMPRIEN,.02)=$P(RMPRDAT,U,2)
|
|
S RMPRFDA(661.1,RMPRIEN,1)=$P(RMPRDAT,U,3)
|
|
S RMPRFDA(661.1,RMPRIEN,2)=$P(RMPRDAT,U,4)
|
|
S RMPRFDA(661.1,RMPRIEN,3)=$P(RMPRDAT,U,5)
|
|
S RMPRFDA(661.1,RMPRIEN,5)=$P(RMPRDAT,U,6)
|
|
S RMPRFDA(661.1,RMPRIEN,6)=$P(RMPRDAT,U,7)
|
|
S RMPRFDA(661.1,RMPRIEN,9)=$P(RMPRDAT,U,8)
|
|
S RMPRFDA(661.1,RMPRIEN,10)=$P(RMPRDAT,U,9)
|
|
S RMPRFDA(661.1,RMPRIEN,11)=$P(RMPRDAT,U,10)
|
|
I '$D(^RMPR(661.1,RMPRIA(1))) D
|
|
. D UPDATE^DIE("U","RMPRFDA","RMPRIA")
|
|
. K RMPRFDA
|
|
. S RMPRIEN="+1,"_RMPRIA(1)_","
|
|
. K RMPRIA
|
|
. S RMPRFDA(661.18,RMPRIEN,.01)=RMPRDES
|
|
. D UPDATE^DIE("U","RMPRFDA")
|
|
. Q
|
|
E D
|
|
. D UPDATE^DIE("","RMPRFDA")
|
|
. Q
|
|
Q
|
|
;
|
|
; Add RR CPT modifier to HCPC E0434
|
|
E0434 N IEN,HCPC,OUP
|
|
S HCPC="E0434"
|
|
S IEN=$O(^RMPR(661.1,"B",HCPC,""))_","
|
|
D GETS^DIQ(661.1,IEN,".03","","OUP")
|
|
I OUP(661.1,IEN,.03)'["RR" D
|
|
.S OUP(661.1,IEN,.03)=OUP(661.1,IEN,.03)_",RR"
|
|
.D UPDATE^DIE("","OUP")
|
|
Q
|
|
;
|
|
; HCPC V5299 change NPPD line to 600E
|
|
V5299 N IEN,HCPC,OUP
|
|
S HCPC="V5299"
|
|
S IEN=$O(^RMPR(661.1,"B",HCPC,""))_","
|
|
D GETS^DIQ(661.1,IEN,"6","","OUP")
|
|
S OUP(661.1,IEN,6)="600 E"
|
|
D UPDATE^DIE("","OUP")
|
|
Q
|
|
;
|
|
DAT ;;table for +al HCPCs (grabbed from NPP)
|
|
;;2969=A4258^LANCET DEVICE^^104352^1^^910 A
|
|
;;2969=LANCET DEVICE FOR FINGER STICKS
|
|
;;2970=E0747^BONE STIMULATOR^^100895^1^R 90^900 K
|
|
;;2970=BONE STIMULATOR OTHER THAN SPINAL APPLICATIONS
|
|
;;2971=E0748^BONE STIMULATOR-SPINAL^^104407^1^R 90^900 K
|
|
;;2971=BONE STIMULATOR-SPINAL APPLICATION
|
|
;;2972=E0749^BONE STIMULATOR-SURGICAL^^100896^1^^960 D
|
|
;;2972=BONE STIMULATOR-SURGICALLY IMPLANTED
|
|
;;END
|