close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCOST.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCOST.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: 4.3 KB
RevLine 
1PSOCOST ;BHAM ISC/SAB - ROUTINE TO GENERATE MONTHLY DRUG COST REPORT ; 08/19/92 8:19
2 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
3 K ^TMP($J) S (ALL,TF,TQ,TC,PG)=0
4MN S %DT("A")="Enter Month/Year: ",%DT="AQEP" D ^%DT G:"^"[X END G:Y'>0 MN S (MONTH,MON)=$E(Y,1,5)_"00",MN=MON+32
5MN1 R !,"Select a Drug or ^ALL for all drugs: ",X:DTIME G:"^"[X END I "^AL"'[$E(X,1,3) G DRG
6MN2 S DIR("A")="Select Minimum Total number of Refills: ",DIR("B")=0,DIR(0)="N^0:50:0",DIR("?")="ENTER A NUMBER FOR MINIMUM REFILLS or PRESS RETURN FOR A MINIMUM OF ZERO (0)."
7 D ^DIR G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) END S RF=Y
8MN3 S DIR("A")="Select Minimum Total Cost: ",DIR("B")=0,DIR(0)="N^0:9999:2",DIR("?")="ENTER MINIMUM COST OF DRUG or PRESS RETURN FOR A MINIMUM COST OF ZERO (0)."
9 D ^DIR G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) END S MC=Y
10 S ALL=1 D DEV I $G(PSQ)!$D(ZTSK) K ZTSK G END
11 G LK
12DRG ;DRUG CHOICE
13 S DIC(0)="QME",DIC="^PSDRUG(" D ^DIC G:"^"[X END G:Y<0 MN1 S DRG=+Y,DRUG=$P(^PSDRUG(DRG,0),"^") D DEV I $G(PSQ)!$D(ZTSK) K ZTSK G END
14 G:'$D(^PSCST(MON)) DAY
15DRG1 F DIV=0:0 S DIV=$O(^PSCST(MON,"V",DIV)) Q:'DIV I $D(^PSCST(MON,"V",DIV,"D",DRG,0)) D NF,STO
16 Q:$G(DAY) D HDR,PRI,GR
17END W ! W:$E(IOST)'["C" @IOF D ^%ZISC K PSQ,DAY,^TMP($J),DIR,DUOUT,DTOUT,DIRUT,DIROUT,DIV,SUB,DIV,ZDIV,MONTH,TF,PG,TQ,TC,MC,RF,X,MN,Y,DRG,DIC,%DT,DRUG,MON,ALL,G,D,I S:$D(ZTQUEUED) ZTREQ="@"
18 Q
19NF S DRUG=$S($D(^PSDRUG(DRG,0)):$P(^PSDRUG(DRG,0),"^"),1:"UNKNOWN")
20 S:'$D(^TMP($J,DIV,DRUG)) ^TMP($J,DIV,DRUG)="0^0^0"
21 S $P(^TMP($J,DIV,DRUG),"^")=($P(^PSCST(MON,"V",DIV,"D",DRG,0),"^",2)+$P(^(0),"^",3))+$P(^TMP($J,DIV,DRUG),"^")
22 S $P(^TMP($J,DIV,DRUG),"^",2)=$P(^PSCST(MON,"V",DIV,"D",DRG,0),"^",4)+$P(^TMP($J,DIV,DRUG),"^",2)
23 S $P(^TMP($J,DIV,DRUG),"^",3)=$P(^PSCST(MON,"V",DIV,"D",DRG,0),"^",5)+$P(^TMP($J,DIV,DRUG),"^",3)_"^"_$S($P(^PSDRUG(DRG,0),"^",9):"*** N/F ***",1:"")
24 Q
25HDR ;REPORT HEADER
26 S Y=MONTH X ^DD("DD")
27 S PG=PG+1 U IO W @IOF,!?50,"MONTHLY DRUG COST REPORT FOR "_Y,?115,"PAGE: "_PG,!?50,$S(ALL:"MINIMUM REFILLS OF "_RF_" AT A MINIMUM COST OF $"_MC,1:"FOR "_DRUG)
28 W !!,"DIVISION",?53,"TOTAL",?82,"TOTAL",?97,"TOTAL",!?5,"DRUG",?53,"FILLED",?81,"QUANITY",?98,"COST",?125,"N/F",! F I=1:1:132 W "-"
29 Q
30PRI ;OUTPUT DATA
31 I '$D(^TMP($J)) U IO W !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<" Q
32 S ZDIV=99 F I=0:0 S DIV=$O(^TMP($J,DIV)) Q:'DIV S DV=$P(^PS(59,DIV,0),"^") D DG
33 Q
34DG S DRG="" F T=0:0 S DRG=$O(^TMP($J,DIV,DRG)) Q:DRG="" D:$Y+4>IOSL HDR W:DIV'=ZDIV !,DV W !?5,DRG,?50,$J($P(^TMP($J,DIV,DRG),"^"),7),?80,$J($P(^(DRG),"^",3),7),?95,$J($P(^(DRG),"^",2),7),?120,$P(^(DRG),"^",4) S ZDIV=DIV D:'ALL GT
35 D:ALL SUB
36 Q
37DEV K %ZIS,IOP,ZTSK,POP S PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S PSQ=1,IOP=PSOION D ^%ZIS K IOP,PSOION Q
38 I $G(IOM)<132 W $C(7),!!,"PRINTOUT MUST BE 132 COLUMNS !!",!! G DEV
39 K PSOION I $D(IO("Q")) S ZTDESC="Option to print Outpatient Pharmacy's monthly drug cost report",ZTRTN=$S('ALL:"DRG1^PSOCOST",1:"LK^PSOCOST") F G="ALL","MON","MN","DRG","DRUG","RF","MC","TF","TQ","TC","PG","MONTH" S:$D(@G) ZTSAVE(G)=""
40 I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"REPORT IS QUEUED TO PRINT !",! Q
41 Q
42LK ;PRINT ALL DRUGS
43 G:'$D(^PSCST(MON)) DAY
44LK1 F DIV=0:0 S DIV=$O(^PSCST(MON,"V",DIV)) Q:'DIV F DRG=0:0 S DRG=$O(^PSCST(MON,"V",DIV,"D",DRG)) Q:'DRG I $P(^PSCST(MON,"V",DIV,"D",DRG,0),"^",3)'<RF,$P(^(0),"^",4)'<MC D NF,STO
45 Q:$G(DAY) D HDR,PRI F I=0:0 S I=$O(SUB(I)) Q:'I S TF=$P(SUB(I),"^")+TF,TQ=$P(SUB(I),"^",3)+TQ,TC=$P(SUB(I),"^",2)+TC
46 D GR G END
47 Q
48SUB ;DIVISIONAL SUB-TOTALS
49 Q:'$D(^TMP($J))
50 D:$Y+4>IOSL HDR W !?47,"----------",?77,"----------",?92,"----------",!?20,"SUB-TOTALS",?50,$J($P(SUB(ZDIV),"^"),7),?80,$J($P(SUB(ZDIV),"^",3),7),?95,$J($P(SUB(ZDIV),"^",2),7),!
51 Q
52GR Q:'$D(^TMP($J)) D:$Y+4>IOSL HDR W !?47,"==========",?77,"==========",?92,"==========",!?20,"GRAND TOTALS",?50,$J(TF,7),?80,$J(TQ,7),?95,$J(TC,7)
53 Q
54STO S:'$D(SUB(DIV)) SUB(DIV)="0^0^0"
55 S $P(SUB(DIV),"^")=$P(^PSCST(MON,"V",DIV,"D",DRG,0),"^",2)+$P(^(0),"^",3)+$P(SUB(DIV),"^"),$P(SUB(DIV),"^",2)=$P(^(0),"^",4)+$P(SUB(DIV),"^",2),$P(SUB(DIV),"^",3)=$P(^(0),"^",5)+$P(SUB(DIV),"^",3)
56 Q
57GT S TF=$P(SUB(DIV),"^")+TF,TQ=$P(SUB(DIV),"^",3)+TQ,TC=$P(SUB(DIV),"^",2)+TC
58 Q
59DAY ;Computes daily totals
60 S DAY=1 F S MON=$O(^PSCST(MON)) Q:'MON!(MON>MN) D @$S(ALL:"LK1",1:"DRG1")
61 D:'ALL HDR,PRI,GR
62 D:ALL
63 .D HDR,PRI F I=0:0 S I=$O(SUB(I)) Q:'I S TF=$P(SUB(I),"^")+TF,TQ=$P(SUB(I),"^",3)+TQ,TC=$P(SUB(I),"^",2)+TC
64 .D GR
65 G END
66 Q
Note: See TracBrowser for help on using the repository browser.