Routine: RMPRL22

RMPRL22 ;PHX/DWL-LIST ISSUE FROM STOCK IN 660 ;8/29/1994

 ;;3.0;PROSTHETICS;;Feb 09, 1996

HDR W !?3,"ENTRIES FOR ",RMPRNAM,!!!?3,"TYPE",!?4,"OF",?8,"ITEM",?32,"SERIAL",?52,"DELIVERY",?71,"TOTAL",!?3,"TRAN",?9,"NO. - DESCRIPTION",?28,"QTY",?32,"NUMBER",?39,"SCE",?43,"VENDOR",?54,"DATE",?62,"REMARKS",?71,"COST"

LOOP F  S RMPRA=$O(^RMPR(660,"C",RMPRDFN,RMPRA)) Q:RMPRA=""  D PRT

 I RC=0 W !,"NO OUTSTANDING 2237 ENTRIES."

PRT S Y=^RMPR(660,RMPRA,0)

 I $P(Y,U,13)'="3" Q

 S RC=RC+1,RMPRA(RC)=RMPRA

 S RMPRDT=$P(Y,U,3),RMPRT=$P(Y,U,4),RMPRI=$P(Y,U,6),RMPRI=$P(^RMPR(661,RMPRI,0),U,1),RMPRDS=$P(^PRC(441,RMPRI,0),U,2),RMPRQTY=$P(Y,U,7),RMPRSN=$P(Y,U,11),RMPRSO=$P(Y,U,14),RMPRV=$P(Y,U,9),RMPRDD=$P(Y,U,12),RMPRR=$P(Y,U,18)

 S RMPRCT(RMPRA)=$S($D(RMPRCT(RMPRA)):RMPRCT(RMPRA),1:0)

 S RMPRTO=RMPRCT(RMPRA)*RMPRQTY,$P(Y,U,16)=RMPRTO,RMPRV=$S(RMPRV="":"",$D(^PRC(440,RMPRV,0)):$P(^(0),U,1),1:""),RMPRDD=$E(RMPRDD,4,5)_"/"_$E(RMPRDD,6,7)_"/"_$E(RMPRDD,2,3)

 W !,RC,".",?4,RMPRT,?8,RMPRI," - ",$E(RMPRDS,1,12),?29,RMPRQTY,?32,$E(RMPRSN,1,6),?39,RMPRSO,?43,$E(RMPRV,1,7),?52,RMPRDD,?62,$E(RMPRR,1,7),?71,"$",RMPRTO

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRL22   1124     printed  Mar 13, 2025@21:39:53                                                                                                                                                                                                     Page 2

RMPRL22   ;PHX/DWL-LIST ISSUE FROM STOCK IN 660 ;8/29/1994

 +1       ;;3.0;PROSTHETICS;;Feb 09, 1996

HDR        WRITE !?3,"ENTRIES FOR ",RMPRNAM,!!!?3,"TYPE",!?4,"OF",?8,"ITEM",?32,"SERIAL",?52,"DELIVERY",?71,"TOTAL",!?3,"TRAN",?9,"NO. - DESCRIPTION",?28,"QTY",?32,"NUMBER",?39,"SCE",?43,"VENDOR",?54,"DATE",?62,"REMARKS",?71,"COST"

LOOP       FOR

               SET RMPRA=$ORDER(^RMPR(660,"C",RMPRDFN,RMPRA))

               if RMPRA=""

                   QUIT

               DO PRT

 +1        IF RC=0

               WRITE !,"NO OUTSTANDING 2237 ENTRIES."

 +2        QUIT

PRT        SET Y=^RMPR(660,RMPRA,0)

 +1        IF $PIECE(Y,U,13)'="3"

               QUIT

 +2        SET RC=RC+1

           SET RMPRA(RC)=RMPRA

 +3        SET RMPRDT=$PIECE(Y,U,3)

           SET RMPRT=$PIECE(Y,U,4)

           SET RMPRI=$PIECE(Y,U,6)

           SET RMPRI=$PIECE(^RMPR(661,RMPRI,0),U,1)

           SET RMPRDS=$PIECE(^PRC(441,RMPRI,0),U,2)

           SET RMPRQTY=$PIECE(Y,U,7)

           SET RMPRSN=$PIECE(Y,U,11)

           SET RMPRSO=$PIECE(Y,U,14)

           SET RMPRV=$PIECE(Y,U,9)

           SET RMPRDD=$PIECE(Y,U,12)

           SET RMPRR=$PIECE(Y,U,18)

 +4        SET RMPRCT(RMPRA)=$SELECT($DATA(RMPRCT(RMPRA)):RMPRCT(RMPRA),1:0)

 +5        SET RMPRTO=RMPRCT(RMPRA)*RMPRQTY

           SET $PIECE(Y,U,16)=RMPRTO

           SET RMPRV=$SELECT(RMPRV="":"",$DATA(^PRC(440,RMPRV,0)):$PIECE(^(0),U,1),1:"")

           SET RMPRDD=$EXTRACT(RMPRDD,4,5)_"/"_$EXTRACT(RMPRDD,6,7)_"/"_$EXTRACT(RMPRDD,2,3)

 +6        WRITE !,RC,".",?4,RMPRT,?8,RMPRI," - ",$EXTRACT(RMPRDS,1,12),?29,RMPRQTY,?32,$EXTRACT(RMPRSN,1,6),?39,RMPRSO,?43,$EXTRACT(RMPRV,1,7),?52,RMPRDD,?62,$EXTRACT(RMPRR,1,7),?71,"$",RMPRTO

 +7        QUIT

RMPRL22.m