PSGWODPR.m

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