RMPRPST3.m

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 ---RMPRPST3   2610     printed  Mar 13, 2025@21:42:28                                                                                                                                                                                                    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