PSXCSSUM.m

PSXCSSUM ;BIR/JMB-Drug Cost by Facility Report ;08 Oct 97  5:31 PM

 ;;2.0;CMOP;**38**;11 Apr 97

 ;Get user input

 D BEG^PSXCSUTL G:$G(PSXOUT) EX1

DEV ;Device handling

 W ! K %ZIS,ZTSK,IOP,POP S %ZIS("B")="",PSXION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSXION D ^%ZIS K POP,PSXION G EX

 I $E(IOST)["C"!($G(IOM)<132) W !!,"Printout must be sent to a 132-column printer!",!! G DEV

 K PSXION I $D(IO("Q")) S ZTDESC="CMOP Drug Cost by Facility",ZTRTN="START^PSXCSSUM" F PSXG="PSXBDT","PSXEDT","PSXDV","PSXFAC" S:$D(@PSXG) ZTSAVE(PSXG)=""

 I  K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report queued to print!!",! K ZTSK G EX

START ;Queued entry point

 U IO K ^TMP($J) S $P(PSXDLN,"=",89)="",$P(PSXSLN,"-",89)=""

 ;Determines loop to use based on user input

 D @($S($G(PSXFAC)=""&($G(PSXDV)=""):"ALL",$G(PSXFAC)'=""&($G(PSXDV)=""):"ALLDV",$G(PSXFAC)'=""&($G(PSXDV)'=""):"DATE",1:"EX")) G PRINT

ALL ;Loops thru all facilities

 F PSXFAC=0:0 S PSXFAC=$O(^PSX(552.5,PSXFAC)) Q:'PSXFAC  S PSXDV="" F  S PSXDV=$O(^PSX(552.5,PSXFAC,1,"B",PSXDV)) Q:PSXDV=""  D DATE

 Q

ALLDV ;Loops thru all divisions

 S PSXDV="" F  S PSXDV=$O(^PSX(552.5,PSXFAC,1,"B",PSXDV)) Q:PSXDV=""  D DATE

 Q

DATE ;Entry point if specific fac & div OR this is called by ALL & ALLDV

 S PSXIDV=$O(^PSX(552.5,PSXFAC,1,"B",PSXDV,0)) ; this line had been commented out INP,Cache3 birm

 ;I $E(PSXBDT,6,7)="01" S PSXBDT=(PSXBDT)-1 ;this line from cache3 INP, do not know origin

 F PSXDT=(PSXBDT-1):0:PSXEDT S PSXDT=$O(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT)) Q:'PSXDT!(PSXDT>PSXEDT)  D

 .F PSXDG=0:0 S PSXDG=$O(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT,1,PSXDG)) Q:'PSXDG  D:$D(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT,1,PSXDG,0)) DRUG

 Q

DRUG ;Gets drug data & sets ^TMP nodes

 S PSXDV=$E(PSXDV,1,25),Y=^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT,1,PSXDG,0)

 I '$D(^TMP($J,PSXFAC,PSXDV)) S ^TMP($J,PSXFAC,PSXDV)=$P(Y,"^",2)_"^"_$P(Y,"^",3)_"^"_$P(Y,"^",4) Q

 S $P(^TMP($J,PSXFAC,PSXDV),"^")=$P(^(PSXDV),"^")+$P(Y,"^",2),$P(^TMP($J,PSXFAC,PSXDV),"^",2)=$P(^(PSXDV),"^",2)+$P(Y,"^",3),$P(^TMP($J,PSXFAC,PSXDV),"^",3)=$P(^(PSXDV),"^",3)+$P(Y,"^",4)

 Q

PRINT ;Print report if no data found

 I '$D(^TMP($J)) D HD W !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<" Q

 D NOW^%DTC S Y=% X ^DD("DD") S PSXRUN=Y,PSXPG=1,Y=PSXBDT X ^DD("DD") S PSXBDTR=Y,Y=PSXEDT X ^DD("DD") S PSXEDTR=Y

 ;If data found, loops thru ^TMP global

 F PSXFAC=0:0 S PSXFAC=$O(^TMP($J,PSXFAC)) Q:'PSXFAC  S (PSXCNT,PSXCNTO,PSXCNTR,PSXCOST)=0 D HD D

 .S PSXDV="",PSXDVCNT=0 F  S PSXDV=$O(^TMP($J,PSXFAC,PSXDV)) Q:PSXDV=""  S PSXDVCNT=PSXDVCNT+1 D

 ..D HD:($Y+4)>IOSL S Y=^TMP($J,PSXFAC,PSXDV),PSXFLS=($P(Y,"^")+$P(Y,"^",2)),PSXCNT=PSXCNT+PSXFLS,PSXCNTO=PSXCNTO+$P(Y,"^"),PSXCNTR=PSXCNTR+$P(Y,"^",2),PSXCOST=PSXCOST+$P(Y,"^",3)

 ..W !,PSXDV,?29,$J($P(Y,"^"),6,0),?41,$J($P(Y,"^",2),6,0),?51,$J(PSXFLS,6,0),?62,$J($P(Y,"^",3),10,2),?78 S PSXAVG=$S(PSXFLS=0:0,1:($P(Y,"^",3)/PSXFLS)) W $J(PSXAVG,10,2)

 .I PSXDVCNT>1 W !!,PSXSLN,!,"TOTAL",?29,$J(PSXCNTO,6),?41,$J(PSXCNTR,6),?51,$J(PSXCNT,6),?62,$J(PSXCOST,10,2),?78 S PSXAVG=$S(PSXCNT=0:0,1:(PSXCOST/PSXCNT)) W $J(PSXAVG,10,2)

EX W !,@IOF D ^%ZISC

EX1 G END^PSXCSUTL

HD ;N X,Y S X=PSXFAC,DIC(0)="MNZ",DIC=4 S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S PSXFACN=$S($G(Y(0,0))]"":Y(0,0),1:"UNKNOWN") K DIC,X,Y ;****DOD L1

 N X,Y S X=PSXFAC,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S Y=$$IEN^XUMF(4,AGNCY,X)

 S Y=$$GET1^DIQ(4,Y,.01) S PSXFACN=$S($G(Y)]"":Y,1:"UNKNOWN") K X,Y

 W:PSXPG>1 @IOF W !,"PRINTED: ",PSXRUN,?(84-$L(PSXPG)),"PAGE ",PSXPG S PSXPG=PSXPG+1

 W !!?(62-$L(PSXFACN)/2),"DRUG COSTS BY FACILITY FOR ",PSXFACN,!?(85-$L(PSXBDTR)-$L(PSXEDTR)/2),PSXBDTR," TO ",PSXEDTR

 W !!,?30,"ORIGN",?52,"TOTAL",?67,"TOTAL",?80,"AVG COST",!,"DIVISION",?30,"FILLS",?40,"REFILLS",?52,"FILLS",?68,"COST",?80,"per FILL",!,PSXDLN

 Q

PSXCSSUM  ;BIR/JMB-Drug Cost by Facility Report ;08 Oct 97  5:31 PM

 +1       ;;2.0;CMOP;**38**;11 Apr 97

 +2       ;Get user input

 +3        DO BEG^PSXCSUTL

           IF $GET(PSXOUT)

               GOTO EX1

DEV       ;Device handling

 +1        WRITE !

           KILL %ZIS,ZTSK,IOP,POP

           SET %ZIS("B")=""

           SET PSXION=ION

           SET %ZIS="QM"

           DO ^%ZIS

           KILL %ZIS

           IF POP

               SET IOP=PSXION

               DO ^%ZIS

               KILL POP,PSXION

               GOTO EX

 +2        IF $EXTRACT(IOST)["C"!($GET(IOM)<132)

               WRITE !!,"Printout must be sent to a 132-column printer!",!!

               GOTO DEV

 +3        KILL PSXION

           IF $DATA(IO("Q"))

               SET ZTDESC="CMOP Drug Cost by Facility"

               SET ZTRTN="START^PSXCSSUM"

               FOR PSXG="PSXBDT","PSXEDT","PSXDV","PSXFAC"

                   IF $DATA(@PSXG)

                       SET ZTSAVE(PSXG)=""

 +4       IF $TEST

               KILL IO("Q")

               DO ^%ZTLOAD

               IF $DATA(ZTSK)

                   WRITE !,"Report queued to print!!",!

               KILL ZTSK

               GOTO EX

START     ;Queued entry point

 +1        USE IO

           KILL ^TMP($JOB)

           SET $PIECE(PSXDLN,"=",89)=""

           SET $PIECE(PSXSLN,"-",89)=""

 +2       ;Determines loop to use based on user input

 +3        DO @($SELECT($GET(PSXFAC)=""&($GET(PSXDV)=""):"ALL",$GET(PSXFAC)'=""&($GET(PSXDV)=""):"ALLDV",$GET(PSXFAC)'=""&($GET(PSXDV)'=""):"DATE",1:"EX"))

           GOTO PRINT

ALL       ;Loops thru all facilities

 +1        FOR PSXFAC=0:0

               SET PSXFAC=$ORDER(^PSX(552.5,PSXFAC))

               IF 'PSXFAC

                   QUIT 

               SET PSXDV=""

               FOR 

                   SET PSXDV=$ORDER(^PSX(552.5,PSXFAC,1,"B",PSXDV))

                   IF PSXDV=""

                       QUIT 

                   DO DATE

 +2        QUIT 

ALLDV     ;Loops thru all divisions

 +1        SET PSXDV=""

           FOR 

               SET PSXDV=$ORDER(^PSX(552.5,PSXFAC,1,"B",PSXDV))

               IF PSXDV=""

                   QUIT 

               DO DATE

 +2        QUIT 

DATE      ;Entry point if specific fac & div OR this is called by ALL & ALLDV

 +1       ; this line had been commented out INP,Cache3 birm

           SET PSXIDV=$ORDER(^PSX(552.5,PSXFAC,1,"B",PSXDV,0))

 +2       ;I $E(PSXBDT,6,7)="01" S PSXBDT=(PSXBDT)-1 ;this line from cache3 INP, do not know origin

 +3        FOR PSXDT=(PSXBDT-1):0:PSXEDT

               SET PSXDT=$ORDER(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT))

               IF 'PSXDT!(PSXDT>PSXEDT)

                   QUIT 

               Begin DoDot:1

 +4                FOR PSXDG=0:0

                       SET PSXDG=$ORDER(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT,1,PSXDG))

                       IF 'PSXDG

                           QUIT 

                       IF $DATA(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT,1,PSXDG,0))

                           DO DRUG

               End DoDot:1

 +5        QUIT 

DRUG      ;Gets drug data & sets ^TMP nodes

 +1        SET PSXDV=$EXTRACT(PSXDV,1,25)

           SET Y=^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT,1,PSXDG,0)

 +2        IF '$DATA(^TMP($JOB,PSXFAC,PSXDV))

               SET ^TMP($JOB,PSXFAC,PSXDV)=$PIECE(Y,"^",2)_"^"_$PIECE(Y,"^",3)_"^"_$PIECE(Y,"^",4)

               QUIT 

 +3        SET $PIECE(^TMP($JOB,PSXFAC,PSXDV),"^")=$PIECE(^(PSXDV),"^")+$PIECE(Y,"^",2)

           SET $PIECE(^TMP($JOB,PSXFAC,PSXDV),"^",2)=$PIECE(^(PSXDV),"^",2)+$PIECE(Y,"^",3)

           SET $PIECE(^TMP($JOB,PSXFAC,PSXDV),"^",3)=$PIECE(^(PSXDV),"^",3)+$PIECE(Y,"^",4)

 +4        QUIT 

PRINT     ;Print report if no data found

 +1        IF '$DATA(^TMP($JOB))

               DO HD

               WRITE !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<"

               QUIT 

 +2        DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

           SET PSXRUN=Y

           SET PSXPG=1

           SET Y=PSXBDT

           XECUTE ^DD("DD")

           SET PSXBDTR=Y

           SET Y=PSXEDT

           XECUTE ^DD("DD")

           SET PSXEDTR=Y

 +3       ;If data found, loops thru ^TMP global

 +4        FOR PSXFAC=0:0

               SET PSXFAC=$ORDER(^TMP($JOB,PSXFAC))

               IF 'PSXFAC

                   QUIT 

               SET (PSXCNT,PSXCNTO,PSXCNTR,PSXCOST)=0

               DO HD

               Begin DoDot:1

 +5                SET PSXDV=""

                   SET PSXDVCNT=0

                   FOR 

                       SET PSXDV=$ORDER(^TMP($JOB,PSXFAC,PSXDV))

                       IF PSXDV=""

                           QUIT 

                       SET PSXDVCNT=PSXDVCNT+1

                       Begin DoDot:2

 +6                        IF ($Y+4)>IOSL

                               DO HD

                           SET Y=^TMP($JOB,PSXFAC,PSXDV)

                           SET PSXFLS=($PIECE(Y,"^")+$PIECE(Y,"^",2))

                           SET PSXCNT=PSXCNT+PSXFLS

                           SET PSXCNTO=PSXCNTO+$PIECE(Y,"^")

                           SET PSXCNTR=PSXCNTR+$PIECE(Y,"^",2)

                           SET PSXCOST=PSXCOST+$PIECE(Y,"^",3)

 +7                        WRITE !,PSXDV,?29,$JUSTIFY($PIECE(Y,"^"),6,0),?41,$JUSTIFY($PIECE(Y,"^",2),6,0),?51,$JUSTIFY(PSXFLS,6,0),?62,$JUSTIFY($PIECE(Y,"^",3),10,2),?78

                           SET PSXAVG=$SELECT(PSXFLS=0:0,1:($PIECE(Y,"^",3)/PSXFLS))

                           WRITE $JUSTIFY(PSXAVG,10,2)

                       End DoDot:2

 +8                IF PSXDVCNT>1

                       WRITE !!,PSXSLN,!,"TOTAL",?29,$JUSTIFY(PSXCNTO,6),?41,$JUSTIFY(PSXCNTR,6),?51,$JUSTIFY(PSXCNT,6),?62,$JUSTIFY(PSXCOST,10,2),?78

                       SET PSXAVG=$SELECT(PSXCNT=0:0,1:(PSXCOST/PSXCNT))

                       WRITE $JUSTIFY(PSXAVG,10,2)

               End DoDot:1

EX         WRITE !,@IOF

           DO ^%ZISC

EX1        GOTO END^PSXCSUTL

HD        ;N X,Y S X=PSXFAC,DIC(0)="MNZ",DIC=4 S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S PSXFACN=$S($G(Y(0,0))]"":Y(0,0),1:"UNKNOWN") K DIC,X,Y ;****DOD L1

 +1        NEW X,Y

           SET X=PSXFAC

           SET AGNCY="VASTANUM"

           IF $DATA(^PSX(552,"D",X))

               SET X=$EXTRACT(X,2,99)

               SET AGNCY="DMIS"

           SET Y=$$IEN^XUMF(4,AGNCY,X)

 +2        SET Y=$$GET1^DIQ(4,Y,.01)

           SET PSXFACN=$SELECT($GET(Y)]"":Y,1:"UNKNOWN")

           KILL X,Y

 +3        IF PSXPG>1

               WRITE @IOF

           WRITE !,"PRINTED: ",PSXRUN,?(84-$LENGTH(PSXPG)),"PAGE ",PSXPG

           SET PSXPG=PSXPG+1

 +4        WRITE !!?(62-$LENGTH(PSXFACN)/2),"DRUG COSTS BY FACILITY FOR ",PSXFACN,!?(85-$LENGTH(PSXBDTR)-$LENGTH(PSXEDTR)/2),PSXBDTR," TO ",PSXEDTR

 +5        WRITE !!,?30,"ORIGN",?52,"TOTAL",?67,"TOTAL",?80,"AVG COST",!,"DIVISION",?30,"FILLS",?40,"REFILLS",?52,"FILLS",?68,"COST",?80,"per FILL",!,PSXDLN

 +6        QUIT