source: FOIAVistA/tag/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWTOT1.m@ 628

PSGWTOT1 ;BHAM ISC/PTD,CML-Print Usage Report for All Drugs for a single AOU or ALL AOUs ; 23 Mar 93 / 1:02 PM
 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
ENQ ;ENTRY POINT WHEN QUEUED
 ;CREATE ARRAY OF INVENTORY NUMBERS THAT FALL IN DATE RANGE.
 K ^TMP("PSGWUSE",$J) S INVN=0
 F J=0:0 S INVN=$O(^PSI(58.19,INVN)) Q:'INVN  S INVDT=$P($P(^PSI(58.19,INVN,0),"^"),".") I (INVDT'<BDT)&(INVDT'>EDT) S ^TMP("PSGWUSE",$J,"INV",INVN)=""
AOU I AOUFL=1 S AOU=$O(^PSI(58.1,AOU)) G:('AOU)&($D(ZTQUEUED)) PRTQUE G:'AOU PRINT
DRUG ;LOOP THROUGH DRUGS FOR AOU
 S DRGDA=0
DRGLP S DRGDA=$O(^PSI(58.1,AOU,1,DRGDA)) G:(AOUFL=0)&('DRGDA)&($D(ZTQUEUED)) PRTQUE G:(AOUFL=0)&('DRGDA) PRINT G:(AOUFL=1)&('DRGDA) AOU S DRGNM=$P(^PSI(58.1,AOU,1,DRGDA,0),"^")
 I '$O(^PSDRUG(DRGNM,0)) S DIK="^PSI(58.1,"_AOU_",1,",DA=DRGDA,DA(1)=AOU D ^DIK K DIK,DA G DRGLP
 S DRGNAME=$P(^PSDRUG(DRGNM,0),"^")
 ;
AR ;AUTOMATIC REPLENISHMENT INVENTORIES
 S (DRGQD,INVDA,ARQD,ODQD,RTQD)=0
INVLP S INVDA=$O(^PSI(58.1,AOU,1,DRGDA,1,INVDA)) G:'INVDA OD
 I $D(^TMP("PSGWUSE",$J,"INV",INVDA)) S QD=$P(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5),ARQD=ARQD+QD,DRGQD=DRGQD+QD G INVLP
 E  G INVLP
 ;
OD ;ON DEMAND REQUESTS
 S ODA=0
ODLP S ODA=$O(^PSI(58.1,AOU,1,DRGDA,5,ODA)) G:'ODA RET S ODT=$P($P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^"),".")
 I (ODT'<BDT)&(ODT'>EDT) S QD=$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2),ODQD=ODQD+QD,DRGQD=DRGQD+QD G ODLP
 E  G ODLP
 ;
RET ;RETURNS
 S RETDT=0
RETLP S RETDT=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT)) G:'RETDT SETGL
 I (RETDT'<BDT)&(RETDT'>EDT) S QD=$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2),RTQD=RTQD+QD,DRGQD=DRGQD-QD G RETLP
 E  G RETLP
 ;
SETGL S:DRGQD>0 ^TMP("PSGWUSE",$J,AOU,DRGNAME)=DRGQD_"^"_ARQD_"^"_ODQD_"^"_RTQD G DRGLP
 ;
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
 K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="PRINT^PSGWTOT1",ZTDESC="Print Usage Report",ZTDTH=$H,ZTSAVE("^TMP(""PSGWUSE"",$J,")="" F G="BDT","EDT","AOU","AOUFL","ITNAM","ITMFL","DRGNM" S:$D(@G) ZTSAVE(G)=""
 D ^%ZTLOAD G END
 ;
PRINT ;PRINT USAGE REPORT FOR ALL DRUGS BY AOU
 S AOU=0,PGCT=1,QFLG="" I '$O(^TMP("PSGWUSE",$J,AOU)) D HDR W !!,"NO USAGE FOR SELECTED DATE RANGE." G DONE
AOULP S AOU=$O(^TMP("PSGWUSE",$J,AOU)) G:'AOU DONE I PGCT>1 D PRTCHK G:QFLG END
 D:PGCT<2 HDR W !?5,"==> ",$P(^PSI(58.1,AOU,0),"^") S DRG=0 I $D(^PSI(58.1,AOU,"I")),^("I"),^("I")'>DT W "   *** INACTIVE ***"
DRLP S DRG=$O(^TMP("PSGWUSE",$J,AOU,DRG)) G:DRG="" AOULP S LOC=^TMP("PSGWUSE",$J,AOU,DRG) D:$Y+5>IOSL PRTCHK G:QFLG END W !,DRG,?42,$J($P(LOC,"^"),4),?51,$J($P(LOC,"^",2),4),?62,$J($P(LOC,"^",3),4),?72,$J($P(LOC,"^",4),4) G DRLP
 ;
DONE I $E(IOST)'="C" W @IOF
 I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
END K ^TMP("PSGWUSE",$J),AOU,AOUFL,ARQD,BDT,DRG,DRGDA,DRGNAME,DRGNM,DRGQD,EDT,INVDA,INVDT,INVN,ITMFL,ITNAM,J,LOC,ODA,ODQD,ODT,PGCT,QD,RETDT,RTQD,PSGWIO,ZTSK,ZTIO,%,%H,%I,G,DA,X,Y,ANS,QFLG
 D ^%ZISC
 S:$D(ZTQUEUED) ZTREQ="@" Q
 ;
HDR ;PRINT REPORT HEADER
 W:$Y @IOF W !,"USAGE REPORT FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,?70,"PAGE ",PGCT,!!?5,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1
 W !,"ITEM",?35,"DISPENSE QUANTITY",!?42,"TOTAL",?49,"AUTO REPL",?60,"ON DEMAND",?72,"RETURNS" S PGCT=PGCT+1
 W ! 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
 D HDR Q