PSGWTOT ;BHAM ISC/PTD,CML-Usage Report for an Item ; 19 Mar 93 / 8:35 AM
;;2.3; Automatic Replenishment/Ward Stock ;**16**;4 JAN 94
W !,"Usage Report may be printed for:",!?15,"a single item for one AOU,",!?15,"a single item for ALL AOUs,",!?15,"ALL items for one AOU, or",!?15,"ALL items for ALL AOUs.",!!
W !,"To select all AOUs, enter ""^ALL"" at the",!,"""Select PHARMACY AOU STOCK AREA OF USE (AOU):"" prompt.",!,"To select all items, enter ""^ALL"" at the ""Select ITEM:"" prompt.",!!
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
ASKAOU S DIC="^PSI(58.1,",DIC(0)="QEAM" D ^DIC K DIC G:(Y<0)&(X'="^ALL") END
I X'="^ALL" S AOU=+Y,AOUFL=0
E S AOU=0,AOUFL=1
ASKITEM I AOUFL=1 S DIC="^PSDRUG(",DIC(0)="QEAOM",DIC("A")="Select ITEM: ",DIC("S")="I $S('$D(^(""I"")):1,+^(""I"")>DT:1,1:0)" D ^DIC K DIC G:(Y<0)&(X'="^ALL") END S:X'="^ALL" ITNAM=$P(Y,"^",2),ITMFL=0,DRGNM=$P(Y,"^")
;VMP IOFO BAY PINES;ELR;PSGW*2.3*16
I AOUFL=0 S DIC="^PSI(58.1,AOU,1,",DIC(0)="QEAM",D="B" D IX^DIC K DIC G:(Y<0)&(X'="^ALL") END S:X'="^ALL" ITMFL=0,DRGNM=$P(Y,"^",2)
I (AOUFL=0)&(X'="^ALL") I '$O(^PSDRUG(DRGNM,0)) S DIK="^PSI(58.1,"_AOU_",1,",DA=$P(Y,"^"),DA(1)=AOU D ^DIK K DIK W " ??",*7,*7 G ASKITEM
I (AOUFL=0)&(X'="^ALL") S ITNAM=$P(^PSDRUG(DRGNM,0),"^")
I X="^ALL" S ITNAM=0,ITMFL=1
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 PSGWIO=ION,ZTIO="" K ZTSAVE,ZTDTH,ZTSK S ZTRTN=$S(ITMFL=1:"ENQ^PSGWTOT1",1:"ENQ^PSGWTOT2"),ZTDESC="Compile Usage Report" F G="BDT","EDT","AOU","AOUFL","ITNAM","ITMFL","DRGNM","PSGWIO" S:$D(@G) ZTSAVE(G)=""
I D ^%ZTLOAD,HOME^%ZIS K ZTSK G END
U IO G:ITMFL=1 ENQ^PSGWTOT1 G:ITMFL=0 ENQ^PSGWTOT2
;
END K AOU,AOUFL,BDT,DRGNM,EDT,ITNAM,ITMFL,PSGWIO,G,ZTIO,ZTSK,DA,X,Y,IO("Q")
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWTOT 2089 printed Dec 13, 2024@01:40:10 Page 2
PSGWTOT ;BHAM ISC/PTD,CML-Usage Report for an Item ; 19 Mar 93 / 8:35 AM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;**16**;4 JAN 94
+2 WRITE !,"Usage Report may be printed for:",!?15,"a single item for one AOU,",!?15,"a single item for ALL AOUs,",!?15,"ALL items for one AOU, or",!?15,"ALL items for ALL AOUs.",!!
+3 WRITE !,"To select all AOUs, enter ""^ALL"" at the",!,"""Select PHARMACY AOU STOCK AREA OF USE (AOU):"" prompt.",!,"To select all items, enter ""^ALL"" at the ""Select ITEM:"" prompt.",!!
BDT SET %DT="AEX"
SET %DT("A")="BEGINNING date for report: "
DO ^%DT
KILL %DT
if Y<0
GOTO END
SET BDT=Y
EDT SET %DT="AEX"
SET %DT(0)=BDT
SET %DT("A")="ENDING date for report: "
DO ^%DT
KILL %DT
if Y<0
GOTO END
SET EDT=Y
ASKAOU SET DIC="^PSI(58.1,"
SET DIC(0)="QEAM"
DO ^DIC
KILL DIC
if (Y<0)&(X'="^ALL")
GOTO END
+1 IF X'="^ALL"
SET AOU=+Y
SET AOUFL=0
+2 IF '$TEST
SET AOU=0
SET AOUFL=1
ASKITEM IF AOUFL=1
SET DIC="^PSDRUG("
SET DIC(0)="QEAOM"
SET DIC("A")="Select ITEM: "
SET DIC("S")="I $S('$D(^(""I"")):1,+^(""I"")>DT:1,1:0)"
DO ^DIC
KILL DIC
if (Y<0)&(X'="^ALL")
GOTO END
if X'="^ALL"
SET ITNAM=$PIECE(Y,"^",2)
SET ITMFL=0
SET DRGNM=$PIECE(Y,"^")
+1 ;VMP IOFO BAY PINES;ELR;PSGW*2.3*16
+2 IF AOUFL=0
SET DIC="^PSI(58.1,AOU,1,"
SET DIC(0)="QEAM"
SET D="B"
DO IX^DIC
KILL DIC
if (Y<0)&(X'="^ALL")
GOTO END
if X'="^ALL"
SET ITMFL=0
SET DRGNM=$PIECE(Y,"^",2)
+3 IF (AOUFL=0)&(X'="^ALL")
IF '$ORDER(^PSDRUG(DRGNM,0))
SET DIK="^PSI(58.1,"_AOU_",1,"
SET DA=$PIECE(Y,"^")
SET DA(1)=AOU
DO ^DIK
KILL DIK
WRITE " ??",*7,*7
GOTO ASKITEM
+4 IF (AOUFL=0)&(X'="^ALL")
SET ITNAM=$PIECE(^PSDRUG(DRGNM,0),"^")
+5 IF X="^ALL"
SET ITNAM=0
SET ITMFL=1
+6 WRITE !!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
DEV KILL %ZIS,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
GOTO END
+1 IF $DATA(IO("Q"))
KILL IO("Q")
SET PSGWIO=ION
SET ZTIO=""
KILL ZTSAVE,ZTDTH,ZTSK
SET ZTRTN=$SELECT(ITMFL=1:"ENQ^PSGWTOT1",1:"ENQ^PSGWTOT2")
SET ZTDESC="Compile Usage Report"
FOR G="BDT","EDT","AOU","AOUFL","ITNAM","ITMFL","DRGNM","PSGWIO"
if $DATA(@G)
SET ZTSAVE(G)=""
+2 IF $TEST
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
GOTO END
+3 USE IO
if ITMFL=1
GOTO ENQ^PSGWTOT1
if ITMFL=0
GOTO ENQ^PSGWTOT2
+4 ;
END KILL AOU,AOUFL,BDT,DRGNM,EDT,ITNAM,ITMFL,PSGWIO,G,ZTIO,ZTSK,DA,X,Y,IO("Q")
+1 DO ^%ZISC
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
