PSGWODPR ;BIR/PTD,CML-PRINT AN ON-DEMAND REPORT BY DATE/AOU - CONTINUED ;Oct 17, 2017@14:48
;;2.3;Automatic Replenishment/Ward Stock;**15,19**;4 JAN 94;Build 45
PRINT ;PRINT AN ON DEMAND REQUEST
N PSGWPFLG S PSGWPFLG=0 I $$GET^XPAR("ALL","PSGW_WS_LVL_ON") S PSGWPFLG=1 ; Patch PSGW*2.3*19 are changes active
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:"")
S Y="" I $D(^PSI(58.1,AOU,1,DRGDA,"EXP")),+^("EXP") S Y=+^("EXP") X ^DD("DD") W !?2,"Expiration Date: ",Y
I PSGWPFLG W:Y="" ! W ?30,"STOCK LEVEL: ",$G(^TMP("PSGWOD",$J,"ARCHSTOCK",ODT,AOU,EDUZ,ODTM,DRGNAME))
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWODPR 2152 printed Dec 13, 2024@01:39:39 Page 2
PSGWODPR ;BIR/PTD,CML-PRINT AN ON-DEMAND REPORT BY DATE/AOU - CONTINUED ;Oct 17, 2017@14:48
+1 ;;2.3;Automatic Replenishment/Ward Stock;**15,19**;4 JAN 94;Build 45
PRINT ;PRINT AN ON DEMAND REQUEST
+1 ; Patch PSGW*2.3*19 are changes active
NEW PSGWPFLG
SET PSGWPFLG=0
IF $$GET^XPAR("ALL","PSGW_WS_LVL_ON")
SET PSGWPFLG=1
+2 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:"")
+4 SET Y=""
IF $DATA(^PSI(58.1,AOU,1,DRGDA,"EXP"))
IF +^("EXP")
SET Y=+^("EXP")
XECUTE ^DD("DD")
WRITE !?2,"Expiration Date: ",Y
+5 IF PSGWPFLG
if Y=""
WRITE !
WRITE ?30,"STOCK LEVEL: ",$GET(^TMP("PSGWOD",$JOB,"ARCHSTOCK",ODT,AOU,EDUZ,ODTM,DRGNAME))
+6 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
