- PSOCST12 ;BHAM ISC/SAB - DIVISION BY DRUG COST ; 08/19/92 8:37
- ;;7.0;OUTPATIENT PHARMACY;**31**;DEC 1997
- ;External Ref. to ^PS(59, is supp. by DBIA# 212
- ;External Ref. to ^PSDRUG( is supp. by DBIA# 221
- BEG S RP=12 D HDC^PSOCSTX F D CDT^PSOCSTX Q:$G(CTR) D DVS^PSOCSTX Q:$G(CTR) S RP=0 D CTP^PSOCSTX Q:$G(CTR) I RP=0 D DEV Q
- D EX Q
- DEV D DVC^PSOCSTX Q:$G(CTR)
- K PSOION I $D(IO("Q")) S ZTDESC="DRUG COSTS BY DIVISION BY DRUG",ZTRTN="START^PSOCST12" D PAS^PSOCSTX
- I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"REPORT QUEUED TO PRINT !!",! D EX Q
- START U IO K ^TMP($J) F PSDT=(BEGDATE-1):0:ENDDATE S PSDT=$O(^PSCST(PSDT)) Q:'PSDT!(PSDT>ENDDATE) D @$S('IFN:"DIV",1:"DRUG")
- S DIVX="" F S DIVX=$O(^TMP($J,DIVX)) Q:DIVX="" S DRUGX="" F S DRUGX=$O(^TMP($J,DIVX,DRUGX)) Q:DRUGX="" D STR
- S (QTY,CNT,CNTO,CNTR,COST)=0,DIVX="" I $O(^TMP($J,DIVX))']"" D HD,HDN^PSOCSTX Q
- F S DIVX=$O(^TMP($J,DIVX)) Q:DIVX=""!($G(CTR)) S DRUGX="" D HD Q:$G(CTR) F S DRUGX=$O(^TMP($J,DIVX,DRUGX)) D:DRUGX="" SUB Q:DRUGX="" D PRT3 Q:$G(CTR)
- I 'CTR,'IFN D HD:($Y+4)>IOSL W !! D PUL W !,"Total for all divisions ",?50,$J(CNTO,6),?57,$J(CNTR,6),?66,$J(CNT,6),?77,$J(QTY,8,2),?88,$J(COST,10,2),?104 S AVG=$S('CNT:0,1:(COST/CNT)) W $J(AVG,10,2) D PUL W !
- EX D EX^PSOCSTX K QTY Q
- HD D HD0^PSOCSTX Q:$G(CTR)
- W !,?50,"Orgin",?68,"Total",?77,"Total",?90,"Total",?105,"Avg Cost",!,"Drug",?50,"Fills",?57,"Refills",?68,"Fills",?77,"Qty",?90,"Cost",?105,"per Fill"
- W ! F I=1:1:130 W "-"
- W:DIVX]"" !,?5,"Division: ",DIVX
- Q
- PUL W !,?50,"------",?57,"------",?66,"------",?77,"--------",?88,"----------",?104,"----------"
- Q
- PRT3 D HD:($Y+4)>IOSL Q:$G(CTR) S Y=^TMP($J,DIVX,DRUGX),FILLS=($P(Y,"^",2)+$P(Y,"^",3)),CNT=CNT+FILLS,CNTO=CNTO+$P(Y,"^",2),CNTR=CNTR+$P(Y,"^",3),COST=COST+$P(Y,"^",4),QTY=QTY+$P(Y,"^",5)
- W !,DRUGX,?50,$J($P(Y,"^",2),6),?57,$J($P(Y,"^",3),6),?66,$J(FILLS,6),?77,$J($P(Y,"^",5),8,2),?88,$J($P(Y,"^",4),10,2),?104 S AVG=$S('FILLS:0,1:($P(Y,"^",4)/FILLS)) W $J(AVG,10,2)
- Q
- DIV F DIV=0:0 S DIV=$O(^PSCST(PSDT,"V",DIV)) Q:'DIV D DRUG
- Q
- DRUG F DRUG=0:0 S DRUG=$O(^PSCST(PSDT,"V",DIV,"D",DRUG)) Q:'DRUG I $D(^(DRUG,0)) S X=^(0) D STORE
- Q
- STORE S DIVX=$S($D(^PS(59,+DIV,0)):$P(^(0),"^"),1:"UNKNOWN")
- Q:'$D(^PSDRUG(DRUG,0)) S DRUGX=$P(^(0),"^") S:'$D(^TMP($J,DIVX,DRUGX)) ^TMP($J,DIVX,DRUGX)="^0^0^0^0",^TMP($J,DIVX)="^0^0^0^0^0"
- S UTL=^TMP($J,DIVX,DRUGX),^TMP($J,DIVX,DRUGX)="^"_($P(UTL,"^",2)+$P(X,"^",2))_"^"_($P(UTL,"^",3)+$P(X,"^",3))_"^"_($P(UTL,"^",4)+$P(X,"^",4))_"^"_($P(UTL,"^",5)+$P(X,"^",5))
- Q
- STR S $P(^TMP($J,DIVX),"^",2)=($P(^TMP($J,DIVX),"^",2)+$P(^TMP($J,DIVX,DRUGX),"^",2)),$P(^TMP($J,DIVX),"^",3)=($P(^TMP($J,DIVX),"^",3)+$P(^TMP($J,DIVX,DRUGX),"^",3))
- S $P(^TMP($J,DIVX),"^",4)=($P(^TMP($J,DIVX),"^",4)+$P(^TMP($J,DIVX,DRUGX),"^",4)),$P(^TMP($J,DIVX),"^",5)=($P(^TMP($J,DIVX),"^",5)+$P(^TMP($J,DIVX,DRUGX),"^",2)+$P(^TMP($J,DIVX,DRUGX),"^",3))
- S $P(^TMP($J,DIVX),"^",6)=($P(^TMP($J,DIVX),"^",6)+$P(^TMP($J,DIVX,DRUGX),"^",5))
- Q
- SUB ;sub-totals per division
- D PUL
- W !,"Total for "_DIVX,?50,$J($P(^TMP($J,DIVX),"^",2),6),?57,$J($P(^(DIVX),"^",3),6),?66,$J($P(^(DIVX),"^",5),6),?77,$J($P(^(DIVX),"^",6),8,2),?88,$J($P(^(DIVX),"^",4),10,2),?104,$J($P(^(DIVX),"^",4)/$P(^(DIVX),"^",5),10,2)
- D PUL Q
- PSOCST12 ;BHAM ISC/SAB - DIVISION BY DRUG COST ; 08/19/92 8:37
- +1 ;;7.0;OUTPATIENT PHARMACY;**31**;DEC 1997
- +2 ;External Ref. to ^PS(59, is supp. by DBIA# 212
- +3 ;External Ref. to ^PSDRUG( is supp. by DBIA# 221
- BEG SET RP=12
- DO HDC^PSOCSTX
- FOR
- DO CDT^PSOCSTX
- IF $GET(CTR)
- QUIT
- DO DVS^PSOCSTX
- IF $GET(CTR)
- QUIT
- SET RP=0
- DO CTP^PSOCSTX
- IF $GET(CTR)
- QUIT
- IF RP=0
- DO DEV
- QUIT
- +1 DO EX
- QUIT
- DEV DO DVC^PSOCSTX
- IF $GET(CTR)
- QUIT
- +1 KILL PSOION
- IF $DATA(IO("Q"))
- SET ZTDESC="DRUG COSTS BY DIVISION BY DRUG"
- SET ZTRTN="START^PSOCST12"
- DO PAS^PSOCSTX
- +2 IF $TEST
- KILL IO("Q")
- DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"REPORT QUEUED TO PRINT !!",!
- DO EX
- QUIT
- START USE IO
- KILL ^TMP($JOB)
- FOR PSDT=(BEGDATE-1):0:ENDDATE
- SET PSDT=$ORDER(^PSCST(PSDT))
- IF 'PSDT!(PSDT>ENDDATE)
- QUIT
- DO @$SELECT('IFN:"DIV",1:"DRUG")
- +1 SET DIVX=""
- FOR
- SET DIVX=$ORDER(^TMP($JOB,DIVX))
- IF DIVX=""
- QUIT
- SET DRUGX=""
- FOR
- SET DRUGX=$ORDER(^TMP($JOB,DIVX,DRUGX))
- IF DRUGX=""
- QUIT
- DO STR
- +2 SET (QTY,CNT,CNTO,CNTR,COST)=0
- SET DIVX=""
- IF $ORDER(^TMP($JOB,DIVX))']""
- DO HD
- DO HDN^PSOCSTX
- QUIT
- +3 FOR
- SET DIVX=$ORDER(^TMP($JOB,DIVX))
- IF DIVX=""!($GET(CTR))
- QUIT
- SET DRUGX=""
- DO HD
- IF $GET(CTR)
- QUIT
- FOR
- SET DRUGX=$ORDER(^TMP($JOB,DIVX,DRUGX))
- IF DRUGX=""
- DO SUB
- IF DRUGX=""
- QUIT
- DO PRT3
- IF $GET(CTR)
- QUIT
- +4 IF 'CTR
- IF 'IFN
- IF ($Y+4)>IOSL
- DO HD
- WRITE !!
- DO PUL
- WRITE !,"Total for all divisions ",?50,$JUSTIFY(CNTO,6),?57,$JUSTIFY(CNTR,6),?66,$JUSTIFY(CNT,6),?77,$JUSTIFY(QTY,8,2),?88,$JUSTIFY(COST,10,2),?104
- SET AVG=$SELECT('CNT:0,1:(COST/CNT))
- WRITE $JUSTIFY(AVG,10,2)
- DO PUL
- WRITE !
- EX DO EX^PSOCSTX
- KILL QTY
- QUIT
- HD DO HD0^PSOCSTX
- IF $GET(CTR)
- QUIT
- +1 WRITE !,?50,"Orgin",?68,"Total",?77,"Total",?90,"Total",?105,"Avg Cost",!,"Drug",?50,"Fills",?57,"Refills",?68,"Fills",?77,"Qty",?90,"Cost",?105,"per Fill"
- +2 WRITE !
- FOR I=1:1:130
- WRITE "-"
- +3 IF DIVX]""
- WRITE !,?5,"Division: ",DIVX
- +4 QUIT
- PUL WRITE !,?50,"------",?57,"------",?66,"------",?77,"--------",?88,"----------",?104,"----------"
- +1 QUIT
- PRT3 IF ($Y+4)>IOSL
- DO HD
- IF $GET(CTR)
- QUIT
- SET Y=^TMP($JOB,DIVX,DRUGX)
- SET FILLS=($PIECE(Y,"^",2)+$PIECE(Y,"^",3))
- SET CNT=CNT+FILLS
- SET CNTO=CNTO+$PIECE(Y,"^",2)
- SET CNTR=CNTR+$PIECE(Y,"^",3)
- SET COST=COST+$PIECE(Y,"^",4)
- SET QTY=QTY+$PIECE(Y,"^",5)
- +1 WRITE !,DRUGX,?50,$JUSTIFY($PIECE(Y,"^",2),6),?57,$JUSTIFY($PIECE(Y,"^",3),6),?66,$JUSTIFY(FILLS,6),?77,$JUSTIFY($PIECE(Y,"^",5),8,2),?88,$JUSTIFY($PIECE(Y,"^",4),10,2),?104
- SET AVG=$SELECT('FILLS:0,1:($PIECE(Y,"^",4)/FILLS))
- WRITE $JUSTIFY(AVG,10,2)
- +2 QUIT
- DIV FOR DIV=0:0
- SET DIV=$ORDER(^PSCST(PSDT,"V",DIV))
- IF 'DIV
- QUIT
- DO DRUG
- +1 QUIT
- DRUG FOR DRUG=0:0
- SET DRUG=$ORDER(^PSCST(PSDT,"V",DIV,"D",DRUG))
- IF 'DRUG
- QUIT
- IF $DATA(^(DRUG,0))
- SET X=^(0)
- DO STORE
- +1 QUIT
- STORE SET DIVX=$SELECT($DATA(^PS(59,+DIV,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- +1 IF '$DATA(^PSDRUG(DRUG,0))
- QUIT
- SET DRUGX=$PIECE(^(0),"^")
- IF '$DATA(^TMP($JOB,DIVX,DRUGX))
- SET ^TMP($JOB,DIVX,DRUGX)="^0^0^0^0"
- SET ^TMP($JOB,DIVX)="^0^0^0^0^0"
- +2 SET UTL=^TMP($JOB,DIVX,DRUGX)
- SET ^TMP($JOB,DIVX,DRUGX)="^"_($PIECE(UTL,"^",2)+$PIECE(X,"^",2))_"^"_($PIECE(UTL,"^",3)+$PIECE(X,"^",3))_"^"_($PIECE(UTL,"^",4)+$PIECE(X,"^",4))_"^"_($PIECE(UTL,"^",5)+$PIECE(X,"^",5))
- +3 QUIT
- STR SET $PIECE(^TMP($JOB,DIVX),"^",2)=($PIECE(^TMP($JOB,DIVX),"^",2)+$PIECE(^TMP($JOB,DIVX,DRUGX),"^",2))
- SET $PIECE(^TMP($JOB,DIVX),"^",3)=($PIECE(^TMP($JOB,DIVX),"^",3)+$PIECE(^TMP($JOB,DIVX,DRUGX),"^",3))
- +1 SET $PIECE(^TMP($JOB,DIVX),"^",4)=($PIECE(^TMP($JOB,DIVX),"^",4)+$PIECE(^TMP($JOB,DIVX,DRUGX),"^",4))
- SET $PIECE(^TMP($JOB,DIVX),"^",5)=($PIECE(^TMP($JOB,DIVX),"^",5)+$PIECE(^TMP($JOB,DIVX,DRUGX),"^",2)+$PIECE(^TMP($JOB,DIVX,DRUGX),"^",3))
- +2 SET $PIECE(^TMP($JOB,DIVX),"^",6)=($PIECE(^TMP($JOB,DIVX),"^",6)+$PIECE(^TMP($JOB,DIVX,DRUGX),"^",5))
- +3 QUIT
- SUB ;sub-totals per division
- +1 DO PUL
- +2 WRITE !,"Total for "_DIVX,?50,$JUSTIFY($PIECE(^TMP($JOB,DIVX),"^",2),6),?57,$JUSTIFY($PIECE(^(DIVX),"^",3),6),?66,$JUSTIFY(...
- ... $PIECE(^(DIVX),"^",5),6),?77,$JUSTIFY($PIECE(^(DIVX),"^",6),8,2),?88,$JUSTIFY($PIECE(^(DIVX),"^",4),10,2),?104,$JUSTIFY($PIECE(^(DIVX),"^",4)/$PIECE(^(DIVX),"^",5),10,2)
- +3 DO PUL
- QUIT
