| 1 | PRCPRPDH ;WISC/RFJ-distribution cost report (to or from primary) ;12 Feb 92
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 5 | N %,COSTCNTR,CUMTOT,D,DA,DATA,DATE,END,ENDDT,INVPT,MAXDT,MISCOST,MISDA,MISINVPT,NEW,NOW,NOWDT,PAGE,PRCPFLAG,SCREEN,START,STARTDT,FROM,TOTAL,TYPE,X,Y
|
|---|
| 6 | S DIR(0)="S^1:TO;2:FROM;",DIR("A")="Print distributions TO or FROM inventory point",DIR("B")="FROM" D ^DIR K DIR S TYPE=$S($G(Y)=1:"TO",$G(Y)=2:"FROM",1:"") I TYPE'="FROM",TYPE'="TO" Q
|
|---|
| 7 | D NOW^%DTC S NOWDT=X,Y=% D DD^%DT S NOW=Y,X1=$E(NOWDT,1,5)_"15",X2=-30 D C^%DTC S (Y,MAXDT)=$E(X,1,5)_"00" D DD^%DT S START=Y,MAXDT=($E(MAXDT,1,3)-1)_$E(MAXDT,4,5)_"00"
|
|---|
| 8 | START S %DT="AEP",%DT("A")="Start Printing Distributions from Date (Month Year): ",%DT("B")=START,%DT(0)=MAXDT W ! D ^%DT K %DT Q:Y<0 S (Y,STARTDT)=$E(Y,1,5) D DD^%DT S END=Y
|
|---|
| 9 | S %DT="AEP",%DT("A")=" End Printing Distributions with Date (Month Year): ",%DT("B")=END,%DT(0)=-NOWDT D ^%DT K %DT Q:Y<0 S ENDDT=$E(Y,1,5)
|
|---|
| 10 | I ENDDT<STARTDT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE." G START
|
|---|
| 11 | S Y=STARTDT D DD^%DT S START=Y W !!,"I will print the distribution history from ",Y," to " S Y=ENDDT D DD^%DT W Y,!! S END=Y
|
|---|
| 12 | S XP="Do you want to breakout the cost by the MIS costing section",XH="Enter 'YES' to break the costs down to the MIS costing section, '^' to exit."
|
|---|
| 13 | S %=$$YN^PRCPUYN(1) I '% Q
|
|---|
| 14 | K MISCOST I %=1 S MISCOST=1
|
|---|
| 15 | S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
|
|---|
| 16 | . S ZTDESC="Distribution History Report (to primary)",ZTRTN="DQ^PRCPRPDH"
|
|---|
| 17 | . S ZTSAVE("PRCP*")="",ZTSAVE("START*")="",ZTSAVE("END*")="",ZTSAVE("NOW*")="",ZTSAVE("TYPE")="",ZTSAVE("MISCOST")="",ZTSAVE("ZTREQ")="@"
|
|---|
| 18 | W !!,"<*> please wait <*>"
|
|---|
| 19 | DQ ;queue comes here
|
|---|
| 20 | N XREF S XREF=$S(TYPE="FROM":"AD",1:"B")
|
|---|
| 21 | K ^TMP($J,"DISTR"),^TMP($J,"MIS") S DA=0 F S DA=$O(^PRCP(446,XREF,PRCP("I"),DA)) Q:'DA S DATA=$G(^PRCP(446,DA,0)) I DATA'="" S DATE=$P(DATA,"^",2) I DATE'<STARTDT,DATE'>ENDDT D
|
|---|
| 22 | . S FROM=+$P(DATA,"^",3) I TYPE="FROM" S FROM=+$P(DATA,"^")
|
|---|
| 23 | . S COSTCNTR=$P(DATA,"^",4) S:'COSTCNTR COSTCNTR="<<UNKNOWN>>" S ^TMP($J,"DISTR",FROM,COSTCNTR)=$G(^TMP($J,"DISTR",FROM,COSTCNTR))+$P(DATA,"^",7)
|
|---|
| 24 | S PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
|
|---|
| 25 | S (CUMTOT,FROM)=0 F S FROM=$O(^TMP($J,"DISTR",FROM)) Q:FROM=""!($D(PRCPFLAG)) S NEW=0,INVPT=$P($$INVNAME^PRCPUX1(FROM),"-",2,99) S:INVPT="" INVPT="<<UNKNOWN>>" W !,$E(INVPT,1,17) D
|
|---|
| 26 | . S TOTAL=0,COSTCNTR="" F S COSTCNTR=$O(^TMP($J,"DISTR",FROM,COSTCNTR)) Q:COSTCNTR=""!($D(PRCPFLAG)) S D=^(COSTCNTR) D
|
|---|
| 27 | . . W:NEW ! W ?19,$E(COSTCNTR,1,40),?61,$J(D,19,2) S CUMTOT=CUMTOT+D,TOTAL=TOTAL+D,NEW=1
|
|---|
| 28 | . . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 29 | . S MISINVPT=PRCP("I") I TYPE="FROM" S MISINVPT=FROM
|
|---|
| 30 | . I $G(MISCOST),$O(^PRCP(445,MISINVPT,3,0)) W !?4,"MIS COSTING SECTION",?41,"% DISTRIBUTED",?61,"$ AMOUNT" S MISDA=0 F S MISDA=$O(^PRCP(445,MISINVPT,3,MISDA)) Q:'MISDA!($D(PRCPFLAG)) D
|
|---|
| 31 | . . S DATA=$G(^PRCP(445,MISINVPT,3,MISDA,0)) Q:DATA=""
|
|---|
| 32 | . . S X=$P($G(^DIC(49,+$P(DATA,"^"),2)),"^"),X=X_$E(" ",$L(X)+1,5),%=$P($G(^DIC(49,+$P(DATA,"^"),0)),"^") S:%="" %="<<UNKNOWN>>" S %=X_" "_%,X=$J(TOTAL*($P(DATA,"^",2)/100),0,2)
|
|---|
| 33 | . . S ^TMP($J,"MIS",$E(%,1,40))=$G(^TMP($J,"MIS",$E(%,1,40)))+X
|
|---|
| 34 | . . W !?4,$E(%,1,40),?44,$J($P(DATA,"^",2),10,2),$J(X,15,2)
|
|---|
| 35 | . . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 36 | . W !?19,"TOTAL $ AMOUNT DISTRIBUTED ",$S(TYPE="FROM":"TO",1:"FROM")," ",$E(INVPT,1,15),?65,$J(TOTAL,15,2),!
|
|---|
| 37 | . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 38 | . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
|
|---|
| 39 | I '$D(PRCPFLAG),$G(MISCOST) D
|
|---|
| 40 | . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 41 | . I $O(^TMP($J,"MIS",""))'="" W !?4,"MIS COSTING SECTION",?41,"% DISTRIBUTED",?61,"$ AMOUNT" S MISDA=0 F S MISDA=$O(^TMP($J,"MIS",MISDA)) Q:MISDA=""!($D(PRCPFLAG)) S TOTAL=^(MISDA) D
|
|---|
| 42 | . . W !?4,$E(MISDA,1,40),?44,$J($S(CUMTOT:TOTAL/CUMTOT*100,1:0),10,2),$J(TOTAL,15,2)
|
|---|
| 43 | . . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 44 | . W !?19,"TOTAL DOLLAR AMOUNT DISTRIBUTED ",TYPE," ",PRCP("IN"),?65,$J(CUMTOT,15,2)
|
|---|
| 45 | I '$D(PRCPFLAG) D END^PRCPUREP
|
|---|
| 46 | D ^%ZISC K ^TMP($J,"DISTR"),^TMP($J,"MIS") Q
|
|---|
| 47 | ;
|
|---|
| 48 | H S %=NOW_" PAGE: "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|---|
| 49 | W $C(13),"DISTRIBUTION COSTING REPORT ",TYPE," ",PRCP("IN"),?(80-$L(%)),%,!?10,"FROM DATE ",START," TO DATE ",END
|
|---|
| 50 | S %="",$P(%,"-",81)="" W !,"DISTRIBUTED ",$S(TYPE="FROM":"TO",1:"FROM"),?19,"COST CENTER",?70,"TOTAL COST",!,% Q
|
|---|
