RMPRPST1 ;HISC/RVD - POST INIT FOR SHIPPING CONVERSION;5/18/98
;;3.0;PROSTHETICS;**30**,MAY 18,1998
W !,$C(7),"Invalid Entry......"
Q
START ;
S U="^"
D XREF^RMPRSE2
W !!,"***** CONVERTING SHIPPING entries for file #660...."
F I=2971001:0 S I=$O(^RMPR(660,"B",I)) Q:I'>0 F J=0:0 S J=$O(^RMPR(660,"B",I,J)) Q:J'>0 S RMDAT0=$G(^RMPR(660,J,0)) D:RMDAT0
.S RMTYP=$P(RMDAT0,U,4),RMFRM=$P(RMDAT0,U,13),RMSRC=$P(RMDAT0,U,14)
.I RMTYP="",(RMSRC=""),(RMFRM=14) D PROC
W !!!,$C(7),"***** FILE #660 SHIPPING CONVERSION IS DONE!!!!"
KILL K I,J,RMIEN,RMPAT,RMSCAT,RMFRM,RMDAT0,RMDATAM,RMCHK,RMTYP,RMGRP,RMSRC
Q
;
PROC ;get GROUPER and set missing data.
S RMDATAM=$G(^RMPR(660,J,"AM"))
S RMGRP=$G(^RMPR(660,J,"AMS")) D:RMGRP
.S RMIEN=$O(^RMPR(660,"AG",RMGRP,0))
.I RMIEN S RMCHK=$G(^RMPR(660,RMIEN,"AM")),RMPCAT=$P(RMCHK,U,3),RMSCAT=$P(RMCHK,U,4),RMDATAM="^^"_RMPCAT_"^"_RMSCAT
S $P(RMDAT0,U,4)="X",$P(RMDAT0,U,14)="C"
S ^RMPR(660,J,0)=RMDAT0,^RMPR(660,J,"AM")=RMDATAM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPST1 1000 printed Nov 22, 2024@17:47:32 Page 2
RMPRPST1 ;HISC/RVD - POST INIT FOR SHIPPING CONVERSION;5/18/98
+1 ;;3.0;PROSTHETICS;**30**,MAY 18,1998
+2 WRITE !,$CHAR(7),"Invalid Entry......"
+3 QUIT
START ;
+1 SET U="^"
+2 DO XREF^RMPRSE2
+3 WRITE !!,"***** CONVERTING SHIPPING entries for file #660...."
+4 FOR I=2971001:0
SET I=$ORDER(^RMPR(660,"B",I))
if I'>0
QUIT
FOR J=0:0
SET J=$ORDER(^RMPR(660,"B",I,J))
if J'>0
QUIT
SET RMDAT0=$GET(^RMPR(660,J,0))
if RMDAT0
Begin DoDot:1
+5 SET RMTYP=$PIECE(RMDAT0,U,4)
SET RMFRM=$PIECE(RMDAT0,U,13)
SET RMSRC=$PIECE(RMDAT0,U,14)
+6 IF RMTYP=""
IF (RMSRC="")
IF (RMFRM=14)
DO PROC
End DoDot:1
+7 WRITE !!!,$CHAR(7),"***** FILE #660 SHIPPING CONVERSION IS DONE!!!!"
KILL KILL I,J,RMIEN,RMPAT,RMSCAT,RMFRM,RMDAT0,RMDATAM,RMCHK,RMTYP,RMGRP,RMSRC
+1 QUIT
+2 ;
PROC ;get GROUPER and set missing data.
+1 SET RMDATAM=$GET(^RMPR(660,J,"AM"))
+2 SET RMGRP=$GET(^RMPR(660,J,"AMS"))
if RMGRP
Begin DoDot:1
+3 SET RMIEN=$ORDER(^RMPR(660,"AG",RMGRP,0))
+4 IF RMIEN
SET RMCHK=$GET(^RMPR(660,RMIEN,"AM"))
SET RMPCAT=$PIECE(RMCHK,U,3)
SET RMSCAT=$PIECE(RMCHK,U,4)
SET RMDATAM="^^"_RMPCAT_"^"_RMSCAT
End DoDot:1
+5 SET $PIECE(RMDAT0,U,4)="X"
SET $PIECE(RMDAT0,U,14)="C"
+6 SET ^RMPR(660,J,0)=RMDAT0
SET ^RMPR(660,J,"AM")=RMDATAM
+7 QUIT
