| 1 | PSDCOSD ;BIR/LTL-Cost Report by Drugs, PSDCOST (cont'd) ; 2 Aug 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | N PSDN,LN,PG,X2 S PSDSD(1)=PSDSD S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 4 | F S PSDSD=$O(^PSD(58.81,"ACT",PSDSD)) W:$E(IOST)="C" "." Q:'PSDSD!(PSDSD>PSDED) S PSDN=$O(^PSD(58.81,"ACT",PSDSD,0)) D:$P($G(^PSD(58.8,+PSDN,0)),U,3)=+PSDSITE
|
|---|
| 5 | .S PSDN(1)=$O(^PSD(58.81,"ACT",PSDSD,PSDN,0))
|
|---|
| 6 | .Q:'$D(LOC(+PSDN(1)))&('$G(ALL))
|
|---|
| 7 | .S PSDN(2)=$O(^PSD(58.81,"ACT",PSDSD,PSDN,PSDN(1),0))
|
|---|
| 8 | .Q:PSDN(2)<2!(PSDN(2)>5)&(PSDN(2)'=9)
|
|---|
| 9 | .S PSDN(3)=$S($P($G(^PSDRUG(+PSDN(1),0)),U)]"":$P($G(^(0)),U),1:"UNKNOWN DRUG #"_PSDN(1))
|
|---|
| 10 | .S PSDN(4)=$O(^PSD(58.81,"ACT",PSDSD,PSDN,PSDN(1),PSDN(2),0))
|
|---|
| 11 | .S PSDN(8)=$G(^PSD(58.81,+PSDN(4),0))
|
|---|
| 12 | .;get NAOU for everything including adjustments
|
|---|
| 13 | .S PSDN(9)=$S(PSDN(2)=9:PSDN,1:$P(PSDN(8),U,18))
|
|---|
| 14 | .Q:$P($G(^PSD(58.8,+PSDN(9),0)),U,2)'="N"
|
|---|
| 15 | .;qty rec'd by NAOU w/green sheet
|
|---|
| 16 | .S PSDN(5)=$P($G(^PSD(58.81,+PSDN(4),1)),U,8)
|
|---|
| 17 | .;qty dispensed by Master Vault w/o green sheet
|
|---|
| 18 | .S:$P(PSDN(8),U,17)']"" PSDN(5)=$P(PSDN(8),U,6)
|
|---|
| 19 | .;Returned to Stock
|
|---|
| 20 | .S:PSDN(2)=3 PSDN(5)=-$P($G(^PSD(58.81,+PSDN(4),3)),U,2)
|
|---|
| 21 | .;Destroyed
|
|---|
| 22 | .S:PSDN(2)=4 PSDN(5)=-$P($G(^PSD(58.81,+PSDN(4),3)),U,5)
|
|---|
| 23 | .;include transfer ins with dispensed
|
|---|
| 24 | .S:PSDN(2)=5 PSDN(2)=2
|
|---|
| 25 | .;Check for transfers
|
|---|
| 26 | .S PSDN(6)=$G(^PSD(58.81,+PSDN(4),7))
|
|---|
| 27 | .D:$P(PSDN(6),U)>PSDSD(1)&($P(PSDN(6),U)<PSDED)
|
|---|
| 28 | ..S PSDN(5)=PSDN(5)-$P(PSDN(6),U,7),PSDN(2)=5
|
|---|
| 29 | .S PSDN(7)=$G(^TMP("PSD",$J,PSDN(3),PSDN(9)))
|
|---|
| 30 | .;total dispensed
|
|---|
| 31 | .S $P(^TMP("PSD",$J,PSDN(3),PSDN(9)),U)=$P(PSDN(7),U)+PSDN(5)
|
|---|
| 32 | .;DA for drug
|
|---|
| 33 | .S:'$P(PSDN(7),U,2) $P(^TMP("PSD",$J,PSDN(3),PSDN(9)),U,2)=PSDN(1)
|
|---|
| 34 | .;total returned to stock
|
|---|
| 35 | .S:PSDN(2)=3 $P(^TMP("PSD",$J,PSDN(3),PSDN(9)),U,3)=PSDN(5)+$P(PSDN(7),U,3)
|
|---|
| 36 | .;total destroyed
|
|---|
| 37 | .S:PSDN(2)=4 $P(^TMP("PSD",$J,PSDN(3),PSDN(9)),U,4)=PSDN(5)+$P(PSDN(7),U,4)
|
|---|
| 38 | .;total transferred
|
|---|
| 39 | .S:PSDN(2)=5 $P(^TMP("PSD",$J,PSDN(3),PSDN(9)),U,5)=-$P(PSDN(6),U,7)+$P(PSDN(7),U,5)
|
|---|
| 40 | .;total adjusted by NAOU
|
|---|
| 41 | .S:PSDN(2)=9 $P(^TMP("PSD",$J,PSDN(3),PSDN(9)),U,6)=PSDN(5)+$P(PSDN(7),U,6)
|
|---|
| 42 | .K PSDN
|
|---|
| 43 | PRTQUE ;queues print after data is compiled
|
|---|
| 44 | I $D(ZTQUEUED) K ZTSAVE,ZTSK S ZTIO=PSDIO,ZTDESC="CS Drug Cost Report",ZTRTN="START^PSDCOSD",ZTDTH=$H,ZTSAVE("PSD*")="",ZTSAVE("^TMP(""PSD"",$J,")="",ZTSAVE("SUM")="" D ^%ZTLOAD,HOME^%ZIS G QUIT
|
|---|
| 45 | START S (PG,PSDN)=0 D HEADER
|
|---|
| 46 | F S PSDN=$O(^TMP("PSD",$J,PSDN)) Q:PSDN']"" D:$Y+6>IOSL HEADER G:$G(PSDOUT) END S PSDN(8)=$G(PSDN(8))+1 K PG(PSDN) D G:$G(PSDOUT) END
|
|---|
| 47 | .W ?8,"DRUG ==> ",PSDN,!! S PSDN(1)=0
|
|---|
| 48 | .F S PSDN(1)=$O(^TMP("PSD",$J,PSDN,PSDN(1))) Q:'PSDN(1) D:$Y+6>IOSL HEADER Q:$G(PSDOUT) S PSDN(9)=$G(PSDN(9))+1 D
|
|---|
| 49 | ..I $D(PG(PSDN)) W ?8,"DRUG ==> ",PSDN," (continued)",!! K PG(PSDN)
|
|---|
| 50 | ..W:'$G(SUM) $P($G(^PSD(58.8,+PSDN(1),0)),U),?36
|
|---|
| 51 | ..S PSDN(2)=$G(^TMP("PSD",$J,PSDN,PSDN(1))),PSDN(3)=$G(PSDN(3))+PSDN(2)
|
|---|
| 52 | ..W:'$G(SUM) $J($P(PSDN(2),U),10),?62
|
|---|
| 53 | ..S PSDN(11)=$P($G(^PSDRUG(+$P(PSDN(2),U,2),660)),U,6)
|
|---|
| 54 | ..S (X,PSDN(4))=$P(PSDN(2),U)*PSDN(11),X2="2$",PSDN(5)=$G(PSDN(5))+PSDN(4) D COMMA^%DTC W:'$G(SUM) X,!!
|
|---|
| 55 | ..S PSDN(10)=" (Subtracted from total)"
|
|---|
| 56 | ..W:'$G(SUM)&($P(PSDN(2),U,3)) "Doses Returned to Stock: ",$P(PSDN(2),U,3),PSDN(10),!!
|
|---|
| 57 | ..W:'$G(SUM)&($P(PSDN(2),U,4)) "Doses Destroyed: ",$P(PSDN(2),U,4),PSDN(10),!!
|
|---|
| 58 | ..W:'$G(SUM)&($P(PSDN(2),U,5)) "Doses Transferred: ",$P(PSDN(2),U,5),PSDN(10),!!
|
|---|
| 59 | ..W:'$G(SUM)&($P(PSDN(2),U,6)) "Doses Adjusted by NAOU: ",$P(PSDN(2),U,6)," (Not affecting total)",!!
|
|---|
| 60 | ..S:'PSDN(11) ^TMP("PSDM",$J,PSDN)=""
|
|---|
| 61 | .Q:$G(PSDOUT) W LN,!?28,"Total: ",$J($G(PSDN(3)),10),?62
|
|---|
| 62 | .S X=$G(PSDN(5)) D COMMA^%DTC W X,!! S PSDN(6)=$G(PSDN(6))+PSDN(3)
|
|---|
| 63 | .S PSDN(7)=$G(PSDN(7))+PSDN(5) K PSDN(3),PSDN(5),PSDN(9)
|
|---|
| 64 | I $G(PSDN(8))>1 W LN,!?14,"Total for all NAOUs: ",$J($G(PSDN(6)),10) S X=$G(PSDN(7)) D COMMA^%DTC W ?62,X,!!
|
|---|
| 65 | I $D(^TMP("PSDM",$J)) S ZTRTN="^PSDCOSM",ZTIO="",ZTDTH=$H,ZTDESC="Mailman notification of 0 DRUG file cost",ZTSAVE("PSD*")="",ZTSAVE("^TMP(""PSDM"",$J,")="" D ^%ZTLOAD,HOME^%ZIS
|
|---|
| 66 | W:'$O(^TMP("PSD",$J,0)) !!,"Sorry, nothing to report for selected drug(s).",!!
|
|---|
| 67 | END W:$E(IOST)'="C" @IOF
|
|---|
| 68 | I $E(IOST)="C",'$G(PSDOUT) W !! S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu." D ^DIR
|
|---|
| 69 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 70 | QUIT K ^TMP("PSD",$J),^TMP("PSDM",$J),IO("Q") Q
|
|---|
| 71 | HEADER ;prints header info
|
|---|
| 72 | I $E(IOST,1,2)'="P-",PG S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
|
|---|
| 73 | I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSDOUT=1
|
|---|
| 74 | W:$Y @IOF S $P(LN,"-",80)="",PG=PG+1,PG(PSDN)="" W !?2,PSDCHO(1)," From "
|
|---|
| 75 | W $P(PSDATE,U)," To ",$P(PSDATE,U,2),?72,"Page ",PG,!!
|
|---|
| 76 | W ?45,"Report Date: ",PSDT(1),!!?40,"Quantity",!,"NAOU",?40,"Dispensed"
|
|---|
| 77 | W ?70,"Cost",!,LN,!!
|
|---|
