VistA-FOIAVistA/r/AUTO_REPLENISHMENT_WARD_STO.../PSGWODPR.m

23 lines
1.8 KiB
Mathematica

PSGWODPR ;BIR/PTD,CML-PRINT AN ON-DEMAND REPORT BY DATE/AOU - CONTINUED ;05/01/91 15:01
;;2.3; Automatic Replenishment/Ward Stock ; **15** ;4 JAN 94
PRINT ;PRINT AN ON DEMAND REQUEST
S PGCT=1,ODT=0,QFLG="" I '$O(^TMP("PSGWOD",$J,0)) D HDR W !,"NO ON-DEMAND DATA FOR SELECTED DATE RANGE." Q
DTLP S ODT=$O(^TMP("PSGWOD",$J,ODT)),AOU=0 Q:'ODT
AOULP 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),"^")
DUZLP 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")
TMLP S ODTM=$O(^TMP("PSGWOD",$J,ODT,AOU,EDUZ,ODTM)),DRGNAME="" G:'ODTM DUZLP S Y=ODTM X ^DD("DD") S TMDT=Y
DRLP 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)
I $Y+5>IOSL D PRTCHK Q:QFLG D HDR
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
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
G DRLP
HDR ;PRINT REPORT MAIN HEADER
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),"^")
S Y=ODT X ^DD("DD") W !!?25,"REQUEST DATE: ",$S(Y'=0:Y,1:"NONE FOUND"),!?12,"ITEM",?62,"BACK-"
W !?36,"DT/TIME ORDERED",?56,"QTY",?62,"ORDER",! S PGCT=PGCT+1 F J=1:1:80 W "-"
Q
;
PRTCHK ;
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
Q