RMPR29LP ;HIN/RVD-PRINT LAB STOCK ISSUE PENDING COMPLETION ;2/09/1998
;;3.0;PROSTHETICS;**33,159**;Feb 09, 1996;Build 2
D DIV4^RMPRSIT I $D(Y),(Y<0) Q
;
EN S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT
I '$D(IO("Q")) U IO G PRINT
K IO("Q") S ZTDESC="LAB STOCK ISSUE PENDING COMPLETION REPORT",ZTRTN="PRINT^RMPR29LP",ZTIO=ION,ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMPR(""L"")")=""
D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
;
PRINT ;Entry point of printing report.
S RMPAGE=1,RMPRT=1,REND=0 D HEAD
F I=0:0 S I=$O(^RMPR(664.1,"E","S",I)) Q:I'>0 Q:$G(REND) S R40=$G(^RMPR(664.1,I,0)) F J=0:0 S J=$O(^RMPR(664.1,I,2,J)) Q:J'>0 Q:$G(REND) S R421=$G(^RMPR(664.1,I,2,J,0)) D:R421 WRI
;
EXIT ;EXIT FROM REPORT HERE
D ^%ZISC
N RMPRSITE,RMPR D KILL^XUSCLEAN
Q
;
WRI ;write Lab Stock Issue Pending Completion
S RMPAT=$P($G(^DPT($P(R40,U,2),0)),U,1),RSSN=$P(^(0),U,9)
S X1=DT
S (RMDTIN,X2)=$P(R40,U,1) D ^%DTC S RMDTOP=X
S RMDATE=$E(RMDTIN,4,5)_"/"_$E(RMDTIN,6,7)_"/"_$E(RMDTIN,2,3)
S RMWOOR=$P(R40,U,13)
S RMIT=$P(R421,U,1)
S RMITEM=$P($G(^PRC(441,$P($G(^RMPR(661,RMIT,0)),U,1),0)),U,2)
I RMPRT'=I W !,$E(RMPAT,1,14),?16,$E(RSSN,6,9),?24,RMDATE,?34,RMWOOR,?55,RMDTOP,?63,$E(RMITEM,1,16)
I RMPRT=I W !,?63,$E(RMITEM,1,16)
S RMPRT=I
I $E(IOST)["C"&($Y>(IOSL-7)) K DIR S DIR(0)="E" D ^DIR S:$D(DTOUT)!$D(DUOUT)!(Y'>0) REND=1 Q:$G(REND) W @IOF D HEAD Q
I $Y>(IOSL-6) W @IOF D HEAD
Q
;
HEAD W !,"LAB STOCK ISSUE PENDING COMPLETION",?65,"Page: ",RMPAGE,!,"for station: ",$E($P($G(^DIC(4,RMPR("STA"),0)),U,1),1,20)
S RMPAGE=RMPAGE+1
HEAD1 ;write heading
;I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR W @IOF D HEAD
W !,RMPR("L")
W !,"PATIENT",?17,"SSN",?24,"DATE INIT",?36,"WORK ORDER #",?50,"# DAYS OPEN",?68,"ITEM"
W !,"-------",?17,"---",?24,"---------",?36,"------------",?50,"-----------",?68,"----"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29LP 1870 printed Dec 13, 2024@02:32:20 Page 2
RMPR29LP ;HIN/RVD-PRINT LAB STOCK ISSUE PENDING COMPLETION ;2/09/1998
+1 ;;3.0;PROSTHETICS;**33,159**;Feb 09, 1996;Build 2
+2 DO DIV4^RMPRSIT
IF $DATA(Y)
IF (Y<0)
QUIT
+3 ;
EN SET %ZIS="MQ"
KILL IOP
DO ^%ZIS
if POP
GOTO EXIT
+1 IF '$DATA(IO("Q"))
USE IO
GOTO PRINT
+2 KILL IO("Q")
SET ZTDESC="LAB STOCK ISSUE PENDING COMPLETION REPORT"
SET ZTRTN="PRINT^RMPR29LP"
SET ZTIO=ION
SET ZTSAVE("RMPR(""STA"")")=""
SET ZTSAVE("RMPR(""L"")")=""
+3 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"REQUEST QUEUED!"
HANG 1
GOTO EXIT
+4 ;
PRINT ;Entry point of printing report.
+1 SET RMPAGE=1
SET RMPRT=1
SET REND=0
DO HEAD
+2 FOR I=0:0
SET I=$ORDER(^RMPR(664.1,"E","S",I))
if I'>0
QUIT
if $GET(REND)
QUIT
SET R40=$GET(^RMPR(664.1,I,0))
FOR J=0:0
SET J=$ORDER(^RMPR(664.1,I,2,J))
if J'>0
QUIT
if $GET(REND)
QUIT
SET R421=$GET(^RMPR(664.1,I,2,J,0))
if R421
DO WRI
+3 ;
EXIT ;EXIT FROM REPORT HERE
+1 DO ^%ZISC
+2 NEW RMPRSITE,RMPR
DO KILL^XUSCLEAN
+3 QUIT
+4 ;
WRI ;write Lab Stock Issue Pending Completion
+1 SET RMPAT=$PIECE($GET(^DPT($PIECE(R40,U,2),0)),U,1)
SET RSSN=$PIECE(^(0),U,9)
+2 SET X1=DT
+3 SET (RMDTIN,X2)=$PIECE(R40,U,1)
DO ^%DTC
SET RMDTOP=X
+4 SET RMDATE=$EXTRACT(RMDTIN,4,5)_"/"_$EXTRACT(RMDTIN,6,7)_"/"_$EXTRACT(RMDTIN,2,3)
+5 SET RMWOOR=$PIECE(R40,U,13)
+6 SET RMIT=$PIECE(R421,U,1)
+7 SET RMITEM=$PIECE($GET(^PRC(441,$PIECE($GET(^RMPR(661,RMIT,0)),U,1),0)),U,2)
+8 IF RMPRT'=I
WRITE !,$EXTRACT(RMPAT,1,14),?16,$EXTRACT(RSSN,6,9),?24,RMDATE,?34,RMWOOR,?55,RMDTOP,?63,$EXTRACT(RMITEM,1,16)
+9 IF RMPRT=I
WRITE !,?63,$EXTRACT(RMITEM,1,16)
+10 SET RMPRT=I
+11 IF $EXTRACT(IOST)["C"&($Y>(IOSL-7))
KILL DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!(Y'>0)
SET REND=1
if $GET(REND)
QUIT
WRITE @IOF
DO HEAD
QUIT
+12 IF $Y>(IOSL-6)
WRITE @IOF
DO HEAD
+13 QUIT
+14 ;
HEAD WRITE !,"LAB STOCK ISSUE PENDING COMPLETION",?65,"Page: ",RMPAGE,!,"for station: ",$EXTRACT($PIECE($GET(^DIC(4,RMPR("STA"),0)),U,1),1,20)
+1 SET RMPAGE=RMPAGE+1
HEAD1 ;write heading
+1 ;I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR W @IOF D HEAD
+2 WRITE !,RMPR("L")
+3 WRITE !,"PATIENT",?17,"SSN",?24,"DATE INIT",?36,"WORK ORDER #",?50,"# DAYS OPEN",?68,"ITEM"
+4 WRITE !,"-------",?17,"---",?24,"---------",?36,"------------",?50,"-----------",?68,"----"
+5 QUIT
