- PSOCST7 ;BHAM ISC/SAB - DRUG COSTS BY CLASSIFICATION ; 08/19/92 9:02
- ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- BEG W ! S %DT("A")="BEGINNING DATE: ",%DT="AEP" D ^%DT G:"^"[X EX G:Y<0 BEG S (%DT(0),BEGDATE)=Y
- EN W ! S %DT("A")="ENDING DATE: " D ^%DT G:"^"[X EX G:Y<0 EN S ENDDATE=Y
- EN1 F G=0:0 W !,"Do you want to look at data concerning a specific classification" S %=1 D YN^DICN Q:% I %Y["?" D YN^PSOUTLA G EN1
- G:%=-1 EN1 I %=2 S IFN=0 G DEV
- S DIC(0)="AEQM",DIC="^PS(50.5,",DIC("A")="Select CLASSIFICATION: " D ^DIC K DIC G:Y<0 EX S IFN=1,CLA=+Y
- DEV K %ZIS,ZTSK,IOP,POP S PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSOION D ^%ZIS K POP,PSOION G EX
- I $G(IOM)<132 D ^%ZISC W $C(7),!!,"Printout must be 132 columns.",!! G DEV
- K PSOION I $D(IO("Q")) S ZTDESC="DRUG COST BY CLASSIFICATION",ZTRTN="START^PSOCST7" F G="BEGDATE","ENDDATE","CLA","IFN" S:$D(@G) ZTSAVE(G)=""
- I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"REPORT QUEUED TO PRINT !!",! K ZTSK G EX
- START U IO K ^TMP($J) S PAGE=1 F PSDT=(BEGDATE-1):0:ENDDATE S PSDT=$O(^PSCST(PSDT)) Q:'PSDT!(PSDT>ENDDATE) D @$S('IFN:"PAT",1:"CLA")
- S (CNT,CNTO,CNTR,COST)=0,CLAX="" D HD F I=0:0 S CLAX=$O(^TMP($J,CLAX)) Q:CLAX="" D PRT2
- D HD:($Y+2)>IOSL W !!,"TOTAL",?50,$J(CNTO,6),?57,$J(CNTR,6),?66,$J(CNT,6),?75,$J(COST,10,2),?91 S AVG=$S(CNT=0:0,1:(COST/CNT)) W $J(AVG,10,2)
- EX W ! W:$E(IOST)'["C" @IOF D ^%ZISC K ^TMP($J),%,AVG,BEGDATE,CNT,CNTO,CNTR,COST,DIC,ENDDATE,FILLS,I,IFN,%Y,PAGE,CLAX,POP,PSDT,UTL,G,CLA,X,Y,%DT,ZTRTN,ZTDESC S:$D(ZTQUEUED) ZTREQ="@" Q
- Q
- PRT2 D HD:($Y+4)>IOSL S Y=^TMP($J,CLAX),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)
- W !,CLAX,?50,$J($P(Y,"^",2),6),?57,$J($P(Y,"^",3),6),?66,$J(FILLS,6),?75,$J($P(Y,"^",4),10,2),?91 S AVG=$S(FILLS=0:0,1:($P(Y,"^",4)/FILLS)) W $J(AVG,10,2)
- Q
- PAT F CLA=0:0 S CLA=$O(^PSCST(PSDT,"C",CLA)) Q:'CLA D CLA
- Q
- CLA I $D(^PSCST(PSDT,"C",CLA,0)) S X=^(0) D STORE
- Q
- STORE Q:'$D(^PS(50.605,CLA,0)) S CLAX=$P(^(0),"^") S:'$D(^TMP($J,CLAX)) ^TMP($J,CLAX)="^0^0^0"
- S UTL=^TMP($J,CLAX),^TMP($J,CLAX)="^"_($P(UTL,"^",2)+$P(X,"^",2))_"^"_($P(UTL,"^",3)+$P(X,"^",3))_"^"_($P(UTL,"^",4)+$P(X,"^",4))
- Q
- HD I PAGE>1,$E(IOST)="C" W !!,$C(7),"(Enter ""^"" TO Halt) " R X:DTIME S:'$T X="^" G:X="^" EX
- W @IOF,!,"Drug Costs by Classification for the period: " S Y=BEGDATE D DT^DIO2 W " to " S Y=ENDDATE D DT^DIO2 W !,"RUN DATE: " S Y=DT D DT^DIO2 W ?72,"PAGE ",PAGE S PAGE=PAGE+1
- W !!,?51,"ORIGN",?57,"TOTAL",?80,"TOTAL",?93,"AVG COST",!,"CLASSIFICATION",?51,"FILLS",?57,"REFILLS",?68,"FILLS",?80,"COST",?93,"per FILL"
- W ! F I=1:1:110 W "-"
- Q
- PSOCST7 ;BHAM ISC/SAB - DRUG COSTS BY CLASSIFICATION ; 08/19/92 9:02
- +1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- BEG WRITE !
- SET %DT("A")="BEGINNING DATE: "
- SET %DT="AEP"
- DO ^%DT
- IF "^"[X
- GOTO EX
- IF Y<0
- GOTO BEG
- SET (%DT(0),BEGDATE)=Y
- EN WRITE !
- SET %DT("A")="ENDING DATE: "
- DO ^%DT
- IF "^"[X
- GOTO EX
- IF Y<0
- GOTO EN
- SET ENDDATE=Y
- EN1 FOR G=0:0
- WRITE !,"Do you want to look at data concerning a specific classification"
- SET %=1
- DO YN^DICN
- IF %
- QUIT
- IF %Y["?"
- DO YN^PSOUTLA
- GOTO EN1
- +1 IF %=-1
- GOTO EN1
- IF %=2
- SET IFN=0
- GOTO DEV
- +2 SET DIC(0)="AEQM"
- SET DIC="^PS(50.5,"
- SET DIC("A")="Select CLASSIFICATION: "
- DO ^DIC
- KILL DIC
- IF Y<0
- GOTO EX
- SET IFN=1
- SET CLA=+Y
- DEV KILL %ZIS,ZTSK,IOP,POP
- SET PSOION=ION
- SET %ZIS="QM"
- DO ^%ZIS
- KILL %ZIS
- IF POP
- SET IOP=PSOION
- DO ^%ZIS
- KILL POP,PSOION
- GOTO EX
- +1 IF $GET(IOM)<132
- DO ^%ZISC
- WRITE $CHAR(7),!!,"Printout must be 132 columns.",!!
- GOTO DEV
- +2 KILL PSOION
- IF $DATA(IO("Q"))
- SET ZTDESC="DRUG COST BY CLASSIFICATION"
- SET ZTRTN="START^PSOCST7"
- FOR G="BEGDATE","ENDDATE","CLA","IFN"
- IF $DATA(@G)
- SET ZTSAVE(G)=""
- +3 IF $TEST
- KILL IO("Q")
- DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"REPORT QUEUED TO PRINT !!",!
- KILL ZTSK
- GOTO EX
- START USE IO
- KILL ^TMP($JOB)
- SET PAGE=1
- FOR PSDT=(BEGDATE-1):0:ENDDATE
- SET PSDT=$ORDER(^PSCST(PSDT))
- IF 'PSDT!(PSDT>ENDDATE)
- QUIT
- DO @$SELECT('IFN:"PAT",1:"CLA")
- +1 SET (CNT,CNTO,CNTR,COST)=0
- SET CLAX=""
- DO HD
- FOR I=0:0
- SET CLAX=$ORDER(^TMP($JOB,CLAX))
- IF CLAX=""
- QUIT
- DO PRT2
- +2 IF ($Y+2)>IOSL
- DO HD
- WRITE !!,"TOTAL",?50,$JUSTIFY(CNTO,6),?57,$JUSTIFY(CNTR,6),?66,$JUSTIFY(CNT,6),?75,$JUSTIFY(COST,10,2),?91
- SET AVG=$SELECT(CNT=0:0,1:(COST/CNT))
- WRITE $JUSTIFY(AVG,10,2)
- EX WRITE !
- IF $EXTRACT(IOST)'["C"
- WRITE @IOF
- DO ^%ZISC
- KILL ^TMP($JOB),%,AVG,BEGDATE,CNT,CNTO,CNTR,COST,DIC,ENDDATE,FILLS,I,IFN,%Y,PAGE,CLAX,POP,PSDT,UTL,G,CLA,X,Y,%DT,ZTRTN,ZTDESC
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +1 QUIT
- PRT2 IF ($Y+4)>IOSL
- DO HD
- SET Y=^TMP($JOB,CLAX)
- 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)
- +1 WRITE !,CLAX,?50,$JUSTIFY($PIECE(Y,"^",2),6),?57,$JUSTIFY($PIECE(Y,"^",3),6),?66,$JUSTIFY(FILLS,6),?75,$JUSTIFY($PIECE(Y,"^",4),10,2),?91
- SET AVG=$SELECT(FILLS=0:0,1:($PIECE(Y,"^",4)/FILLS))
- WRITE $JUSTIFY(AVG,10,2)
- +2 QUIT
- PAT FOR CLA=0:0
- SET CLA=$ORDER(^PSCST(PSDT,"C",CLA))
- IF 'CLA
- QUIT
- DO CLA
- +1 QUIT
- CLA IF $DATA(^PSCST(PSDT,"C",CLA,0))
- SET X=^(0)
- DO STORE
- +1 QUIT
- STORE IF '$DATA(^PS(50.605,CLA,0))
- QUIT
- SET CLAX=$PIECE(^(0),"^")
- IF '$DATA(^TMP($JOB,CLAX))
- SET ^TMP($JOB,CLAX)="^0^0^0"
- +1 SET UTL=^TMP($JOB,CLAX)
- SET ^TMP($JOB,CLAX)="^"_($PIECE(UTL,"^",2)+$PIECE(X,"^",2))_"^"_($PIECE(UTL,"^",3)+$PIECE(X,"^",3))_"^"_($PIECE(UTL,"^",4)+$PIECE(X,"^",4))
- +2 QUIT
- HD IF PAGE>1
- IF $EXTRACT(IOST)="C"
- WRITE !!,$CHAR(7),"(Enter ""^"" TO Halt) "
- READ X:DTIME
- IF '$TEST
- SET X="^"
- IF X="^"
- GOTO EX
- +1 WRITE @IOF,!,"Drug Costs by Classification for the period: "
- SET Y=BEGDATE
- DO DT^DIO2
- WRITE " to "
- SET Y=ENDDATE
- DO DT^DIO2
- WRITE !,"RUN DATE: "
- SET Y=DT
- DO DT^DIO2
- WRITE ?72,"PAGE ",PAGE
- SET PAGE=PAGE+1
- +2 WRITE !!,?51,"ORIGN",?57,"TOTAL",?80,"TOTAL",?93,"AVG COST",!,"CLASSIFICATION",?51,"FILLS",?57,"REFILLS",?68,"FILLS",?80,"COST",?93,"per FILL"
- +3 WRITE !
- FOR I=1:1:110
- WRITE "-"
- +4 QUIT
