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 ---[H[J[2J[HRMPRPST 1701 printed Sep 23, 2025@20:13:41 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
