source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWODPR.m@ 691

Last change on this file since 691 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1PSGWODPR ;BIR/PTD,CML-PRINT AN ON-DEMAND REPORT BY DATE/AOU - CONTINUED ;05/01/91 15:01
2 ;;2.3; Automatic Replenishment/Ward Stock ; **15** ;4 JAN 94
3PRINT ;PRINT AN ON DEMAND REQUEST
4 S PGCT=1,ODT=0,QFLG="" I '$O(^TMP("PSGWOD",$J,0)) D HDR W !,"NO ON-DEMAND DATA FOR SELECTED DATE RANGE." Q
5DTLP S ODT=$O(^TMP("PSGWOD",$J,ODT)),AOU=0 Q:'ODT
6AOULP S AOU=$O(^TMP("PSGWOD",$J,ODT,AOU)),EDUZ=0 G:'AOU DTLP D:PGCT>1 PRTCHK Q:QFLG D HDR W !!,"==> AREA OF USE: ",$P(^PSI(58.1,AOU,0),"^")
7DUZLP S EDUZ=$O(^TMP("PSGWOD",$J,ODT,AOU,EDUZ)),ODTM=0 G:EDUZ="" AOULP W !!?6,"ENTERED BY: ",$S(+EDUZ'=0:$P(^VA(200,EDUZ,0),"^"),1:"UNKNOWN")
8TMLP S ODTM=$O(^TMP("PSGWOD",$J,ODT,AOU,EDUZ,ODTM)),DRGNAME="" G:'ODTM DUZLP S Y=ODTM X ^DD("DD") S TMDT=Y
9DRLP S DRGNAME=$O(^TMP("PSGWOD",$J,ODT,AOU,EDUZ,ODTM,DRGNAME)) G:DRGNAME="" TMLP S LOC=^(DRGNAME),QD=$P(LOC,"^"),STAN=$P(LOC,"^",2),DRGDA=$P(LOC,"^",3),BOTOT=$P(LOC,"^",4),LEDUZ=$P(LOC,"^",5),LEDT=$P(LOC,"^",6)
10 I $Y+5>IOSL D PRTCHK Q:QFLG D HDR
11 I +LEDUZ W !?6,"Next Item LAST EDITED BY: ",$S($D(^VA(200,LEDUZ,0)):$P(^(0),"^"),1:"UNKNOWN") I +LEDT S Y=LEDT X ^DD("DD") W " on ",Y
12 W !,DRGNAME,!?36,TMDT,?55,$J(QD,4),?62,$S(BOTOT>0:$J(BOTOT,4),1:""),?68,$S(STAN'=1:"*Std. Stock",1:"") I $D(^PSI(58.1,AOU,1,DRGDA,"EXP")),+^("EXP") S Y=+^("EXP") X ^DD("DD") W !?2,"Expiration Date: ",Y
13 G DRLP
14HDR ;PRINT REPORT MAIN HEADER
15 D NOW^%DTC S Y=$P(%,".") X ^DD("DD") W:$Y @IOF W !,"ON DEMAND REQUEST LIST BY DATE",?50,"DATE: ",Y,?70,"PAGE: ",PGCT I $D(SEL),SEL="I",$D(IGDA) W !,"FOR INVENTORY GROUP - ",$P(^PSI(58.2,IGDA,0),"^")
16 S Y=ODT X ^DD("DD") W !!?25,"REQUEST DATE: ",$S(Y'=0:Y,1:"NONE FOUND"),!?12,"ITEM",?62,"BACK-"
17 W !?36,"DT/TIME ORDERED",?56,"QTY",?62,"ORDER",! S PGCT=PGCT+1 F J=1:1:80 W "-"
18 Q
19 ;
20PRTCHK ;
21 I $E(IOST)="C" W !!,"Press <RETURN> to Continue or ""^"" to Exit: " R ANS:DTIME S:'$T ANS="^" D:ANS?1."?" HELP^PSGWUTL1 I ANS="^" S QFLG=1
22 Q
Note: See TracBrowser for help on using the repository browser.