source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVDCR1.m@ 1036

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1PSIVDCR1 ;BIR/PR,MLM-PRINT DRUG COST REPORT ;29 SEP 94 / 10:09 AM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3W ;Entry to print report.
4 I $D(LCO),$D(^UTILITY($J)) S V="" F V=0:0 S V=$O(^UTILITY($J,V)) Q:'V S DRUG="" F J=0:0 S DRUG=$O(^UTILITY($J,V,"H",DRUG)) Q:DRUG="" S:$D(^UTILITY($J,V,"H",DRUG,0)) DC=$P(^(0),U,5) I DC'>UCO,(DC'<LCO) D RESORT
5 I $D(LCO) F V=0:0 S V=$O(^UTILITY($J,V)) Q:'V K ^UTILITY($J,V,"H")
6 S (B1,B2,B4,B3,G5,E,G1,G2,G4,G3)=0,OK=1,L1="==============",L2="--------------"
7 U IO S S=$S($D(PQ):"Y",1:"NO"),Y=I7 X ^DD("DD") S H=Y,Y=I8 X ^DD("DD") S H=H_" THROUGH "_Y,%H=$H D YX^%DTC S US="PRINTED BY: "_($P(^VA(200,DUZ,0),U))_" ON "_Y D H I '$D(^UTILITY($J)) W !,"NO DATA." W:$E(IOST)'="C"&($Y) @IOF D ^%ZISC G K
8 D P,K Q
9H ;Header
10 S E=E+1 W:$Y @IOF W !?60,"IV DRUG COST REPORT ("_$S($D(BRIEF)&($D(SMO)):"SUMMARY ONLY",$D(BRIEF)&('$D(SMO)):"CONDENSED",1:"REGULAR"),") FOR:",?120,"PAGE:",E
11 W !?60,H,!?60,I15,!?60,I10,!?60,US,!! I '$D(LP) W:'$D(SMO) ?122,"UNITS",!,"IV ROOM/DRUG" W $S('$D(BRIEF):"/WARD",1:"")_$S($D(PQ):"/PATIENT",1:""),?35,"DISPENSED",?56,"(DESTROYED)",?77,"RECYCLED",?96,"CANCELLED",?124,"COST",!
12 F Q=1:1:132 W "=" W:Q=132 !
13 Q
14P ;Print IV room, grand total cost
15 F V=0:0 D F S V=$O(^UTILITY($J,V)) W:'V ! Q:'V W:'$D(SMO) !,"IV ROOM: ",$S($D(^PS(59.5,V,0)):$P(^(0),U),1:"NF") S (N,N1,P)="" S DC="" F J=0:0 S DC=$O(^UTILITY($J,V,DC)) Q:DC="" D P1^PSIVDCR2
16 I $D(LCO),'$D(^UTILITY("PSIV",$J)) W !,"NO DATA." W:$E(IOST)'="C"&($Y) @IOF D ^%ZISC G K
17 F L=1:1:2 D F W:'$D(SMO) !?30,L1,?53,L1,?71,L1,?90,L1,?117,L1 I L=2 W !!?11,"GRAND TOTAL COST: ",?28,"$",$J(G1,14,2),?52,"$",$J(G2,14,2),?70,"$",$J(G3,14,2),?89,"$",$J(G4,14,2),?113,"$",$J(G5,17,2)
18 ;
19S ;Print high/low cost in descending sort
20 K LP I I2="HIGH",'$D(SMO) S LP=1 D H W !,"DESCENDING SORT:"
21 I $D(LP) S V="" F I=0:0 S V=$O(^UTILITY("PSIV",$J,V)) Q:V="" D F W !!,"IV ROOM: ",V,! S C="" F S C=$O(^UTILITY("PSIV",$J,V,C)) Q:'C S SD="" F Q=0:0 S SD=$O(^UTILITY("PSIV",$J,V,C,SD)) Q:SD="" D F W ?30,SD,?90,"$",$J(^(SD),15,2),!
22SP ;Print out summary page
23 I B1!(G1) S LP=1 I '$D(SMO) D H
24 I B1 W !!!!?16,"BAG SUMMARY:"
25 I W !,?17,"DESTROYED",?40,"=",?40,$J(B2/B1*100,6,2)_" %",?80,"OF DISPENSED BAGS",!?17,"RECYCLED",?40,"=",?40,$J(B3/B1*100,6,2)_" %",?80,"OF DISPENSED BAGS",!?17,"CANCELLED",?40,"=",?40,$J(B4/B1*100,6,2)_" %",?80,"OF DISPENSED BAGS"
26 I G1 W !!?16,"COST SUMMARY:"
27 I W !,?17,"DESTROYED",?40,"=",?40,$J(G2/G1*100,6,2)_" %",?80,"OF DISPENSED COST",!?17,"RECYCLED",?40,"=",?40,$J(G3/G1*100,6,2)_" %",?80,"OF DISPENSED COST",!?17,"CANCELLED",?40,"=",?40,$J(G4/G1*100,6,2)_" %",?80,"OF DISPENSED COST"
28 ;
29TM ;
30 W !!!?17,"FINISHED PRINTING ON: " D NOW^%DTC S Y=% X ^DD("DD") W Y,@IOF K ZTSK D ^%ZISC
31K ;
32 S:$D(ZTQUEUED) ZTREQ="@"
33 K %,A,B,B1,B2,B3,B4,C,CC,C1,C3,C2,C3,C4,C5,DATA,DC,DD,E,G1,G2,G3,G4,G5,GG,H,I,II,I2,I6,I7,I8,I10,L,L1,L2,LP,N,N1,OK,P,P1,P2,P3,P4,P5,PQ,Q,SD,SUS,U1,U2,U3,U4,UCO,V1,V2,V3,V4,WT,^UTILITY("PSIV",$J)
34 Q
35 ;
36F ;Form feed
37 I $Y+5>IOSL D H
38 Q
39RESORT ;
40 S ^UTILITY($J,V,-DC,DRUG,0)=^UTILITY($J,V,"H",DRUG,0),WD="" F J=0:0 S WD=$O(^UTILITY($J,V,"H",DRUG,WD)) Q:WD="" S PN="" F J=0:0 S PN=$O(^UTILITY($J,V,"H",DRUG,WD,PN)) Q:PN="" D RESORT1
41 Q
42RESORT1 ;
43 S:$D(^UTILITY($J,V,"H",DRUG,WD,PN,0)) ^UTILITY($J,V,-DC,DRUG,WD,PN,0)=^UTILITY($J,V,"H",DRUG,WD,PN,0)
44 Q
Note: See TracBrowser for help on using the repository browser.