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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWTOT1 3406 printed Apr 09, 2024@20:44:50 Page 2
PSGWTOT1 ;BHAM ISC/PTD,CML-Print Usage Report for All Drugs for a single AOU or ALL AOUs ; 23 Mar 93 / 1:02 PM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
ENQ ;ENTRY POINT WHEN QUEUED
+1 ;CREATE ARRAY OF INVENTORY NUMBERS THAT FALL IN DATE RANGE.
+2 KILL ^TMP("PSGWUSE",$JOB)
SET INVN=0
+3 FOR J=0:0
SET INVN=$ORDER(^PSI(58.19,INVN))
if 'INVN
QUIT
SET INVDT=$PIECE($PIECE(^PSI(58.19,INVN,0),"^"),".")
IF (INVDT'<BDT)&(INVDT'>EDT)
SET ^TMP("PSGWUSE",$JOB,"INV",INVN)=""
AOU IF AOUFL=1
SET AOU=$ORDER(^PSI(58.1,AOU))
if ('AOU)&($DATA(ZTQUEUED))
GOTO PRTQUE
if 'AOU
GOTO PRINT
DRUG ;LOOP THROUGH DRUGS FOR AOU
+1 SET DRGDA=0
DRGLP SET DRGDA=$ORDER(^PSI(58.1,AOU,1,DRGDA))
if (AOUFL=0)&('DRGDA)&($DATA(ZTQUEUED))
GOTO PRTQUE
if (AOUFL=0)&('DRGDA)
GOTO PRINT
if (AOUFL=1)&('DRGDA)
GOTO AOU
SET DRGNM=$PIECE(^PSI(58.1,AOU,1,DRGDA,0),"^")
+1 IF '$ORDER(^PSDRUG(DRGNM,0))
SET DIK="^PSI(58.1,"_AOU_",1,"
SET DA=DRGDA
SET DA(1)=AOU
DO ^DIK
KILL DIK,DA
GOTO DRGLP
+2 SET DRGNAME=$PIECE(^PSDRUG(DRGNM,0),"^")
+3 ;
AR ;AUTOMATIC REPLENISHMENT INVENTORIES
+1 SET (DRGQD,INVDA,ARQD,ODQD,RTQD)=0
INVLP SET INVDA=$ORDER(^PSI(58.1,AOU,1,DRGDA,1,INVDA))
if 'INVDA
GOTO OD
+1 IF $DATA(^TMP("PSGWUSE",$JOB,"INV",INVDA))
SET QD=$PIECE(^PSI(58.1,AOU,1,DRGDA,1,INVDA,0),"^",5)
SET ARQD=ARQD+QD
SET DRGQD=DRGQD+QD
GOTO INVLP
+2 IF '$TEST
GOTO INVLP
+3 ;
OD ;ON DEMAND REQUESTS
+1 SET ODA=0
ODLP SET ODA=$ORDER(^PSI(58.1,AOU,1,DRGDA,5,ODA))
if 'ODA
GOTO RET
SET ODT=$PIECE($PIECE(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^"),".")
+1 IF (ODT'<BDT)&(ODT'>EDT)
SET QD=$PIECE(^PSI(58.1,AOU,1,DRGDA,5,ODA,0),"^",2)
SET ODQD=ODQD+QD
SET DRGQD=DRGQD+QD
GOTO ODLP
+2 IF '$TEST
GOTO ODLP
+3 ;
RET ;RETURNS
+1 SET RETDT=0
RETLP SET RETDT=$ORDER(^PSI(58.1,AOU,1,DRGDA,3,RETDT))
if 'RETDT
GOTO SETGL
+1 IF (RETDT'<BDT)&(RETDT'>EDT)
SET QD=$PIECE(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2)
SET RTQD=RTQD+QD
SET DRGQD=DRGQD-QD
GOTO RETLP
+2 IF '$TEST
GOTO RETLP
+3 ;
SETGL if DRGQD>0
SET ^TMP("PSGWUSE",$JOB,AOU,DRGNAME)=DRGQD_"^"_ARQD_"^"_ODQD_"^"_RTQD
GOTO DRGLP
+1 ;
PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT
+1 KILL ZTSAVE,ZTIO
SET ZTIO=PSGWIO
SET ZTRTN="PRINT^PSGWTOT1"
SET ZTDESC="Print Usage Report"
SET ZTDTH=$HOROLOG
SET ZTSAVE("^TMP(""PSGWUSE"",$J,")=""
FOR G="BDT","EDT","AOU","AOUFL","ITNAM","ITMFL","DRGNM"
if $DATA(@G)
SET ZTSAVE(G)=""
+2 DO ^%ZTLOAD
GOTO END
+3 ;
PRINT ;PRINT USAGE REPORT FOR ALL DRUGS BY AOU
+1 SET AOU=0
SET PGCT=1
SET QFLG=""
IF '$ORDER(^TMP("PSGWUSE",$JOB,AOU))
DO HDR
WRITE !!,"NO USAGE FOR SELECTED DATE RANGE."
GOTO DONE
AOULP SET AOU=$ORDER(^TMP("PSGWUSE",$JOB,AOU))
if 'AOU
GOTO DONE
IF PGCT>1
DO PRTCHK
if QFLG
GOTO END
+1 if PGCT<2
DO HDR
WRITE !?5,"==> ",$PIECE(^PSI(58.1,AOU,0),"^")
SET DRG=0
IF $DATA(^PSI(58.1,AOU,"I"))
IF ^("I")
IF ^("I")'>DT
WRITE " *** INACTIVE ***"
DRLP SET DRG=$ORDER(^TMP("PSGWUSE",$JOB,AOU,DRG))
if DRG=""
GOTO AOULP
SET LOC=^TMP("PSGWUSE",$JOB,AOU,DRG)
if $Y+5>IOSL
DO PRTCHK
if QFLG
GOTO END
WRITE !,DRG,?42,$JUSTIFY($PIECE(LOC,"^"),4),?51,$JUSTIFY($PIECE(LOC,"^",2),4),?62,$JUSTIFY($PIECE(LOC,"^",3),4),?72,$JUSTIFY($PIECE(LOC,"^",4),4)
GOTO DRLP
+1 ;
DONE IF $EXTRACT(IOST)'="C"
WRITE @IOF
+1 IF $EXTRACT(IOST)="C"
if 'QFLG
DO SS^PSGWUTL1
END KILL ^TMP("PSGWUSE",$JOB),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
+1 DO ^%ZISC
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 ;
HDR ;PRINT REPORT HEADER
+1 if $Y
WRITE @IOF
WRITE !,"USAGE REPORT FROM "
SET Y=BDT
XECUTE ^DD("DD")
WRITE Y," TO "
SET Y=EDT
XECUTE ^DD("DD")
WRITE Y,?70,"PAGE ",PGCT,!!?5,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1
+2 WRITE !,"ITEM",?35,"DISPENSE QUANTITY",!?42,"TOTAL",?49,"AUTO REPL",?60,"ON DEMAND",?72,"RETURNS"
SET PGCT=PGCT+1
+3 WRITE !
FOR J=1:1:80
WRITE "-"
+4 QUIT
PRTCHK ;
+1 IF $EXTRACT(IOST)="C"
WRITE !!,"Press <RETURN> to Continue or ""^"" to Exit: "
READ ANS:DTIME
if '$TEST
SET ANS="^"
if ANS?1."?"
DO HELP^PSGWUTL1
IF ANS="^"
SET QFLG=1
QUIT
+2 DO HDR
QUIT
