PSXCSDC ;BIR/JMB-Drug Cost by Drug Report ;[ 04/08/97 2:06 PM ]
;;2.0;CMOP;;11 Apr 97
;Gets specific drug (if desired), facility, div, & date range to print
D IDYN^PSXCSUTL G:$G(PSXOUT) EX1^PSXCSDC1
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^PSXCSDC1
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 Drug",ZTRTN="START^PSXCSDC" F PSXG="PSXBDT","PSXEDT","PSXDV","PSXFAC","PSXID" S:$D(@PSXG) ZTSAVE(PSXG)=""
I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report queued to print!",! K ZTSK G EX^PSXCSDC1
START ;Determines which loop to use based on user input
U IO K ^TMP($J),PSXSPDV S:$D(PSXDV) PSXSPDV=1 D @($S($G(PSXFAC)=""&($G(PSXDV)=""):"ALL",$G(PSXFAC)'=""&($G(PSXDV)=""):"ALLDV",$G(PSXFAC)'=""&($G(PSXDV)'=""):"DATE",1:"EX^PSXCSDC1")) G PRINT^PSXCSDC1
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)) F PSXPSDT=(PSXBDT-1):0:PSXEDT S PSXPSDT=$O(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXPSDT)) Q:'PSXPSDT!(PSXPSDT>PSXEDT) D
.F PSXDG=0:0 S PSXDG=$O(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXPSDT,1,PSXDG)) Q:'PSXDG D:$D(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXPSDT,1,PSXDG,0)) DRUG
Q
DRUG ;Gets drug data & sets ^TMP nodes
S PSXDGID=$P(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXPSDT,1,PSXDG,0),"^")
I $G(PSXID)'="" Q:PSXDGID'=PSXID
D NAME^PSXCSUTL S PSXDV=$E(PSXDV,1,25),Y=^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXPSDT,1,PSXDG,0)
I '$D(^TMP($J,PSXFAC,PSXDV,PSXNAM)) S ^TMP($J,PSXFAC,PSXDV,PSXNAM)=$P(Y,"^",2)_"^"_$P(Y,"^",3)_"^"_$P(Y,"^",4)_"^"_$P(Y,"^",5) Q
S $P(^TMP($J,PSXFAC,PSXDV,PSXNAM),"^")=$P(^(PSXNAM),"^")+$P(Y,"^",2),$P(^TMP($J,PSXFAC,PSXDV,PSXNAM),"^",2)=$P(^(PSXNAM),"^",2)+$P(Y,"^",3),$P(^TMP($J,PSXFAC,PSXDV,PSXNAM),"^",3)=$P(^(PSXNAM),"^",3)+$P(Y,"^",4)
S $P(^TMP($J,PSXFAC,PSXDV,PSXNAM),"^",4)=$P(^(PSXNAM),"^",4)+$P(Y,"^",5)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCSDC 2283 printed Nov 22, 2024@16:53:56 Page 2
PSXCSDC ;BIR/JMB-Drug Cost by Drug Report ;[ 04/08/97 2:06 PM ]
+1 ;;2.0;CMOP;;11 Apr 97
+2 ;Gets specific drug (if desired), facility, div, & date range to print
+3 DO IDYN^PSXCSUTL
if $GET(PSXOUT)
GOTO EX1^PSXCSDC1
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^PSXCSDC1
+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 Drug"
SET ZTRTN="START^PSXCSDC"
FOR PSXG="PSXBDT","PSXEDT","PSXDV","PSXFAC","PSXID"
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^PSXCSDC1
START ;Determines which loop to use based on user input
+1 USE IO
KILL ^TMP($JOB),PSXSPDV
if $DATA(PSXDV)
SET PSXSPDV=1
DO @($SELECT($GET(PSXFAC)=""&($GET(PSXDV)=""):"ALL",$GET(PSXFAC)'=""&($GET(PSXDV)=""):"ALLDV",$GET(PSXFAC)'=""&($GET(PSXDV)'=""):"DATE",1:"EX^PSXCSDC1"))
GOTO PRINT^PSXCSDC1
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 SET PSXIDV=$ORDER(^PSX(552.5,PSXFAC,1,"B",PSXDV,0))
FOR PSXPSDT=(PSXBDT-1):0:PSXEDT
SET PSXPSDT=$ORDER(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXPSDT))
if 'PSXPSDT!(PSXPSDT>PSXEDT)
QUIT
Begin DoDot:1
+2 FOR PSXDG=0:0
SET PSXDG=$ORDER(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXPSDT,1,PSXDG))
if 'PSXDG
QUIT
if $DATA(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXPSDT,1,PSXDG,0))
DO DRUG
End DoDot:1
+3 QUIT
DRUG ;Gets drug data & sets ^TMP nodes
+1 SET PSXDGID=$PIECE(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXPSDT,1,PSXDG,0),"^")
+2 IF $GET(PSXID)'=""
if PSXDGID'=PSXID
QUIT
+3 DO NAME^PSXCSUTL
SET PSXDV=$EXTRACT(PSXDV,1,25)
SET Y=^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXPSDT,1,PSXDG,0)
+4 IF '$DATA(^TMP($JOB,PSXFAC,PSXDV,PSXNAM))
SET ^TMP($JOB,PSXFAC,PSXDV,PSXNAM)=$PIECE(Y,"^",2)_"^"_$PIECE(Y,"^",3)_"^"_$PIECE(Y,"^",4)_"^"_$PIECE(Y,"^",5)
QUIT
+5 SET $PIECE(^TMP($JOB,PSXFAC,PSXDV,PSXNAM),"^")=$PIECE(^(PSXNAM),"^")+$PIECE(Y,"^",2)
SET $PIECE(^TMP($JOB,PSXFAC,PSXDV,PSXNAM),"^",2)=$PIECE(^(PSXNAM),"^",2)+$PIECE(Y,"^",3)
SET $PIECE(^TMP($JOB,PSXFAC,PSXDV,PSXNAM),"^",3)=$PIECE(^(PSXNAM),"^",3)+$PIECE(Y,"^",4)
+6 SET $PIECE(^TMP($JOB,PSXFAC,PSXDV,PSXNAM),"^",4)=$PIECE(^(PSXNAM),"^",4)+$PIECE(Y,"^",5)
+7 QUIT
