source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVAMIS.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1PSIVAMIS ;BIR/CCH,PR-AMIS REPORT ;03 NOV 94 / 4:38 PM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3 ;
4ENQ K ^UTILITY($J) F IV=0:0 S IV=$O(^PS(50.8,IV)) Q:'IV I $D(^PS(50.8,IV,2)) F DAT=I7-1:0 S DAT=$O(^PS(50.8,IV,2,DAT)) Q:'DAT!(DAT>I8) D DRUG
5PRTQUE G:'$D(I6) W S ZTIO=I6,ZTRTN="W^PSIVAMIS",ZTDTH=$H,ZTSAVE("^UTILITY($J,")="" F G="I7","I8" S ZTSAVE(G)=""
6 S ZTDESC="IV AMIS REPORT (PRINT)",%ZIS="QN",IOP=I6 D ^%ZIS,^%ZTLOAD G K
7 ;
8W U IO S PGCNT=0 I '$D(^UTILITY($J)) D H W !,"No data." W:$E(IOST)'="C"&($Y) @IOF D ^%ZISC G K
9 F IV=0:0 K TOT S IVTOT=0,IV=$O(^UTILITY($J,IV)) Q:'IV D H W !!,"IV ROOM ",$P(^PS(59.5,IV,0),U) D IV W !!?56,"================",!?5,"*TOTAL FOR IV ROOM: ",$P(^PS(59.5,IV,0),U),?54,$J(IVTOT,18,4),! F TYP="P","A","H","S","C" S PR="" D PRTLN,CTOT
10 ;
11 D TM^PSIVDCR1
12K S:$D(ZTQUEUED) ZTREQ="@" K CNT,CNTNDE,D,DAT,DISP,DRG,DRGCOST,DS,IV,IVTOT,JJ,LN,LO,PERRY,PGCNT,TOTNDE,TUC,TYP,WARD,WCOST,WDISP,WUNITS,ZZ,^UTILITY($J) D ENIVKV^PSGSETU
13 Q
14 ;
15DRUG I $D(^PS(50.8,IV,2,DAT,1)) F WARD=0:0 S WARD=$O(^PS(50.8,IV,2,DAT,1,WARD)) Q:'WARD D GETEM
16 I $D(^PS(50.8,IV,2,DAT,2)) F DRG=0:0 S DRG=$O(^PS(50.8,IV,2,DAT,2,DRG)) Q:'DRG I $D(^(DRG,0)) S DRGCOST=$P(^(0),U,5) D WARD
17 Q
18 ;
19WARD I $D(^PS(50.8,IV,2,DAT,2,DRG,3)) F WD=0:0 S WD=$O(^PS(50.8,IV,2,DAT,2,DRG,3,WD)) Q:'WD I $D(^(WD,1)) F TYP="P","A","H","S","C" D TYPE
20 Q
21 ;
22TYPE S DA=$O(^PS(50.8,IV,2,DAT,2,DRG,3,WD,"B",TYP,0)) Q:DA'>0
23 S COST=$P(^PS(50.8,IV,2,DAT,2,DRG,3,WD,1,DA,0),U,2)*DRGCOST
24 S LO=$S($D(^UTILITY($J,IV,$S($D(^DIC(42,WD,0)):$P(^(0),U),1:"OUT-PT"),TYP)):^(TYP),1:"") S $P(LO,U)=$P(LO,U)+COST,$P(LO,U,2)=$P(LO,U,2)+$P(^PS(50.8,IV,2,DAT,2,DRG,3,WD,1,DA,0),U,2)
25 S ^UTILITY($J,IV,$S($D(^DIC(42,WD,0)):$P(^(0),U),1:"OUT-PT"),TYP)=LO K COST Q
26 ;
27H W:$Y @IOF S PGCNT=PGCNT+1 W !!!?31,"IV AMIS REPORT",?65,"Page No. ",PGCNT,!,?20,"FROM " S Y=I7 X ^DD("DD") W Y," THROUGH " S Y=I8 X ^DD("DD") W Y D NOW^%DTC S Y=X X ^DD("DD") W ?65,Y
28 W !!,?36,"TOTAL",?63,"AVERAGE",!,?5,"TYPE",?34,"DISPENSED (BAGS)",?64,"COST"
29 W !! F LN=1:1:80 W "="
30 Q
31 ;
32WRT2 S TOTNDE=^UTILITY($J,IV,PERRY,0)
33 F TYP="P","A","H","S","C" S ZZ(TYP)=$S($D(^UTILITY($J,IV,PERRY,TYP)):^(TYP),1:"") D COMPTE,PRTLN,PRTLN1
34WDTOT W !,?30,"_____________",?57,"_______________"
35 S DS=WDISP,TUC=$S(DS'>0:0,1:WCOST/(WDISP)),DISP=WDISP D:$Y+5>IOSL H W !,?5,"TOTAL FOR WARD" S IVTOT=IVTOT+TUC D PRTLN1 Q
36COMPTE S DISP=$P(TOTNDE,U,$S(TYP="P":1,TYP="A":2,TYP="H":3,TYP="C":4,1:5)) I +$P(ZZ(TYP),U,1)'>0!(+$P(ZZ(TYP),U,2)'>0) S TUC=0 G HERE
37 S:DISP'>0 TUC=0 G:DISP'>0 HERE S TUC=$P(ZZ(TYP),U,1)/DISP
38HERE S WDISP=$S($D(WDISP):WDISP+DISP,1:DISP),WCOST=$S($D(WCOST):WCOST+$P(ZZ(TYP),U),1:$P(ZZ(TYP),U)),WUNITS=$S($D(WUNITS):WUNITS+$P(ZZ(TYP),U,2),1:$P(ZZ(TYP),U,2))
39 S LO=$S($D(TOT(TYP)):TOT(TYP),1:"") F C=1:1:2 S $P(LO,U,C)=$P(LO,U,C)+$P(ZZ(TYP),U,C)
40 S $P(LO,U,3)=$P(LO,U,3)+DISP S TOT(TYP)=LO Q
41PRTLN W !?5 W:$D(PR) "*" W $S(TYP="P":"Piggyback",TYP="A":"Admixture",TYP="H":"Hyperal",TYP="C":"Chemotherapy",1:"Syringe") K PR Q
42CTOT S TUC=$S('$D(TOT(TYP)):0,$P(TOT(TYP),U,3)<1:0,1:$P(TOT(TYP),U,1)/($P(TOT(TYP),U,3)-$P(TOT(TYP),U,4)))
43 S DISP=$S($D(TOT(TYP)):$P(TOT(TYP),U,3),1:0)
44PRTLN1 W ?35,$J(DISP,8,0),?60,$J(TUC,12,4) Q
45IV S PERRY="" F JJ=0:0 S PERRY=$O(^UTILITY($J,IV,PERRY)) Q:PERRY="" D:$Y+1>IOSL H W !!,PERRY K WDISP,WCOST,WUNITS D WRT2
46 Q
47GETEM I $D(^PS(50.8,IV,2,DAT,1,WARD,0)) S CNTNDE=^(0),X=0 D SETEM
48 I $D(^PS(50.8,IV,2,DAT,1,WARD,"R")) S CNTNDE=^("R"),X="R" D SETEM
49 Q
50SETEM F ZZ=1:1:5 S CNT(ZZ)=$P(CNTNDE,U,ZZ+1)
51 S LO=$S($D(^UTILITY($J,IV,$S($D(^DIC(42,WARD,0)):$P(^(0),U),1:"OUT-PT"),X)):^(X),1:"") F ZZ=1:1:5 S $P(LO,U,ZZ)=$P(LO,U,ZZ)+CNT(ZZ)
52 S ^UTILITY($J,IV,$S($D(^DIC(42,WARD,0)):$P(^(0),U),1:"OUT-PT"),X)=LO Q
Note: See TracBrowser for help on using the repository browser.