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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCSSUM 3828 printed Dec 13, 2024@01:43:53 Page 2
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
