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."
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRL22 1124 printed Dec 13, 2024@02:34:59 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
