RMPRPSTS.m

RMPRPSTS ;HISC/RVD/HNC - POST INIT FOR UNKNOWN HCPCS CONVERSION;6/11/98

 ;;3.0;PROSTHETICS;**32**,Jun 11,1998

 W !,$C(7),"Invalid Entry......"

 Q

START ;

 S U="^"

 W !!,"***** CONVERTING UNKNOWN HCPCS...."

 S I=0

 F  S I=$O(^RMPR(660,I)) Q:I'>0  D

 .S RMDAT1=($G(^RMPR(660,I,1)))

 .I $P(RMDAT1,U,4)=2430 S $P(^RMPR(660,I,0),U,22)=101067

 ;re-cross reference the 4.1 field

 K ^RMPR(660,"G")

 S DIK="^RMPR(660,",DIK(1)="4.1^G" D ENALL^DIK

 W !!!,$C(7),"***** UNKNOWN HCPCS CONVERSION IS DONE!!!!"

KILL K I,RMDAT0

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPRPSTS   531     printed  Apr 09, 2024@21:35:14                                                                                                                                                                                                     Page 2

RMPRPSTS  ;HISC/RVD/HNC - POST INIT FOR UNKNOWN HCPCS CONVERSION;6/11/98

 +1       ;;3.0;PROSTHETICS;**32**,Jun 11,1998

 +2        WRITE !,$CHAR(7),"Invalid Entry......"

 +3        QUIT 

START     ;

 +1        SET U="^"

 +2        WRITE !!,"***** CONVERTING UNKNOWN HCPCS...."

 +3        SET I=0

 +4        FOR 

               SET I=$ORDER(^RMPR(660,I))

               if I'>0

                   QUIT 

               Begin DoDot:1

 +5                SET RMDAT1=($GET(^RMPR(660,I,1)))

 +6                IF $PIECE(RMDAT1,U,4)=2430

                       SET $PIECE(^RMPR(660,I,0),U,22)=101067

               End DoDot:1

 +7       ;re-cross reference the 4.1 field

 +8        KILL ^RMPR(660,"G")

 +9        SET DIK="^RMPR(660,"

           SET DIK(1)="4.1^G"

           DO ENALL^DIK

 +10       WRITE !!!,$CHAR(7),"***** UNKNOWN HCPCS CONVERSION IS DONE!!!!"

KILL       KILL I,RMDAT0

 +1        QUIT