PSGWTOT2 ;BHAM ISC/PTD,CML-Print Usage Report for Single Drug for One or ALL AOUs ; 23 Mar 93 / 1:03 PM ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94 ENQ ;ENTRY POINT WHEN QUEUED. K ^TMP("PSGWUSE",$J) AOULP I AOUFL=1 S AOU=$O(^PSI(58.1,AOU)) G:('AOU)&($D(ZTQUEUED)) PRTQUE G:'AOU PRINT S DRGDA=0 DRG S DRGDA=$O(^PSI(58.1,AOU,1,"B",DRGNM,DRGDA)) G:(AOUFL=0)&('DRGDA)&($D(ZTQUEUED)) PRTQUE G:(AOUFL=0)&('DRGDA) PRINT G:(AOUFL=1)&('DRGDA) AOULP ; AR ;INVENTORIES S INVDA=0 INVLP S INVDA=$O(^PSI(58.1,AOU,1,DRGDA,1,INVDA)) G:'INVDA OD S INVDT=$S($D(^PSI(58.19,INVDA,0)):$P(^(0),"^"),1:"") I 'INVDT,'$D(^PSI(58.19,INVDA,0)) S DIE="^PSI(58.1,AOU,1,DRGDA,1,",DA=INVDA,DA(1)=DRGDA,DA(2)=AOU,DR=".01///@" D ^DIE K DIE G INVLP I ($P(INVDT,".")'EDT) S:$P(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5)'="" ^TMP("PSGWUSE",$J,AOU,"AR",INVDT)=$P(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5) G INVLP ; OD ;ON DEMANDS S ODA=0 ODLP S ODA=$O(^PSI(58.1,AOU,1,DRGDA,5,ODA)) G:'ODA RET S ODT=$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^") I ($P(ODT,".")'EDT) S:$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2)'="" ^TMP("PSGWUSE",$J,AOU,"OD",ODT)=$P(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2) G ODLP ; RET ;RETURNS S RETDT=0 RETLP S RETDT=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT)) G:'RETDT DRG I (RETDT'EDT) S:$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2)'="" ^TMP("PSGWUSE",$J,AOU,"RT",RETDT)=$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2) G RETLP ; PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="PRINT^PSGWTOT2",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 SINGLE DRUG BY AOU S (AOU,GRTOT)=0,PGCT=1,QFLG="" I '$O(^TMP("PSGWUSE",$J,AOU)) D HDR W !!?10,"NO USAGE FOR ",ITNAM," FOR SELECTED DATES." G DONE D HDR AOU S (DRGQD,ARQD,ODQD,RTQD,QD,TYP)=0 S AOU=$O(^TMP("PSGWUSE",$J,AOU)) D:('AOU)&(AOUFL=1) GRTOT G:QFLG END G:'AOU DONE D SUB G:QFLG END TYP S TYP=$O(^TMP("PSGWUSE",$J,AOU,TYP)),INVDT=0 D:TYP="" TOTAL G:QFLG END G:TYP="" AOU D:$Y+5>IOSL PRTCHK G:QFLG END W:TYP="AR" !?10,"AUTO REPLENISHMENT" W:TYP="OD" !?10,"ON DEMAND" W:TYP="RT" !?10,"RETURNS" DT S INVDT=$O(^TMP("PSGWUSE",$J,AOU,TYP,INVDT)) G:'INVDT SUBTOT S QD=$P(^TMP("PSGWUSE",$J,AOU,TYP,INVDT),"^") I TYP="AR" S ARQD=ARQD+QD,DRGQD=DRGQD+QD I TYP="OD" S ODQD=ODQD+QD,DRGQD=DRGQD+QD I TYP="RT" S RTQD=RTQD+QD,DRGQD=DRGQD-QD D:$Y+5>IOSL PRTCHK G:QFLG END D WRTLN G DT ; DONE I $E(IOST)'="C" W @IOF I $E(IOST)="C" D:'QFLG SS^PSGWUTL1 END K ^TMP("PSGWUSE",$J),AOU,AOUFL,ARQD,BDT,DRGDA,ANS,QFLG,DRGNM,DRGQD,EDT,INVDA,INVDT,ITMFL,ITNAM,J,GRTOT,ODA,ODT,ODQD,PGCT,QD,RETDT,RTQD,TYP,PSGWIO,PSGWION,ZTSK,ZTIO,%,%H,%I,DA,G,X,Y,DA,DR D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q ; HDR ; 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 S PGCT=PGCT+1 W !?5,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1,!,"ITEM",?15,"INVENTORY DATE",?35,"DISPENSE QUANTITY",! F J=1:1:80 W "-" Q SUB ; I $Y+5>IOSL D PRTCHK I QFLG Q W !!?5,"==> ",$P(^PSI(58.1,AOU,0),"^"),!,ITNAM,!! Q ; WRTLN S Y=INVDT X ^DD("DD") W !?15,$P(Y,"@")," ",$P(Y,"@",2),?43,$J(QD,4) Q SUBTOT ; I $Y+5>IOSL D PRTCHK I QFLG Q W !?43,"-----" W:TYP="AR" !?12,"SUBTOTAL AUTO REPL.",?40,"+",?43,$J(ARQD,4),! W:TYP="OD" !?12,"SUBTOTAL ON DEMAND",?40,"+",?43,$J(ODQD,4),! W:TYP="RT" !?12,"SUBTOTAL RETURNS",?40,"-",?43,$J(RTQD,4),! G TYP ; TOTAL W !?42,"=======",!,"TOTAL DISPENSED",?43,$J(DRGQD,4) S GRTOT=GRTOT+DRGQD Q GRTOT ; I $Y+5>IOSL D PRTCHK I QFLG Q W !!?38 F J=1:1:15 W "=" W !,"TOTAL USAGE FOR ALL AREAS IS:",?43,$J(GRTOT,4) Q PRTCHK ; I $E(IOST)="C" W !!,"Press 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