- 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
- PSGWODPR ;BIR/PTD,CML-PRINT AN ON-DEMAND REPORT BY DATE/AOU - CONTINUED ;05/01/91 15:01
- +1 ;;2.3; Automatic Replenishment/Ward Stock ; **15** ;4 JAN 94
- PRINT ;PRINT AN ON DEMAND REQUEST
- +1 SET PGCT=1
- SET ODT=0
- SET QFLG=""
- IF '$ORDER(^TMP("PSGWOD",$JOB,0))
- DO HDR
- WRITE !,"NO ON-DEMAND DATA FOR SELECTED DATE RANGE."
- QUIT
- DTLP SET ODT=$ORDER(^TMP("PSGWOD",$JOB,ODT))
- SET AOU=0
- IF 'ODT
- QUIT
- AOULP SET AOU=$ORDER(^TMP("PSGWOD",$JOB,ODT,AOU))
- SET EDUZ=0
- IF 'AOU
- GOTO DTLP
- IF PGCT>1
- DO PRTCHK
- IF QFLG
- QUIT
- DO HDR
- WRITE !!,"==> AREA OF USE: ",$PIECE(^PSI(58.1,AOU,0),"^")
- DUZLP SET EDUZ=$ORDER(^TMP("PSGWOD",$JOB,ODT,AOU,EDUZ))
- SET ODTM=0
- IF EDUZ=""
- GOTO AOULP
- WRITE !!?6,"ENTERED BY: ",$SELECT(+EDUZ'=0:$PIECE(^VA(200,EDUZ,0),"^"),1:"UNKNOWN")
- TMLP SET ODTM=$ORDER(^TMP("PSGWOD",$JOB,ODT,AOU,EDUZ,ODTM))
- SET DRGNAME=""
- IF 'ODTM
- GOTO DUZLP
- SET Y=ODTM
- XECUTE ^DD("DD")
- SET TMDT=Y
- DRLP SET DRGNAME=$ORDER(^TMP("PSGWOD",$JOB,ODT,AOU,EDUZ,ODTM,DRGNAME))
- IF DRGNAME=""
- GOTO TMLP
- SET LOC=^(DRGNAME)
- SET QD=$PIECE(LOC,"^")
- SET STAN=$PIECE(LOC,"^",2)
- SET DRGDA=$PIECE(LOC,"^",3)
- SET BOTOT=$PIECE(LOC,"^",4)
- SET LEDUZ=$PIECE(LOC,"^",5)
- SET LEDT=$PIECE(LOC,"^",6)
- +1 IF $Y+5>IOSL
- DO PRTCHK
- IF QFLG
- QUIT
- DO HDR
- +2 IF +LEDUZ
- WRITE !?6,"Next Item LAST EDITED BY: ",$SELECT($DATA(^VA(200,LEDUZ,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- IF +LEDT
- SET Y=LEDT
- XECUTE ^DD("DD")
- WRITE " on ",Y
- +3 WRITE !,DRGNAME,!?36,TMDT,?55,$JUSTIFY(QD,4),?62,$SELECT(BOTOT>0:$JUSTIFY(BOTOT,4),1:""),?68,$SELECT(STAN'=1:"*Std. Stock",1:"")
- IF $DATA(^PSI(58.1,AOU,1,DRGDA,"EXP"))
- IF +^("EXP")
- SET Y=+^("EXP")
- XECUTE ^DD("DD")
- WRITE !?2,"Expiration Date: ",Y
- +4 GOTO DRLP
- HDR ;PRINT REPORT MAIN HEADER
- +1 DO NOW^%DTC
- SET Y=$PIECE(%,".")
- XECUTE ^DD("DD")
- IF $Y
- WRITE @IOF
- WRITE !,"ON DEMAND REQUEST LIST BY DATE",?50,"DATE: ",Y,?70,"PAGE: ",PGCT
- IF $DATA(SEL)
- IF SEL="I"
- IF $DATA(IGDA)
- WRITE !,"FOR INVENTORY GROUP - ",$PIECE(^PSI(58.2,IGDA,0),"^")
- +2 SET Y=ODT
- XECUTE ^DD("DD")
- WRITE !!?25,"REQUEST DATE: ",$SELECT(Y'=0:Y,1:"NONE FOUND"),!?12,"ITEM",?62,"BACK-"
- +3 WRITE !?36,"DT/TIME ORDERED",?56,"QTY",?62,"ORDER",!
- SET PGCT=PGCT+1
- FOR J=1:1:80
- WRITE "-"
- +4 QUIT
- +5 ;
- PRTCHK ;
- +1 IF $EXTRACT(IOST)="C"
- WRITE !!,"Press <RETURN> to Continue or ""^"" to Exit: "
- READ ANS:DTIME
- IF '$TEST
- SET ANS="^"
- IF ANS?1."?"
- DO HELP^PSGWUTL1
- IF ANS="^"
- SET QFLG=1
- +2 QUIT
