- PSGWSTD ;BHAM ISC/KKA - Standard Cost Report ; 25 Aug 97 / 9:59 AM
- ;;2.3; Automatic Replenishment/Ward Stock ;**4,13**;4 JAN 94
- 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="@"
- K %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)
- ...S TCST=LVL*UCST 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
- PSGWSTD ;BHAM ISC/KKA - Standard Cost Report ; 25 Aug 97 / 9:59 AM
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;**4,13**;4 JAN 94
- +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 KILL %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
- +2 DO ^%ZISC
- +3 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 SET TCST=LVL*UCST
- IF 'MFLG
- SET TTCST=TTCST+TCST
- IF TCST=0
- SET TTCST=0
- SET MFLG=1
- +14 WRITE ?46,$SELECT(LVL:$JUSTIFY(LVL,4),1:"DATA MISSING"),?62,"X"
- +15 WRITE ?72,$SELECT($DATA(UCST):$JUSTIFY(UCST,8,4),1:"DATA MISSING"),?88,"="
- +16 WRITE ?92,$SELECT(TCST'=0:$JUSTIFY(TCST,14,4),1:"DATA MISSING")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 IF OUT
- QUIT
- +18 WRITE !
- FOR X=1:1:120
- WRITE "_"
- +19 WRITE !!,"Total for ",$PIECE(^PSI(58.1,AOU,0),"^"),?35
- FOR X=1:1:60
- WRITE "-"
- +20 WRITE ">",?99,$SELECT(TTCST'=0:$JUSTIFY(TTCST,20,4),1:"DATA MISSING")
- +21 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
