- 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
- 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
