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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPST3 2610 printed Oct 16, 2024@18:38:12 Page 2
RMPRPST3 ;HISC/ODJ - POST INIT FOR +AL HCPCS;8/1/00
+1 ;;3.0;PROSTHETICS;**50**;Aug 01,2000
+2 WRITE !!,"Must use correct line label - review source code.",!!
+3 QUIT
START ;Populate the 661.1 HCPC File with additional codes
+1 NEW I,RMPRIEN,RMPRDAT,RMPRDES
+2 SET U="^"
+3 WRITE !!,"Entering Additional HCPCs......."
+4 FOR I=1:2
if $PIECE($TEXT(DAT+I),";",3)="END"
QUIT
Begin DoDot:1
+5 SET RMPRDAT=$PIECE($TEXT(DAT+I),";",3)
+6 SET RMPRIEN=$PIECE(RMPRDAT,"=",1)
+7 SET RMPRDAT=$PIECE(RMPRDAT,"=",2)
+8 WRITE !,RMPRIEN," ",RMPRDAT
+9 SET RMPRDES=$PIECE($PIECE($TEXT(DAT+I+1),";",3),"=",2)
+10 DO UPD(RMPRIEN,RMPRDAT,RMPRDES)
+11 QUIT
End DoDot:1
+12 WRITE !,"Finished entering Additional HCPCs",!
+13 WRITE !,"Adding RR modifier to HCPC E0434"
+14 DO E0434
+15 WRITE !,"Finished adding modifier to HCPC E0434",!
+16 WRITE !,"Amending HCPC V5299"
+17 DO V5299
+18 WRITE !,"Finished amending V5299"
+19 WRITE !,"Finished post init",!
+20 QUIT
UPD(RMPRIEN,RMPRDAT,RMPRDES) ;
+1 NEW RMPRFDA,RMPRIA
+2 SET RMPRIA(1)=RMPRIEN
SET RMPRIEN=RMPRIEN_","
+3 if '$DATA(^RMPR(661.1,RMPRIA(1)))
SET RMPRIEN="+1,"
+4 SET RMPRFDA(661.1,RMPRIEN,.01)=$PIECE(RMPRDAT,U,1)
+5 SET RMPRFDA(661.1,RMPRIEN,.02)=$PIECE(RMPRDAT,U,2)
+6 SET RMPRFDA(661.1,RMPRIEN,1)=$PIECE(RMPRDAT,U,3)
+7 SET RMPRFDA(661.1,RMPRIEN,2)=$PIECE(RMPRDAT,U,4)
+8 SET RMPRFDA(661.1,RMPRIEN,3)=$PIECE(RMPRDAT,U,5)
+9 SET RMPRFDA(661.1,RMPRIEN,5)=$PIECE(RMPRDAT,U,6)
+10 SET RMPRFDA(661.1,RMPRIEN,6)=$PIECE(RMPRDAT,U,7)
+11 SET RMPRFDA(661.1,RMPRIEN,9)=$PIECE(RMPRDAT,U,8)
+12 SET RMPRFDA(661.1,RMPRIEN,10)=$PIECE(RMPRDAT,U,9)
+13 SET RMPRFDA(661.1,RMPRIEN,11)=$PIECE(RMPRDAT,U,10)
+14 IF '$DATA(^RMPR(661.1,RMPRIA(1)))
Begin DoDot:1
+15 DO UPDATE^DIE("U","RMPRFDA","RMPRIA")
+16 KILL RMPRFDA
+17 SET RMPRIEN="+1,"_RMPRIA(1)_","
+18 KILL RMPRIA
+19 SET RMPRFDA(661.18,RMPRIEN,.01)=RMPRDES
+20 DO UPDATE^DIE("U","RMPRFDA")
+21 QUIT
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 DO UPDATE^DIE("","RMPRFDA")
+24 QUIT
End DoDot:1
+25 QUIT
+26 ;
+27 ; Add RR CPT modifier to HCPC E0434
E0434 NEW IEN,HCPC,OUP
+1 SET HCPC="E0434"
+2 SET IEN=$ORDER(^RMPR(661.1,"B",HCPC,""))_","
+3 DO GETS^DIQ(661.1,IEN,".03","","OUP")
+4 IF OUP(661.1,IEN,.03)'["RR"
Begin DoDot:1
+5 SET OUP(661.1,IEN,.03)=OUP(661.1,IEN,.03)_",RR"
+6 DO UPDATE^DIE("","OUP")
End DoDot:1
+7 QUIT
+8 ;
+9 ; HCPC V5299 change NPPD line to 600E
V5299 NEW IEN,HCPC,OUP
+1 SET HCPC="V5299"
+2 SET IEN=$ORDER(^RMPR(661.1,"B",HCPC,""))_","
+3 DO GETS^DIQ(661.1,IEN,"6","","OUP")
+4 SET OUP(661.1,IEN,6)="600 E"
+5 DO UPDATE^DIE("","OUP")
+6 QUIT
+7 ;
DAT ;;table for +al HCPCs (grabbed from NPP)
+1 ;;2969=A4258^LANCET DEVICE^^104352^1^^910 A
+2 ;;2969=LANCET DEVICE FOR FINGER STICKS
+3 ;;2970=E0747^BONE STIMULATOR^^100895^1^R 90^900 K
+4 ;;2970=BONE STIMULATOR OTHER THAN SPINAL APPLICATIONS
+5 ;;2971=E0748^BONE STIMULATOR-SPINAL^^104407^1^R 90^900 K
+6 ;;2971=BONE STIMULATOR-SPINAL APPLICATION
+7 ;;2972=E0749^BONE STIMULATOR-SURGICAL^^100896^1^^960 D
+8 ;;2972=BONE STIMULATOR-SURGICALLY IMPLANTED
+9 ;;END
