PSGWATR1 ;BHAM ISC/CML-Print Item Activity Inquiry (80 column) ; 23 Mar 93 / 12:44 PM
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
S (PG,QFLG)=0,Y=BDT X ^DD("DD") S HBDT=Y,Y=EDT X ^DD("DD") S HEDT=Y S HDT=$$PSGWDT^PSGWUTL1,$P(LN,"-",80)="",DRGDA=+^PSI(58.1,AOU,1,ITEM,0),$P(LN2,"-",65)="" D INV I 'QFLG D OND I 'QFLG D RET
DONE I $E(IOST)'="C" W @IOF
I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
QUIT K ^TMP("PSGWATR",$J) K ZTSK,%,%H,%I,%W,ADT,ANS,AOU,ARDT,BDT,C,DRGDA,EDT,HBDT,HDT,HEDT,INVDA,ITEM,LN,LN2,NODE,OD,ODDA,ODDT,PG,QD,QFLG,RET,RETDT,TYPE,X,Y,G,PSGWIO
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@" Q
INV ;PRINT INVENTORIES
D HDR,IHDR I '$O(^TMP("PSGWATR",$J,"AR",0)) W !?15,"** THERE IS NO INVENTORY DATA FOR THIS DATE RANGE **" Q
F ADT=0:0 S ADT=$O(^TMP("PSGWATR",$J,"AR",ADT)) Q:'ADT S NODE=^(ADT),QFLG=0 D:$Y+5>IOSL PRTCHK Q:QFLG D:$Y+5>IOSL HDR,IHDR W !?15,"ID #",+NODE," - " S Y=ADT X ^DD("DD") W Y,?60,$J($P(NODE,"^",2),7)
Q
OND ;PRINT ON-DEMANDS
D PRTCHK Q:QFLG D HDR,OHDR I '$O(^TMP("PSGWATR",$J,"OD",0)) W !?15,"** THERE IS NO ON-DEMAND DATA FOR THIS DATE RANGE **" Q
F OD=0:0 S OD=$O(^TMP("PSGWATR",$J,"OD",OD)) Q:'OD S QD=+^(OD),QFLG=0 D:$Y+5>IOSL PRTCHK Q:QFLG D:$Y+5>IOSL HDR,OHDR S Y=OD X ^DD("DD") W !?17,Y,?60,$J(QD,7)
Q
RET ;PRINT RETURNS
D PRTCHK Q:QFLG D HDR,RHDR I '$O(^TMP("PSGWATR",$J,"RET",0)) W !?15,"** THERE IS NO RETURNS DATA FOR THIS DATE RANGE **" Q
F RET=0:0 S RET=$O(^TMP("PSGWATR",$J,"RET",RET)) Q:'RET S QD=+^(RET),QFLG=0 D:$Y+5>IOSL PRTCHK Q:QFLG D:$Y+5>IOSL HDR,RHDR S Y=RET X ^DD("DD") W !?17,Y,?60,$J(QD,7)
Q
HDR ;
S PG=PG+1 W:$Y @IOF W !,"ITEM ACTIVITY INQUIRY for period ",HBDT," to ",HEDT,?72,"Page: ",PG,!,"Printed ",HDT,!!,"AOU : ",$P(^PSI(58.1,AOU,0),"^"),!,"ITEM: ",$P(^PSDRUG(DRGDA,0),"^"),!,LN Q
PRTCHK ;
I $E(IOST)="C" W !!,"Press <RETURN> to Continue or ""^"" to Exit: " R ANS:DTIME S:'$T ANS="^" D:ANS["?" HELP^PSGWUTL1 I ANS="^" S QFLG=1 Q
Q
IHDR ;INVENTORY SUBHEADER
W !,"INVENTORIES:",!!?15,"ID # - DATE/TIME FOR INVENTORY",?55,"QUANTITY DISPENSED",!?15,LN2 Q
OHDR ;ON-DEMAND HEADERS
W !,"ON-DEMAND REQUESTS:",!!?15,"ON-DEMAND REQUEST DATE/TIME",?55,"QUANTITY DISPENSED",!?15,LN2 Q
RHDR ;RETURNS HEADER
W !,"RETURNS:",!!?15,"RETURN DATE/TIME",?55,"QUANTITY RETURNED",!?15,LN2 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWATR1 2285 printed Nov 22, 2024@16:49:04 Page 2
PSGWATR1 ;BHAM ISC/CML-Print Item Activity Inquiry (80 column) ; 23 Mar 93 / 12:44 PM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
+2 SET (PG,QFLG)=0
SET Y=BDT
XECUTE ^DD("DD")
SET HBDT=Y
SET Y=EDT
XECUTE ^DD("DD")
SET HEDT=Y
SET HDT=$$PSGWDT^PSGWUTL1
SET $PIECE(LN,"-",80)=""
SET DRGDA=+^PSI(58.1,AOU,1,ITEM,0)
SET $PIECE(LN2,"-",65)=""
DO INV
IF 'QFLG
DO OND
IF 'QFLG
DO RET
DONE IF $EXTRACT(IOST)'="C"
WRITE @IOF
+1 IF $EXTRACT(IOST)="C"
if 'QFLG
DO SS^PSGWUTL1
QUIT KILL ^TMP("PSGWATR",$JOB)
KILL ZTSK,%,%H,%I,%W,ADT,ANS,AOU,ARDT,BDT,C,DRGDA,EDT,HBDT,HDT,HEDT,INVDA,ITEM,LN,LN2,NODE,OD,ODDA,ODDT,PG,QD,QFLG,RET,RETDT,TYPE,X,Y,G,PSGWIO
+1 DO ^%ZISC
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
INV ;PRINT INVENTORIES
+1 DO HDR
DO IHDR
IF '$ORDER(^TMP("PSGWATR",$JOB,"AR",0))
WRITE !?15,"** THERE IS NO INVENTORY DATA FOR THIS DATE RANGE **"
QUIT
+2 FOR ADT=0:0
SET ADT=$ORDER(^TMP("PSGWATR",$JOB,"AR",ADT))
if 'ADT
QUIT
SET NODE=^(ADT)
SET QFLG=0
if $Y+5>IOSL
DO PRTCHK
if QFLG
QUIT
if $Y+5>IOSL
DO HDR
DO IHDR
WRITE !?15,"ID #",+NODE," - "
SET Y=ADT
XECUTE ^DD("DD")
WRITE Y,?60,$JUSTIFY($PIECE(NODE,"^",2),7)
+3 QUIT
OND ;PRINT ON-DEMANDS
+1 DO PRTCHK
if QFLG
QUIT
DO HDR
DO OHDR
IF '$ORDER(^TMP("PSGWATR",$JOB,"OD",0))
WRITE !?15,"** THERE IS NO ON-DEMAND DATA FOR THIS DATE RANGE **"
QUIT
+2 FOR OD=0:0
SET OD=$ORDER(^TMP("PSGWATR",$JOB,"OD",OD))
if 'OD
QUIT
SET QD=+^(OD)
SET QFLG=0
if $Y+5>IOSL
DO PRTCHK
if QFLG
QUIT
if $Y+5>IOSL
DO HDR
DO OHDR
SET Y=OD
XECUTE ^DD("DD")
WRITE !?17,Y,?60,$JUSTIFY(QD,7)
+3 QUIT
RET ;PRINT RETURNS
+1 DO PRTCHK
if QFLG
QUIT
DO HDR
DO RHDR
IF '$ORDER(^TMP("PSGWATR",$JOB,"RET",0))
WRITE !?15,"** THERE IS NO RETURNS DATA FOR THIS DATE RANGE **"
QUIT
+2 FOR RET=0:0
SET RET=$ORDER(^TMP("PSGWATR",$JOB,"RET",RET))
if 'RET
QUIT
SET QD=+^(RET)
SET QFLG=0
if $Y+5>IOSL
DO PRTCHK
if QFLG
QUIT
if $Y+5>IOSL
DO HDR
DO RHDR
SET Y=RET
XECUTE ^DD("DD")
WRITE !?17,Y,?60,$JUSTIFY(QD,7)
+3 QUIT
HDR ;
+1 SET PG=PG+1
if $Y
WRITE @IOF
WRITE !,"ITEM ACTIVITY INQUIRY for period ",HBDT," to ",HEDT,?72,"Page: ",PG,!,"Printed ",HDT,!!,"AOU : ",$PIECE(^PSI(58.1,AOU,0),"^"),!,"ITEM: ",$PIECE(^PSDRUG(DRGDA,0),"^"),!,LN
QUIT
PRTCHK ;
+1 IF $EXTRACT(IOST)="C"
WRITE !!,"Press <RETURN> to Continue or ""^"" to Exit: "
READ ANS:DTIME
if '$TEST
SET ANS="^"
if ANS["?"
DO HELP^PSGWUTL1
IF ANS="^"
SET QFLG=1
QUIT
+2 QUIT
IHDR ;INVENTORY SUBHEADER
+1 WRITE !,"INVENTORIES:",!!?15,"ID # - DATE/TIME FOR INVENTORY",?55,"QUANTITY DISPENSED",!?15,LN2
QUIT
OHDR ;ON-DEMAND HEADERS
+1 WRITE !,"ON-DEMAND REQUESTS:",!!?15,"ON-DEMAND REQUEST DATE/TIME",?55,"QUANTITY DISPENSED",!?15,LN2
QUIT
RHDR ;RETURNS HEADER
+1 WRITE !,"RETURNS:",!!?15,"RETURN DATE/TIME",?55,"QUANTITY RETURNED",!?15,LN2
QUIT
