- PSOMGM31 ;BHAM ISC/JMB - MONTHLY MANAGEMENT PRESCRIPTION COSTS REPORT CONTD ; 3/19/93
- ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- SUB ;PRINT SUB TOTALS
- I 'PRT D MON^PSOMGMN3 W !?13 F K=1:1:9 W $J("=======",13)
- W !,$S('PRT:"DIV TOTAL",1:$E($P(^PS(59,DIV,0),"^"),1,8)),?13,$J($FN($S($P(S2(DIV),"^",4)=0!($P(S3(DIV),"^",2)=0):0,1:$P(S3(DIV),"^",2)/$P(S2(DIV),"^",4)),"",2),13)
- W $J($FN($S($P(S2(DIV),"^",3)=0!($P(S3(DIV),"^",3)=0):0,1:$P(S3(DIV),"^",3)/$P(S2(DIV),"^",3)),"",2),13),$J($FN($S($P(S3(DIV),"^",7)=0!($P(S1(DIV),"^",12)=0):0,1:($P(S3(DIV),"^",7)/$P(S1(DIV),"^",12))),"",2),13)
- W $J($FN($S($P(S3(DIV),"^",7)=0!($P(S1(DIV),"^",10)=0):0,1:$P(S3(DIV),"^",7)/$P(S1(DIV),"^",10)),"",2),13),$J($FN($S($P(S3(DIV),"^",8)=0!($P(S1(DIV),"^",11)=0):0,1:$P(S3(DIV),"^",8)/$P(S1(DIV),"^",11)),"",2),13)
- W $J($FN($P(S3(DIV),"^",7),"",2),13),$J($FN($P(S3(DIV),"^",8),"",2),13),$J($FN($P(S3(DIV),"^",9),"",2),13),$J($FN($S($P(S3(DIV),"^",9)=0!($P(S2(DIV),"^",13)=0):0,1:$P(S3(DIV),"^",9)/$P(S2(DIV),"^",13)),"",2),13)
- Q
- TOT ;PRINT GRAND TOTALS
- S PRT=1 D RPT^PSOMGMN3 F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV D SUB
- 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)
- .W $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)
- .W $J($FN($S($P(T3,"^",8)=0!($P(T1,"^",11)=0):0,1:$P(T3,"^",8)/$P(T1,"^",11)),"",2),13)
- ;
- E W $J($FN($S($P(S2(DIV),"^",4)=0!($P(T3,"^",2)=0):0,1:($P(SUBS(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)
- .W $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)
- .W $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)
- I QTR W !!,"QUARTER "_QTR_" OUTPATIENT PRESCRIPTION COSTS/PATIENT = $"_$FN($S(QTCST=0!(QTMREQ=0):0,1:QTCST/QTMREQ),"",2)
- E W !!,"QUARTERLY OUTPATIENT PRESCRIPTION COST/PATIENT NOT AVAILABLE"
- W !!!?17,"FINISHED PRINTING ON: " D NOW^%DTC S Y=% X ^DD("DD") W Y,@IOF
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOMGM31 2745 printed Feb 18, 2025@23:57:28 Page 2
- PSOMGM31 ;BHAM ISC/JMB - MONTHLY MANAGEMENT PRESCRIPTION COSTS REPORT CONTD ; 3/19/93
- +1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- SUB ;PRINT SUB TOTALS
- +1 IF 'PRT
- DO MON^PSOMGMN3
- WRITE !?13
- FOR K=1:1:9
- WRITE $JUSTIFY("=======",13)
- +2 WRITE !,$SELECT('PRT:"DIV TOTAL",1:$EXTRACT($PIECE(^PS(59,DIV,0),"^"),1,8)),?13,$JUSTIFY($FNUMBER($SELECT($PIECE(S2(DIV),"^",4)=0!($PIECE(S3(DIV),"^",2)=0):0,1:$PIECE(S3(DIV),"^",2)/$PIECE(S2(DIV),"^",4)),"",2),13)
- +3 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(S2(DIV),"^",3)=0!($PIECE(S3(DIV),"^",3)=0):0,1:$PIECE(S3(DIV),"^",3)/$PIECE(S2(DIV),"^",3)),"",2),13),$JUSTIFY(...
- ... $FNUMBER($SELECT($PIECE(S3(DIV),"^",7)=0!($PIECE(S1(DIV),"^",12)=0):0,1:($PIECE(S3(DIV),"^",7)/$PIECE(S1(DIV),"^",12))),"",2),13)
- +4 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(S3(DIV),"^",7)=0!($PIECE(S1(DIV),"^",10)=0):0,1:$PIECE(S3(DIV),"^",7)/$PIECE(S1(DIV),"^",10)),"",2),13),$JUSTIFY(...
- ... $FNUMBER($SELECT($PIECE(S3(DIV),"^",8)=0!($PIECE(S1(DIV),"^",11)=0):0,1:$PIECE(S3(DIV),"^",8)/$PIECE(S1(DIV),"^",11)),"",2),13)
- +5 WRITE $JUSTIFY($FNUMBER($PIECE(S3(DIV),"^",7),"",2),13),$JUSTIFY($FNUMBER($PIECE(S3(DIV),"^",8),"",2),13),$JUSTIFY($FNUMBER(...
- ... $PIECE(S3(DIV),"^",9),"",2),13),$JUSTIFY($FNUMBER($SELECT($PIECE(S3(DIV),"^",9)=0!($PIECE(S2(DIV),"^",13)=0):0,1:$PIECE(S3(DIV),"^",9)/$PIECE(S2(DIV),"^",13)),"",2),13)
- +6 QUIT
- TOT ;PRINT GRAND TOTALS
- +1 SET PRT=1
- DO RPT^PSOMGMN3
- FOR DIV=0:0
- SET DIV=$ORDER(^PS(59,DIV))
- if 'DIV
- QUIT
- DO SUB
- +2 WRITE !?13
- FOR K=1:1:9
- WRITE $JUSTIFY("=======",13)
- +3 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
- +4 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T2,"^",3)=0!($PIECE(T3,"^",3)=0):0,1:$PIECE(T3,"^",3)/$PIECE(T2,"^",3)),"",2),13)
- +5 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",7)=0!($PIECE(T1,"^",12)=0):0,1:$PIECE(T3,"^",7)/$PIECE(T1,"^",12)),"",2),13)
- +6 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",7)=0!($PIECE(T1,"^",10)=0):0,1:$PIECE(T3,"^",7)/$PIECE(T1,"^",10)),"",2),13)
- +7 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",8)=0!($PIECE(T1,"^",11)=0):0,1:$PIECE(T3,"^",8)/$PIECE(T1,"^",11)),"",2),13)
- End DoDot:1
- +8 ;
- +9 IF '$TEST
- WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(S2(DIV),"^",4)=0!($PIECE(T3,"^",2)=0):0,1:($PIECE(SUBS(DIV),"^",4)*$PIECE(T3,"^",2))/$PIECE(S2(DIV),"^",4)),"",2),13)
- Begin DoDot:1
- +10 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)
- +11 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",7)=0!($PIECE(S1(DIV),"^",12)=0):0,1:$PIECE(T3,"^",7)/$PIECE(S1(DIV),"^",12)),"",2),13)
- +12 WRITE $JUSTIFY($FNUMBER($SELECT($PIECE(T3,"^",7)=0!($PIECE(S1(DIV),"^",10)=0):0,1:$PIECE(T3,"^",7)/$PIECE(S1(DIV),"^",10)),"",2),13)
- +13 WRITE $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
- +14 WRITE $JUSTIFY($FNUMBER($PIECE(T3,"^",7),"",2),13),$JUSTIFY($FNUMBER($PIECE(T3,"^",8),"",2),13),$JUSTIFY($FNUMBER($PIECE(T3,"^",9),"",2),13)
- +15 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)
- +16 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)
- +17 IF QTR
- WRITE !!,"QUARTER "_QTR_" OUTPATIENT PRESCRIPTION COSTS/PATIENT = $"_$FNUMBER($SELECT(QTCST=0!(QTMREQ=0):0,1:QTCST/QTMREQ),"",2)
- +18 IF '$TEST
- WRITE !!,"QUARTERLY OUTPATIENT PRESCRIPTION COST/PATIENT NOT AVAILABLE"
- +19 WRITE !!!?17,"FINISHED PRINTING ON: "
- DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- WRITE Y,@IOF
- +20 QUIT