PSGWAIO ;BHAM ISC/PTD,CML-AOU Inventory Outline for Selected Date Range ; 11 Aug 93 / 7:54 AM
 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
BDT S %DT="AEX",%DT("A")="BEGINNING date for report: " D ^%DT K %DT G:Y<0 END S BDT=Y
EDT S %DT="AEX",%DT(0)=BDT,%DT("A")="ENDING date for report: " D ^%DT K %DT G:Y<0 END S EDT=Y
 W !!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END
 I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^PSGWAIO",ZTDESC="Print AOU Inventory Outline" F G="BDT","EDT" S:$D(@G) ZTSAVE(G)=""
 I  D ^%ZTLOAD,HOME^%ZIS K ZTSK S QFLG=1 G DONE
 U IO
 ;
ENQ ;ENTRY POINT WHEN QUEUED
 S INVDT=(BDT-.1) K ^TMP("PSGWIO",$J)
DTLP S INVDT=$O(^PSI(58.19,"B",INVDT)),INVDA=0 G:($P(INVDT,".")>EDT)!('INVDT) PRINT
INVLP F J=0:0 S INVDA=$O(^PSI(58.19,"B",INVDT,INVDA)) G:'INVDA DTLP D BUILD
 ;
PRINT ;PRINT AOU INVENTORY OUTLINE
 S PGCT=1,AOU=0,QFLG="" D HDR I '$O(^TMP("PSGWIO",$J,0)) W !?5,"NO INVENTORIES LISTED FOR SELECTED DATES." G DONE
AOU F J=0:0 S AOU=$O(^TMP("PSGWIO",$J,AOU)),INVDT=0 G:'AOU!(QFLG) DONE D:$Y+5>IOSL PRTCHK G:QFLG DONE W !!,"==> "_$P(^PSI(58.1,AOU,0),"^") F K=0:0 S INVDT=$O(^TMP("PSGWIO",$J,AOU,INVDT)),WD=0 Q:'INVDT  D WKDT Q:QFLG
 ;
WKDT D:$Y+5>IOSL PRTCHK Q:QFLG  S Y=INVDT X ^DD("DD") W !?5,Y
 F L=0:0 S WD=$O(^TMP("PSGWIO",$J,AOU,INVDT,WD)),ID=0 Q:WD=""!(QFLG)  W ?30,WD F M=0:0 S ID=$O(^TMP("PSGWIO",$J,AOU,INVDT,WD,ID)),IDUZ=0 Q:'ID  W ?39,$J(ID,6) D DUZ Q:QFLG
 Q
 ;
DUZ F N=0:0 S IDUZ=$O(^TMP("PSGWIO",$J,AOU,INVDT,WD,ID,IDUZ)),LOC="" Q:'IDUZ!(QFLG)  S LOC=^(IDUZ),PCL=($L(LOC,",")-1) W ?51,$P(^VA(200,IDUZ,0),"^") F P=2:1:PCL D:$Y+5>IOSL PRTCHK Q:QFLG  D WRTYPE
 Q
 ;
DONE I $E(IOST)'="C" W @IOF
 I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
END K ZTSK,ANS,QFLG,AOU,BDT,EDT,ID,IDUZ,INVDA,INVDT,INVDUZ,J,K,L,LOC,M,N,P,PCL,PGCT,TYP,TYPSTR,WD,WKD,%,%I,%H,G,Y,^TMP("PSGWIO",$J),IO("Q") D ^%ZISC
 S:$D(ZTQUEUED) ZTREQ="@" Q
 ;
HDR ;PRINT REPORT MAIN HEADER
 W:$Y @IOF W !,"PHARMACY AREA OF USE INVENTORY LIST FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,!,"PRINT DATE: ",$$PSGWDT^PSGWUTL1
 W ?70,"PAGE ",PGCT S PGCT=PGCT+1 W !!,"==> AREA OF USE",!?5,"INVENTORY DATE/TIME",?27,"DAY/WEEK",?39,"INV. ID#",?51,"RESPONSIBLE PERSON",!?22,"TYPES INVENTORIED",! F J=1:1:80 W "-"
 Q
 ;
BUILD ;STORE INVENTORY DATA FOR DATE RANGE
 S WKD=$S(($P(^PSI(58.19,INVDA,0),"^",2)'=""):$P(^(0),"^",2),1:" "),INVDUZ=$S(($P(^(0),"^",3)'=""):$P(^(0),"^",3),1:" "),AOU=0
AOULP S AOU=$O(^PSI(58.19,INVDA,1,AOU)),TYP=0,TYPSTR="" Q:'AOU
TYPLP S TYP=$O(^PSI(58.19,INVDA,1,AOU,1,TYP)),TYPSTR=TYPSTR_","_TYP D:'TYP SETGL G:'TYP AOULP G TYPLP
 ;
SETGL S ^TMP("PSGWIO",$J,AOU,INVDT,WKD,INVDA,INVDUZ)=TYPSTR
 Q
 ;
WRTYPE W !?22,$S($D(^PSI(58.16,($P(LOC,",",P)),0)):$P(^(0),"^"),1:"TYPE NAME HAS BEEN DELETED IN FILE 58.16")
 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
 D HDR Q