PSOMGR31 ;BHAM ISC/JMB - DAILY MANAGEMENT COST REPORT CONTD ; 3/19/93
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
TOT S PRT=1 D RPT^PSOMGRP3 F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV D SUB^PSOMGRP3
W !!?13 F K=1:1:9 W $J("=======",13)
W !,"GR TOTAL",?13 I ANS="A" W $J($FN($S($P(T2,"^",4)=0!($P(T3,"^",2)=0):0,1:$P(T3,"^",2)/$P(T2,"^",4)),"",2),13) D
.W $J($FN($S($P(T2,"^",3)=0!($P(T3,"^",3)=0):0,1:$P(T3,"^",3)/$P(T2,"^",3)),"",2),13),$J($FN($S($P(T3,"^",7)=0!($P(T1,"^",12)=0):0,1:$P(T3,"^",7)/$P(T1,"^",12)),"",2),13)
.W $J($FN($S($P(T3,"^",7)=0!($P(T1,"^",10)=0):0,1:$P(T3,"^",7)/$P(T1,"^",10)),"",2),13),$J($FN($S($P(T3,"^",8)=0!($P(T1,"^",11)=0):0,1:$P(T3,"^",8)/$P(T1,"^",11)),"",2),13)
I ANS="S" W $J($FN($S($P(S2(DIV),"^",4)=0!($P(T3,"^",2)=0):0,1:($P(S2(DIV),"^",4)*$P(T3,"^",2))/$P(S2(DIV),"^",4)),"",2),13) D
.W $J($FN($S($P(S2(DIV),"^",3)=0!($P(T3,"^",3)=0):0,1:($P(S2(DIV),"^",3)*$P(T3,"^",3))/$P(S2(DIV),"^",3)),"",2),13),$J($FN($S($P(T3,"^",7)=0!($P(S1(DIV),"^",12)=0):0,1:$P(T3,"^",7)/$P(S1(DIV),"^",12)),"",2),13)
.W $J($FN($S($P(T3,"^",7)=0!($P(S1(DIV),"^",10)=0):0,1:$P(T3,"^",7)/$P(S1(DIV),"^",10)),"",2),13),$J($FN($S($P(T3,"^",8)=0!($P(S1(DIV),"^",11)=0):0,1:$P(T3,"^",8)/$P(S1(DIV),"^",11)),"",2),13)
W $J($FN($P(T3,"^",7),"",2),13),$J($FN($P(T3,"^",8),"",2),13),$J($FN($P(T3,"^",9),"",2),13)
I ANS="A" W $J($FN($S($P(T3,"^",9)=0!($P(T2,"^",13)=0):0,1:$P(T3,"^",9)/$P(T2,"^",13)),"",2),13)
E W $J($FN($S($P(T3,"^",9)=0!($P(S2(DIV),"^",13)=0):0,1:$P(T3,"^",9)/$P(S2(DIV),"^",13)),"",2),13)
W !!!?17,"FINISHED PRINTING ON: " D NOW^%DTC S Y=% X ^DD("DD") W Y
W @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOMGR31 1611 printed Dec 13, 2024@02:31:08 Page 2
PSOMGR31 ;BHAM ISC/JMB - DAILY MANAGEMENT COST REPORT CONTD ; 3/19/93
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
TOT SET PRT=1
DO RPT^PSOMGRP3
FOR DIV=0:0
SET DIV=$ORDER(^PS(59,DIV))
if 'DIV
QUIT
DO SUB^PSOMGRP3
+1 WRITE !!?13
FOR K=1:1:9
WRITE $JUSTIFY("=======",13)
+2 WRITE !,"GR TOTAL",?13
IF ANS="A"
WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T2,"^",4)=0!($PIECE(T3,"^",2)=0):0,1:$PIECE(T3,"^",2)/$PIECE(T2,"^",4)),"",2),13)
Begin DoDot:1
+3 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T2,"^",3)=0!($PIECE(T3,"^",3)=0):0,1:$PIECE(T3,"^",3)/$PIECE(T2,"^",3)),"",2),13),$JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",7)=0!($PIECE(T1,"^",12)=0):0,1:$PIECE(T3,"^",7)/$PIECE(T1,"^",12)),"",2),13
)
+4 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",7)=0!($PIECE(T1,"^",10)=0):0,1:$PIECE(T3,"^",7)/$PIECE(T1,"^",10)),"",2),13),$JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",8)=0!($PIECE(T1,"^",11)=0):0,1:$PIECE(T3,"^",8)/$PIECE(T1,"^",11)),"",2),
13)
End DoDot:1
+5 IF ANS="S"
WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(S2(DIV),"^",4)=0!($PIECE(T3,"^",2)=0):0,1:($PIECE(S2(DIV),"^",4)*$PIECE(T3,"^",2))/$PIECE(S2(DIV),"^",4)),"",2),13)
Begin DoDot:1
+6 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(S2(DIV),"^",3)=0!($PIECE(T3,"^",3)=0):0,1:($PIECE(S2(DIV),"^",3)*$PIECE(T3,"^",3))/$PIECE(S2(DIV),"^",3)),"",2),13),$JUSTIFY(...
... $FNUMBER($SELECT($PIECE(T3,"^",7)=0!($PIECE(S1(DIV),"^",12)=0):0,1:$PIECE(T3,"^",7)/$PIECE(S1(DIV),"^",12)),"",2),13)
+7 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",7)=0!($PIECE(S1(DIV),"^",10)=0):0,1:$PIECE(T3,"^",7)/$PIECE(S1(DIV),"^",10)),"",2),13),$JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",8)=0!($PIECE(S1(DIV),"^",11)=0):0,1:$PIECE(T3,"^",8)/...
... $PIECE(S1(DIV),"^",11)),"",2),13)
End DoDot:1
+8 WRITE $JUSTIFY($FNUMBER($PIECE(T3,"^",7),"",2),13),$JUSTIFY($FNUMBER($PIECE(T3,"^",8),"",2),13),$JUSTIFY($FNUMBER($PIECE(T3,"^",9),"",2),13)
+9 IF ANS="A"
WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",9)=0!($PIECE(T2,"^",13)=0):0,1:$PIECE(T3,"^",9)/$PIECE(T2,"^",13)),"",2),13)
+10 IF '$TEST
WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",9)=0!($PIECE(S2(DIV),"^",13)=0):0,1:$PIECE(T3,"^",9)/$PIECE(S2(DIV),"^",13)),"",2),13)
+11 WRITE !!!?17,"FINISHED PRINTING ON: "
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
WRITE Y
+12 WRITE @IOF
+13 QUIT
