PSIVAMIS ;BIR/CCH,PR-AMIS REPORT ;03 NOV 94 / 4:38 PM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
;
ENQ 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
PRTQUE G:'$D(I6) W S ZTIO=I6,ZTRTN="W^PSIVAMIS",ZTDTH=$H,ZTSAVE("^UTILITY($J,")="" F G="I7","I8" S ZTSAVE(G)=""
S ZTDESC="IV AMIS REPORT (PRINT)",%ZIS="QN",IOP=I6 D ^%ZIS,^%ZTLOAD G K
;
W U IO S PGCNT=0 I '$D(^UTILITY($J)) D H W !,"No data." W:$E(IOST)'="C"&($Y) @IOF D ^%ZISC G K
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
;
D TM^PSIVDCR1
K 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
Q
;
DRUG 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
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
Q
;
WARD 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
Q
;
TYPE S DA=$O(^PS(50.8,IV,2,DAT,2,DRG,3,WD,"B",TYP,0)) Q:DA'>0
S COST=$P(^PS(50.8,IV,2,DAT,2,DRG,3,WD,1,DA,0),U,2)*DRGCOST
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)
S ^UTILITY($J,IV,$S($D(^DIC(42,WD,0)):$P(^(0),U),1:"OUT-PT"),TYP)=LO K COST Q
;
H 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
W !!,?36,"TOTAL",?63,"AVERAGE",!,?5,"TYPE",?34,"DISPENSED (BAGS)",?64,"COST"
W !! F LN=1:1:80 W "="
Q
;
WRT2 S TOTNDE=^UTILITY($J,IV,PERRY,0)
F TYP="P","A","H","S","C" S ZZ(TYP)=$S($D(^UTILITY($J,IV,PERRY,TYP)):^(TYP),1:"") D COMPTE,PRTLN,PRTLN1
WDTOT W !,?30,"_____________",?57,"_______________"
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
COMPTE 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
S:DISP'>0 TUC=0 G:DISP'>0 HERE S TUC=$P(ZZ(TYP),U,1)/DISP
HERE 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))
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)
S $P(LO,U,3)=$P(LO,U,3)+DISP S TOT(TYP)=LO Q
PRTLN W !?5 W:$D(PR) "*" W $S(TYP="P":"Piggyback",TYP="A":"Admixture",TYP="H":"Hyperal",TYP="C":"Chemotherapy",1:"Syringe") K PR Q
CTOT 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)))
S DISP=$S($D(TOT(TYP)):$P(TOT(TYP),U,3),1:0)
PRTLN1 W ?35,$J(DISP,8,0),?60,$J(TUC,12,4) Q
IV 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
Q
GETEM I $D(^PS(50.8,IV,2,DAT,1,WARD,0)) S CNTNDE=^(0),X=0 D SETEM
I $D(^PS(50.8,IV,2,DAT,1,WARD,"R")) S CNTNDE=^("R"),X="R" D SETEM
Q
SETEM F ZZ=1:1:5 S CNT(ZZ)=$P(CNTNDE,U,ZZ+1)
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)
S ^UTILITY($J,IV,$S($D(^DIC(42,WARD,0)):$P(^(0),U),1:"OUT-PT"),X)=LO Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVAMIS 3717 printed Dec 13, 2024@02:03:50 Page 2
PSIVAMIS ;BIR/CCH,PR-AMIS REPORT ;03 NOV 94 / 4:38 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;
ENQ KILL ^UTILITY($JOB)
FOR IV=0:0
SET IV=$ORDER(^PS(50.8,IV))
if 'IV
QUIT
IF $DATA(^PS(50.8,IV,2))
FOR DAT=I7-1:0
SET DAT=$ORDER(^PS(50.8,IV,2,DAT))
if 'DAT!(DAT>I8)
QUIT
DO DRUG
PRTQUE if '$DATA(I6)
GOTO W
SET ZTIO=I6
SET ZTRTN="W^PSIVAMIS"
SET ZTDTH=$HOROLOG
SET ZTSAVE("^UTILITY($J,")=""
FOR G="I7","I8"
SET ZTSAVE(G)=""
+1 SET ZTDESC="IV AMIS REPORT (PRINT)"
SET %ZIS="QN"
SET IOP=I6
DO ^%ZIS
DO ^%ZTLOAD
GOTO K
+2 ;
W USE IO
SET PGCNT=0
IF '$DATA(^UTILITY($JOB))
DO H
WRITE !,"No data."
if $EXTRACT(IOST)'="C"&($Y)
WRITE @IOF
DO ^%ZISC
GOTO K
+1 FOR IV=0:0
KILL TOT
SET IVTOT=0
SET IV=$ORDER(^UTILITY($JOB,IV))
if 'IV
QUIT
DO H
WRITE !!,"IV ROOM ",$PIECE(^PS(59.5,IV,0),U)
DO IV
WRITE !!?56,"================",!?5,"*TOTAL FOR IV ROOM: ",$PIECE(^PS(59.5,IV,0),U),?54,$JUSTIFY(IVTOT,18,4),!
FOR TYP="P","A","H","S","C"
SET PR=""
DO PRTLN
DO CTOT
+2 ;
+3 DO TM^PSIVDCR1
K if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL CNT,CNTNDE,D,DAT,DISP,DRG,DRGCOST,DS,IV,IVTOT,JJ,LN,LO,PERRY,PGCNT,TOTNDE,TUC,TYP,WARD,WCOST,WDISP,WUNITS,ZZ,^UTILITY($JOB)
DO ENIVKV^PSGSETU
+1 QUIT
+2 ;
DRUG IF $DATA(^PS(50.8,IV,2,DAT,1))
FOR WARD=0:0
SET WARD=$ORDER(^PS(50.8,IV,2,DAT,1,WARD))
if 'WARD
QUIT
DO GETEM
+1 IF $DATA(^PS(50.8,IV,2,DAT,2))
FOR DRG=0:0
SET DRG=$ORDER(^PS(50.8,IV,2,DAT,2,DRG))
if 'DRG
QUIT
IF $DATA(^(DRG,0))
SET DRGCOST=$PIECE(^(0),U,5)
DO WARD
+2 QUIT
+3 ;
WARD IF $DATA(^PS(50.8,IV,2,DAT,2,DRG,3))
FOR WD=0:0
SET WD=$ORDER(^PS(50.8,IV,2,DAT,2,DRG,3,WD))
if 'WD
QUIT
IF $DATA(^(WD,1))
FOR TYP="P","A","H","S","C"
DO TYPE
+1 QUIT
+2 ;
TYPE SET DA=$ORDER(^PS(50.8,IV,2,DAT,2,DRG,3,WD,"B",TYP,0))
if DA'>0
QUIT
+1 SET COST=$PIECE(^PS(50.8,IV,2,DAT,2,DRG,3,WD,1,DA,0),U,2)*DRGCOST
+2 SET LO=$SELECT($DATA(^UTILITY($JOB,IV,$SELECT($DATA(^DIC(42,WD,0)):$PIECE(^(0),U),1:"OUT-PT"),TYP)):^(TYP),1:"")
SET $PIECE(LO,U)=$PIECE(LO,U)+COST
SET $PIECE(LO,U,2)=$PIECE(LO,U,2)+$PIECE(^PS(50.8,IV,2,DAT,2,DRG,3,WD,1,DA,0),U,2)
+3 SET ^UTILITY($JOB,IV,$SELECT($DATA(^DIC(42,WD,0)):$PIECE(^(0),U),1:"OUT-PT"),TYP)=LO
KILL COST
QUIT
+4 ;
H if $Y
WRITE @IOF
SET PGCNT=PGCNT+1
WRITE !!!?31,"IV AMIS REPORT",?65,"Page No. ",PGCNT,!,?20,"FROM "
SET Y=I7
XECUTE ^DD("DD")
WRITE Y," THROUGH "
SET Y=I8
XECUTE ^DD("DD")
WRITE Y
DO NOW^%DTC
SET Y=X
XECUTE ^DD("DD")
WRITE ?65,Y
+1 WRITE !!,?36,"TOTAL",?63,"AVERAGE",!,?5,"TYPE",?34,"DISPENSED (BAGS)",?64,"COST"
+2 WRITE !!
FOR LN=1:1:80
WRITE "="
+3 QUIT
+4 ;
WRT2 SET TOTNDE=^UTILITY($JOB,IV,PERRY,0)
+1 FOR TYP="P","A","H","S","C"
SET ZZ(TYP)=$SELECT($DATA(^UTILITY($JOB,IV,PERRY,TYP)):^(TYP),1:"")
DO COMPTE
DO PRTLN
DO PRTLN1
WDTOT WRITE !,?30,"_____________",?57,"_______________"
+1 SET DS=WDISP
SET TUC=$SELECT(DS'>0:0,1:WCOST/(WDISP))
SET DISP=WDISP
if $Y+5>IOSL
DO H
WRITE !,?5,"TOTAL FOR WARD"
SET IVTOT=IVTOT+TUC
DO PRTLN1
QUIT
COMPTE SET DISP=$PIECE(TOTNDE,U,$SELECT(TYP="P":1,TYP="A":2,TYP="H":3,TYP="C":4,1:5))
IF +$PIECE(ZZ(TYP),U,1)'>0!(+$PIECE(ZZ(TYP),U,2)'>0)
SET TUC=0
GOTO HERE
+1 if DISP'>0
SET TUC=0
if DISP'>0
GOTO HERE
SET TUC=$PIECE(ZZ(TYP),U,1)/DISP
HERE SET WDISP=$SELECT($DATA(WDISP):WDISP+DISP,1:DISP)
SET WCOST=$SELECT($DATA(WCOST):WCOST+$PIECE(ZZ(TYP),U),1:$PIECE(ZZ(TYP),U))
SET WUNITS=$SELECT($DATA(WUNITS):WUNITS+$PIECE(ZZ(TYP),U,2),1:$PIECE(ZZ(TYP),U,2))
+1 SET LO=$SELECT($DATA(TOT(TYP)):TOT(TYP),1:"")
FOR C=1:1:2
SET $PIECE(LO,U,C)=$PIECE(LO,U,C)+$PIECE(ZZ(TYP),U,C)
+2 SET $PIECE(LO,U,3)=$PIECE(LO,U,3)+DISP
SET TOT(TYP)=LO
QUIT
PRTLN WRITE !?5
if $DATA(PR)
WRITE "*"
WRITE $SELECT(TYP="P":"Piggyback",TYP="A":"Admixture",TYP="H":"Hyperal",TYP="C":"Chemotherapy",1:"Syringe")
KILL PR
QUIT
CTOT SET TUC=$SELECT('$DATA(TOT(TYP)):0,$PIECE(TOT(TYP),U,3)<1:0,1:$PIECE(TOT(TYP),U,1)/($PIECE(TOT(TYP),U,3)-$PIECE(TOT(TYP),U,4)))
+1 SET DISP=$SELECT($DATA(TOT(TYP)):$PIECE(TOT(TYP),U,3),1:0)
PRTLN1 WRITE ?35,$JUSTIFY(DISP,8,0),?60,$JUSTIFY(TUC,12,4)
QUIT
IV SET PERRY=""
FOR JJ=0:0
SET PERRY=$ORDER(^UTILITY($JOB,IV,PERRY))
if PERRY=""
QUIT
if $Y+1>IOSL
DO H
WRITE !!,PERRY
KILL WDISP,WCOST,WUNITS
DO WRT2
+1 QUIT
GETEM IF $DATA(^PS(50.8,IV,2,DAT,1,WARD,0))
SET CNTNDE=^(0)
SET X=0
DO SETEM
+1 IF $DATA(^PS(50.8,IV,2,DAT,1,WARD,"R"))
SET CNTNDE=^("R")
SET X="R"
DO SETEM
+2 QUIT
SETEM FOR ZZ=1:1:5
SET CNT(ZZ)=$PIECE(CNTNDE,U,ZZ+1)
+1 SET LO=$SELECT($DATA(^UTILITY($JOB,IV,$SELECT($DATA(^DIC(42,WARD,0)):$PIECE(^(0),U),1:"OUT-PT"),X)):^(X),1:"")
FOR ZZ=1:1:5
SET $PIECE(LO,U,ZZ)=$PIECE(LO,U,ZZ)+CNT(ZZ)
+2 SET ^UTILITY($JOB,IV,$SELECT($DATA(^DIC(42,WARD,0)):$PIECE(^(0),U),1:"OUT-PT"),X)=LO
QUIT
