source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWSTD.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PSGWSTD ;BHAM ISC/KKA - Standard Cost Report ; 25 Aug 97 / 9:59 AM
2 ;;2.3; Automatic Replenishment/Ward Stock ;**4,13**;4 JAN 94
3 D SEL^PSGWUTL1 Q:'$D(SEL) G:SEL="I" DVC
4 F S DIC=58.1,DIC(0)="QEAM" D ^DIC K DIC Q:Y<0 S AOULP(+Y)=""
5 G:'$D(AOULP)&(X'="^ALL") END
6 I X="^ALL" F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU S AOULP(AOU)=""
7DVC ;select a device
8 W !!,"The right margin for this report is 132.",!,"You may queue the report to print at a later time.",!!
9 K IO("Q"),%ZIS,IOP S %ZIS="MQ",%ZIS("B")="" D ^%ZIS K %ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." Q
10 I $D(IO("Q")) S ZTRTN="EN1^PSGWSTD",ZTDESC="MAXIMUM COST REPORT",ZTSAVE("AOULP(")="" D ^%ZTLOAD,HOME^%ZIS G END
11 U IO
12EN1 ;entry point when queued
13 D NOW^%DTC S PSGWDT=X,PAGE=1,OUT=0
14 S AOU=0 F S AOU=$O(AOULP(AOU)) Q:AOU'>0!(OUT) S TTCST=0 D PRINT
15DONE I $E(IOST)="C"&('OUT) W !!!,"Press <RETURN> to continue: " R AUTO:DTIME
16 W !,@IOF
17END S:$D(ZTQUEUED) ZTREQ="@"
18 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
19 D ^%ZISC
20 Q
21PRINT ;print all items for the AOU and their data
22 D PAGE Q:OUT
23 W !," ==>",$P(^PSI(58.1,AOU,0),"^")
24 I '$O(^PSI(58.1,AOU,1,0)) W !!,"No items found for this AOU" Q
25 S ITM=0,MFLG=0 F S ITM=$O(^PSI(58.1,AOU,1,ITM)) Q:ITM'>0!(OUT) D
26 .I $Y+4>IOSL D PAGE Q:OUT
27 .S PSGWAOUN=^PSI(58.1,AOU,1,ITM,0)
28 .S DRG=$P(PSGWAOUN,"^") Q:'DRG
29 .S INACT=$P(PSGWAOUN,"^",3) I INACT=""!(INACT>PSGWDT) D
30 ..I $D(^PSDRUG(DRG,0)) D
31 ...W !,$P(^PSDRUG(DRG,0),"^")
32 ...S LVL=$P(PSGWAOUN,"^",2)
33 ...I $D(^PSDRUG(DRG,660)) S UCST=$P(^(660),"^",6)
34 ...S TCST=LVL*UCST I 'MFLG S TTCST=TTCST+TCST I TCST=0 S TTCST=0,MFLG=1
35 ...W ?46,$S(LVL:$J(LVL,4),1:"DATA MISSING"),?62,"X"
36 ...W ?72,$S($D(UCST):$J(UCST,8,4),1:"DATA MISSING"),?88,"="
37 ...W ?92,$S(TCST'=0:$J(TCST,14,4),1:"DATA MISSING")
38 Q:OUT
39 W ! F X=1:1:120 W "_"
40 W !!,"Total for ",$P(^PSI(58.1,AOU,0),"^"),?35 F X=1:1:60 W "-"
41 W ">",?99,$S(TTCST'=0:$J(TTCST,20,4),1:"DATA MISSING")
42 Q
43PAGE ;
44 I $E(IOST)="C"&(PAGE>1) S DIR(0)="E" D ^DIR K DIR I Y'=1 S OUT=1 Q
45 W @IOF,!,"Standard Cost Report",?109,"PAGE ",PAGE,!,?109,$P($$PSGWDT^PSGWUTL1,"@",1)
46 S PAGE=PAGE+1
47 W !!!,?5,"AOU",!,"ITEM",?46,"LEVEL",?72,"UNIT COST",?97,"TOTAL COST",!
48 F I=1:1:120 W "_"
49 W !
50 Q
Note: See TracBrowser for help on using the repository browser.