Routine: RMPR29LP

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

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

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,"----"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29LP   1870     printed  Mar 13, 2025@21:37:06                                                                                                                                                                                                    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

RMPR29LP.m