RMPRPST1.m

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 ---RMPRPST1   1000     printed  Apr 09, 2024@21:33:40                                                                                                                                                                                                    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