- 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 Mar 13, 2025@21:42:25 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
