[613] | 1 | RMPR29LP ;HIN/RVD-PRINT LAB STOCK ISSUE PENDING COMPLETION ;2/09/1998
|
---|
| 2 | ;;3.0;PROSTHETICS;**33**;Feb 09, 1996
|
---|
| 3 | D DIV4^RMPRSIT I $D(Y),(Y<0) Q
|
---|
| 4 | ;
|
---|
| 5 | EN S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT
|
---|
| 6 | I '$D(IO("Q")) U IO G PRINT
|
---|
| 7 | K IO("Q") S ZTDESC="LAB STOCK ISSUE PENDING COMPLETION REPORT",ZTRTN="PRINT^RMPR29LP",ZTIO=IO,ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMPR(""L"")")=""
|
---|
| 8 | D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
|
---|
| 9 | ;
|
---|
| 10 | PRINT ;Entry point of printing report.
|
---|
| 11 | S RMPAGE=1,RMPRT=1,REND=0 D HEAD
|
---|
| 12 | 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
|
---|
| 13 | ;
|
---|
| 14 | EXIT ;EXIT FROM REPORT HERE
|
---|
| 15 | D ^%ZISC
|
---|
| 16 | N RMPRSITE,RMPR D KILL^XUSCLEAN
|
---|
| 17 | Q
|
---|
| 18 | ;
|
---|
| 19 | WRI ;write Lab Stock Issue Pending Completion
|
---|
| 20 | S RMPAT=$P($G(^DPT($P(R40,U,2),0)),U,1),RSSN=$P(^(0),U,9)
|
---|
| 21 | S X1=DT
|
---|
| 22 | S (RMDTIN,X2)=$P(R40,U,1) D ^%DTC S RMDTOP=X
|
---|
| 23 | S RMDATE=$E(RMDTIN,4,5)_"/"_$E(RMDTIN,6,7)_"/"_$E(RMDTIN,2,3)
|
---|
| 24 | S RMWOOR=$P(R40,U,13)
|
---|
| 25 | S RMIT=$P(R421,U,1)
|
---|
| 26 | S RMITEM=$P($G(^PRC(441,$P($G(^RMPR(661,RMIT,0)),U,1),0)),U,2)
|
---|
| 27 | I RMPRT'=I W !,$E(RMPAT,1,14),?16,$E(RSSN,6,9),?24,RMDATE,?34,RMWOOR,?55,RMDTOP,?63,$E(RMITEM,1,16)
|
---|
| 28 | I RMPRT=I W !,?63,$E(RMITEM,1,16)
|
---|
| 29 | S RMPRT=I
|
---|
| 30 | 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
|
---|
| 31 | I $Y>(IOSL-6) W @IOF D HEAD
|
---|
| 32 | Q
|
---|
| 33 | ;
|
---|
| 34 | HEAD W !,"LAB STOCK ISSUE PENDING COMPLETION",?65,"Page: ",RMPAGE,!,"for station: ",$E($P($G(^DIC(4,RMPR("STA"),0)),U,1),1,20)
|
---|
| 35 | S RMPAGE=RMPAGE+1
|
---|
| 36 | HEAD1 ;write heading
|
---|
| 37 | ;I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR W @IOF D HEAD
|
---|
| 38 | W !,RMPR("L")
|
---|
| 39 | W !,"PATIENT",?17,"SSN",?24,"DATE INIT",?36,"WORK ORDER #",?50,"# DAYS OPEN",?68,"ITEM"
|
---|
| 40 | W !,"-------",?17,"---",?24,"---------",?36,"------------",?50,"-----------",?68,"----"
|
---|
| 41 | Q
|
---|