RMPRPST.m

RMPRPST ;HISC/RVD - POST INIT FOR HCPCS CONVERSION;1/02/98

 ;;3.0;PROSTHETICS;**28**,JAN 02,1998

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

 Q

START ;x-ref field 4.1 in file 660

 W !!!!!!!!!!! D XREF^RMPRSE2

660 ;HCPCS conversion for file 660

 ;quit conversion if 661.1 was not transported correctly

 I '$D(^RMPR(661.1,"E",104613,2575)) W !,$C(7),"**** Unable to continue POST INIT,  file 661.1 was not transported correctly !!!!" Q

 S RMFILE=660

 W !!,"***** CONVERTING HCPCS entry for 660...."

 S I=0 F  S I=$O(^RMPR(660,I)) Q:I'>0  S RMHIEN=$P($G(^RMPR(660,I,0)),U,22) I RMHIEN,(RMHIEN>3000) D GETHC S $P(^RMPR(660,I,1),U,4)=RM6611

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

 ;

664 ;hcpcs conversion for file 664

 S RMFILE=664

 W !!,"***** CONVERTING HCPCS entry for 664...."

 S I=0 F  S I=$O(^RMPR(664,I)) Q:I'>0  F J=0:0 S J=$O(^RMPR(664,I,1,J)) Q:J'>0  S RMHIEN=$P($G(^RMPR(664,I,1,J,0)),U,16) I RMHIEN,(RMHIEN>3000) D GETHC S $P(^RMPR(664,I,1,J,0),U,16)=RM6611

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

 ;

6641 ;hcpcs conversion for file 664.1

 S RMFILE=664.1

 W !!,"***** CONVERTING HCPCS entry for 664.1...."

 S I=0 F  S I=$O(^RMPR(664.1,I)) Q:I'>0  F J=0:0 S J=$O(^RMPR(664.1,I,2,J)) Q:J'>0  S RMHIEN=$P($G(^RMPR(664.1,I,2,J,2)),U,1) I RMHIEN,(RMHIEN>3000) D GETHC S $P(^RMPR(664.1,I,2,J,2),U,1)=RM6611

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

 W !!,$C(7),"Note: Conversion of HCPCS has completed successfully."

 W !,?6,"You can let Prosthetic users back to the system !!!!!"

KILL K I,J,RMFILE,RMHIEN,RM6611,RMHCPC

 Q

 ;

GETHC ;get hcpcs IEN from 661.1

 S RM6611=$O(^RMPR(661.1,"E",RMHIEN,0)) S:'RM6611 RM6611=2430

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPRPST   1701     printed  Apr 09, 2024@21:34:32                                                                                                                                                                                                     Page 2

RMPRPST   ;HISC/RVD - POST INIT FOR HCPCS CONVERSION;1/02/98

 +1       ;;3.0;PROSTHETICS;**28**,JAN 02,1998

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

 +3        QUIT 

START     ;x-ref field 4.1 in file 660

 +1        WRITE !!!!!!!!!!!

           DO XREF^RMPRSE2

660       ;HCPCS conversion for file 660

 +1       ;quit conversion if 661.1 was not transported correctly

 +2        IF '$DATA(^RMPR(661.1,"E",104613,2575))

               WRITE !,$CHAR(7),"**** Unable to continue POST INIT,  file 661.1 was not transported correctly !!!!"

               QUIT 

 +3        SET RMFILE=660

 +4        WRITE !!,"***** CONVERTING HCPCS entry for 660...."

 +5        SET I=0

           FOR 

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

               if I'>0

                   QUIT 

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

               IF RMHIEN

                   IF (RMHIEN>3000)

                       DO GETHC

                       SET $PIECE(^RMPR(660,I,1),U,4)=RM6611

 +6        WRITE !,$CHAR(7),"***** FILE 660, HCPCS CONVERSION IS DONE!!!!"

 +7       ;

664       ;hcpcs conversion for file 664

 +1        SET RMFILE=664

 +2        WRITE !!,"***** CONVERTING HCPCS entry for 664...."

 +3        SET I=0

           FOR 

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

               if I'>0

                   QUIT 

               FOR J=0:0

                   SET J=$ORDER(^RMPR(664,I,1,J))

                   if J'>0

                       QUIT 

                   SET RMHIEN=$PIECE($GET(^RMPR(664,I,1,J,0)),U,16)

                   IF RMHIEN

                       IF (RMHIEN>3000)

                           DO GETHC

                           SET $PIECE(^RMPR(664,I,1,J,0),U,16)=RM6611

 +4        WRITE !,$CHAR(7),"***** FILE 664, HCPCS CONVERSION IS DONE!!!!"

 +5       ;

6641      ;hcpcs conversion for file 664.1

 +1        SET RMFILE=664.1

 +2        WRITE !!,"***** CONVERTING HCPCS entry for 664.1...."

 +3        SET I=0

           FOR 

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

               if I'>0

                   QUIT 

               FOR J=0:0

                   SET J=$ORDER(^RMPR(664.1,I,2,J))

                   if J'>0

                       QUIT 

                   SET RMHIEN=$PIECE($GET(^RMPR(664.1,I,2,J,2)),U,1)

                   IF RMHIEN

                       IF (RMHIEN>3000)

                           DO GETHC

                           SET $PIECE(^RMPR(664.1,I,2,J,2),U,1)=RM6611

 +4        WRITE !,$CHAR(7),"***** FILE 664.1, HCPCS CONVERSION IS DONE!!!!"

 +5        WRITE !!,$CHAR(7),"Note: Conversion of HCPCS has completed successfully."

 +6        WRITE !,?6,"You can let Prosthetic users back to the system !!!!!"

KILL       KILL I,J,RMFILE,RMHIEN,RM6611,RMHCPC

 +1        QUIT 

 +2       ;

GETHC     ;get hcpcs IEN from 661.1

 +1        SET RM6611=$ORDER(^RMPR(661.1,"E",RMHIEN,0))

           if 'RM6611

               SET RM6611=2430

 +2        QUIT