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