PSGWSTD ;BHAM ISC/KKA - Standard Cost Report ; 25 Aug 97 / 9:59 AM
;;2.3;Automatic Replenishment/Ward Stock ;**4,13,21**;4 JAN 94;Build 6
D SEL^PSGWUTL1 Q:'$D(SEL) G:SEL="I" DVC
F S DIC=58.1,DIC(0)="QEAM" D ^DIC K DIC Q:Y<0 S AOULP(+Y)=""
G:'$D(AOULP)&(X'="^ALL") END
I X="^ALL" F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU S AOULP(AOU)=""
DVC ;select a device
W !!,"The right margin for this report is 132.",!,"You may queue the report to print at a later time.",!!
K IO("Q"),%ZIS,IOP S %ZIS="MQ",%ZIS("B")="" D ^%ZIS K %ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." Q
I $D(IO("Q")) S ZTRTN="EN1^PSGWSTD",ZTDESC="MAXIMUM COST REPORT",ZTSAVE("AOULP(")="" D ^%ZTLOAD,HOME^%ZIS G END
U IO
EN1 ;entry point when queued
D NOW^%DTC S PSGWDT=X,PAGE=1,OUT=0
S AOU=0 F S AOU=$O(AOULP(AOU)) Q:AOU'>0!(OUT) S TTCST=0 D PRINT
DONE I $E(IOST)="C"&('OUT) W !!!,"Press <RETURN> to continue: " R AUTO:DTIME
W !,@IOF
END S:$D(ZTQUEUED) ZTREQ="@"
;PSGW*2.3*21 add PSGWCNM to kill list
K PSGWCNM,%ZIS,AOU,AOULP,AUTO,CONV,DIC,DIR,DRG,I,INACT,ITM,LVL,OUT,PAGE,POP,PSGWAOUN,PSGWDT,SEL,TCST,TTCST,UCST,X,Y,ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE
D ^%ZISC
Q
PRINT ;print all items for the AOU and their data
D PAGE Q:OUT
W !," ==>",$P(^PSI(58.1,AOU,0),"^")
I '$O(^PSI(58.1,AOU,1,0)) W !!,"No items found for this AOU" Q
S ITM=0,MFLG=0 F S ITM=$O(^PSI(58.1,AOU,1,ITM)) Q:ITM'>0!(OUT) D
.I $Y+4>IOSL D PAGE Q:OUT
.S PSGWAOUN=^PSI(58.1,AOU,1,ITM,0)
.S DRG=$P(PSGWAOUN,"^") Q:'DRG
.S INACT=$P(PSGWAOUN,"^",3) I INACT=""!(INACT>PSGWDT) D
..I $D(^PSDRUG(DRG,0)) D
...W !,$P(^PSDRUG(DRG,0),"^")
...S LVL=$P(PSGWAOUN,"^",2)
...I $D(^PSDRUG(DRG,660)) S UCST=$P(^(660),"^",6)
...;PSGW*2.3*21 Use AR/WS AMIS CONVERSION NUMBER
...S PSGWCNM=$S($P($G(^PSDRUG(DRG,"PSG")),U,3)="":1,1:$P($G(^PSDRUG(DRG,"PSG")),U,3))
...S TCST=LVL*UCST*PSGWCNM I 'MFLG S TTCST=TTCST+TCST I TCST=0 S TTCST=0,MFLG=1
...W ?46,$S(LVL:$J(LVL,4),1:"DATA MISSING"),?62,"X"
...W ?72,$S($D(UCST):$J(UCST,8,4),1:"DATA MISSING"),?88,"="
...W ?92,$S(TCST'=0:$J(TCST,14,4),1:"DATA MISSING")
Q:OUT
W ! F X=1:1:120 W "_"
W !!,"Total for ",$P(^PSI(58.1,AOU,0),"^"),?35 F X=1:1:60 W "-"
W ">",?99,$S(TTCST'=0:$J(TTCST,20,4),1:"DATA MISSING")
Q
PAGE ;
I $E(IOST)="C"&(PAGE>1) S DIR(0)="E" D ^DIR K DIR I Y'=1 S OUT=1 Q
W @IOF,!,"Standard Cost Report",?109,"PAGE ",PAGE,!,?109,$P($$PSGWDT^PSGWUTL1,"@",1)
S PAGE=PAGE+1
W !!!,?5,"AOU",!,"ITEM",?46,"LEVEL",?72,"UNIT COST",?97,"TOTAL COST",!
F I=1:1:120 W "_"
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWSTD 2541 printed Dec 13, 2024@01:40:09 Page 2
PSGWSTD ;BHAM ISC/KKA - Standard Cost Report ; 25 Aug 97 / 9:59 AM
+1 ;;2.3;Automatic Replenishment/Ward Stock ;**4,13,21**;4 JAN 94;Build 6
+2 DO SEL^PSGWUTL1
if '$DATA(SEL)
QUIT
if SEL="I"
GOTO DVC
+3 FOR
SET DIC=58.1
SET DIC(0)="QEAM"
DO ^DIC
KILL DIC
if Y<0
QUIT
SET AOULP(+Y)=""
+4 if '$DATA(AOULP)&(X'="^ALL")
GOTO END
+5 IF X="^ALL"
FOR AOU=0:0
SET AOU=$ORDER(^PSI(58.1,AOU))
if 'AOU
QUIT
SET AOULP(AOU)=""
DVC ;select a device
+1 WRITE !!,"The right margin for this report is 132.",!,"You may queue the report to print at a later time.",!!
+2 KILL IO("Q"),%ZIS,IOP
SET %ZIS="MQ"
SET %ZIS("B")=""
DO ^%ZIS
KILL %ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED."
QUIT
+3 IF $DATA(IO("Q"))
SET ZTRTN="EN1^PSGWSTD"
SET ZTDESC="MAXIMUM COST REPORT"
SET ZTSAVE("AOULP(")=""
DO ^%ZTLOAD
DO HOME^%ZIS
GOTO END
+4 USE IO
EN1 ;entry point when queued
+1 DO NOW^%DTC
SET PSGWDT=X
SET PAGE=1
SET OUT=0
+2 SET AOU=0
FOR
SET AOU=$ORDER(AOULP(AOU))
if AOU'>0!(OUT)
QUIT
SET TTCST=0
DO PRINT
DONE IF $EXTRACT(IOST)="C"&('OUT)
WRITE !!!,"Press <RETURN> to continue: "
READ AUTO:DTIME
+1 WRITE !,@IOF
END if $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 ;PSGW*2.3*21 add PSGWCNM to kill list
+2 KILL PSGWCNM,%ZIS,AOU,AOULP,AUTO,CONV,DIC,DIR,DRG,I,INACT,ITM,LVL,OUT,PAGE,POP,PSGWAOUN,PSGWDT,SEL,TCST,TTCST,UCST,X,Y,ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE
+3 DO ^%ZISC
+4 QUIT
PRINT ;print all items for the AOU and their data
+1 DO PAGE
if OUT
QUIT
+2 WRITE !," ==>",$PIECE(^PSI(58.1,AOU,0),"^")
+3 IF '$ORDER(^PSI(58.1,AOU,1,0))
WRITE !!,"No items found for this AOU"
QUIT
+4 SET ITM=0
SET MFLG=0
FOR
SET ITM=$ORDER(^PSI(58.1,AOU,1,ITM))
if ITM'>0!(OUT)
QUIT
Begin DoDot:1
+5 IF $Y+4>IOSL
DO PAGE
if OUT
QUIT
+6 SET PSGWAOUN=^PSI(58.1,AOU,1,ITM,0)
+7 SET DRG=$PIECE(PSGWAOUN,"^")
if 'DRG
QUIT
+8 SET INACT=$PIECE(PSGWAOUN,"^",3)
IF INACT=""!(INACT>PSGWDT)
Begin DoDot:2
+9 IF $DATA(^PSDRUG(DRG,0))
Begin DoDot:3
+10 WRITE !,$PIECE(^PSDRUG(DRG,0),"^")
+11 SET LVL=$PIECE(PSGWAOUN,"^",2)
+12 IF $DATA(^PSDRUG(DRG,660))
SET UCST=$PIECE(^(660),"^",6)
+13 ;PSGW*2.3*21 Use AR/WS AMIS CONVERSION NUMBER
+14 SET PSGWCNM=$SELECT($PIECE($GET(^PSDRUG(DRG,"PSG")),U,3)="":1,1:$PIECE($GET(^PSDRUG(DRG,"PSG")),U,3))
+15 SET TCST=LVL*UCST*PSGWCNM
IF 'MFLG
SET TTCST=TTCST+TCST
IF TCST=0
SET TTCST=0
SET MFLG=1
+16 WRITE ?46,$SELECT(LVL:$JUSTIFY(LVL,4),1:"DATA MISSING"),?62,"X"
+17 WRITE ?72,$SELECT($DATA(UCST):$JUSTIFY(UCST,8,4),1:"DATA MISSING"),?88,"="
+18 WRITE ?92,$SELECT(TCST'=0:$JUSTIFY(TCST,14,4),1:"DATA MISSING")
End DoDot:3
End DoDot:2
End DoDot:1
+19 if OUT
QUIT
+20 WRITE !
FOR X=1:1:120
WRITE "_"
+21 WRITE !!,"Total for ",$PIECE(^PSI(58.1,AOU,0),"^"),?35
FOR X=1:1:60
WRITE "-"
+22 WRITE ">",?99,$SELECT(TTCST'=0:$JUSTIFY(TTCST,20,4),1:"DATA MISSING")
+23 QUIT
PAGE ;
+1 IF $EXTRACT(IOST)="C"&(PAGE>1)
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y'=1
SET OUT=1
QUIT
+2 WRITE @IOF,!,"Standard Cost Report",?109,"PAGE ",PAGE,!,?109,$PIECE($$PSGWDT^PSGWUTL1,"@",1)
+3 SET PAGE=PAGE+1
+4 WRITE !!!,?5,"AOU",!,"ITEM",?46,"LEVEL",?72,"UNIT COST",?97,"TOTAL COST",!
+5 FOR I=1:1:120
WRITE "_"
+6 WRITE !
+7 QUIT
