PSXCSDC1 ;BIR/JMB-Drug Cost by Drug Report-CONTINUED ;04/08/97 2:06 PM
;;2.0;CMOP;**38**;11 Apr 97
PRINT D NOW^%DTC S Y=% X ^DD("DD") S PSXRUN=Y
;Sets tab stops based on if specific/all drugs is selected by user
I '$D(PSXID) S PSXTH1=37,PSXTH2=49,PSXTH3=62,PSXTH4=80,PSXTH5=89,PSXTH6=100,PSXT1=36,PSXT2=50,PSXT3=61,PSXT4=75,PSXT5=87,PSXT6=102,PSXLGN=115
I $D(PSXID) S PSXTH=27,PSXTH1=61,PSXTH2=71,PSXTH3=81,PSXTH4=91,PSXTH5=104,PSXTH6=118,PSXT=27,PSXT1=60,PSXT2=71,PSXT3=80,PSXT4=89,PSXT5=102,PSXT6=122,PSXLGN=132
S PSXLGN=$S($D(PSXID):132,1:115),$P(PSXDLN,"=",PSXLGN)="",$P(PSXSLN,"-",PSXLGN)="",PSXPG=1
D NOW^%DTC S Y=% X ^DD("DD") S PSXRUN=Y,Y=PSXBDT X ^DD("DD") S PSXBDTR=Y,Y=PSXEDT X ^DD("DD") S PSXEDTR=Y
;If no data found, prints header & "no data found"
I '$D(^TMP($J)) D NODATA G EX
;If data found, loops thru ^TMP global & prints report
F PSXFAC=0:0 S PSXFAC=$O(^TMP($J,PSXFAC)) Q:'+PSXFAC S (PSXCNT,PSXCNTO,PSXCNTR,PSXCOST,PSXTOT)=0 D:$D(PSXID) HD D D SUB^PSXCSDC2
.K PSXSUB S PSXDV="" F S PSXDV=$O(^TMP($J,PSXFAC,PSXDV)) Q:PSXDV="" S PSXSUB(PSXDV)="0^0^0^0^0^" D:'$D(PSXID) HD D D:'$D(PSXID) SUBDV^PSXCSDC2
..S PSXNAM="" F S PSXNAM=$O(^TMP($J,PSXFAC,PSXDV,PSXNAM)) Q:PSXNAM="" D
...D:($Y+4)>IOSL HD S Y=^TMP($J,PSXFAC,PSXDV,PSXNAM),PSXFLS=($P(Y,"^")+$P(Y,"^",2)),PSXCNT=PSXCNT+PSXFLS,PSXCNTO=PSXCNTO+$P(Y,"^"),PSXCNTR=PSXCNTR+$P(Y,"^",2),PSXCOST=PSXCOST+$P(Y,"^",3)
...W:'$D(PSXID) !,$E(PSXNAM,1,36) W:$D(PSXID) !,$E(PSXDV,1,25),?27,$E(PSXNAM,1,30)
...W ?PSXT1,$J($P(Y,"^"),6,0),?PSXT2,$J($P(Y,"^",2),6,0),?PSXT3,$J(PSXFLS,6,0),?PSXT4,$J($P(Y,"^",3),10,2),?PSXT5 S PSXAVG=$S(PSXFLS=0:0,1:($P(Y,"^",3)/PSXFLS)) W $J(PSXAVG,10,2)
...S PSXAVCST=$P(Y,"^",3)/$P(Y,"^",4) W ?PSXT6,$J(PSXAVCST,8,3),?122,$P(Y,"^",5) ; Y,"^",5 added as cmop-leav local code
...S $P(PSXSUB(PSXDV),"^")=$P(PSXSUB(PSXDV),"^")+$P(Y,"^"),$P(PSXSUB(PSXDV),"^",2)=$P(PSXSUB(PSXDV),"^",2)+$P(Y,"^",2)
...S $P(PSXSUB(PSXDV),"^",3)=$P(PSXSUB(PSXDV),"^",3)+PSXFLS,$P(PSXSUB(PSXDV),"^",4)=$P(PSXSUB(PSXDV),"^",4)+$P(Y,"^",3)
...S $P(PSXSUB(PSXDV),"^",5)=$P(PSXSUB(PSXDV),"^",5)+$P(Y,"^",4)
EX W !,@IOF D ^%ZISC
EX1 K ^TMP($J) D END^PSXCSUTL Q
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 K DIC ;****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 Y=$$GET1^DIQ(4,Y,.01)
S PSXFACN=$S($G(Y)]"":Y,1:"UNKNOWN") K X,Y
W:PSXPG>1 @IOF W !,"PRINTED: ",PSXRUN,?PSXTH6,"PAGE ",PSXPG S PSXPG=PSXPG+1
W !!?(PSXLGN-18-$L(PSXFACN)/2),"DRUG COST BY DRUG FOR ",PSXFACN,!?(PSXLGN-4-$L(PSXBDTR)-$L(PSXEDTR)/2),PSXBDTR," TO ",PSXEDTR
W:'$D(PSXID) !,"DIVISION: ",$S(PSXTOT:"ALL DIVISIONS",1:PSXDV)
W !!?PSXTH1,"ORIGN",?PSXTH3,"TOTAL",?PSXTH4,"TOTAL",?PSXTH5,"AVG COST"
W ?PSXTH6,"AVG COST per"
W !
W:PSXTOT "DIVISION" W:'PSXTOT&('$D(PSXID)) "DRUG" W:$D(PSXID) "DIVISION",?40,"DRUG"
W ?PSXTH1,"FILLS",?PSXTH2,"REFILLS",?PSXTH3,"FILLS",?PSXTH4," COST",?PSXTH5,"per FILL"
W ?PSXTH6,"DISPENSE UNIT"
W !,PSXDLN
Q
NODATA ;Prints report for no data found
W !,"PRINTED: ",PSXRUN,?PSXTH6,"PAGE 1"
W !!?(PSXLGN-32),"DRUG COST BY DRUG FOR ALL FACILITIES",!?(PSXLGN-4-$L(PSXBDTR)-$L(PSXEDTR)/2),PSXBDTR," TO ",PSXEDTR
W:'$D(PSXID) !,"DIVISION: ALL DIVISIONS"
W !!?PSXTH1,"ORIGN",?PSXTH3,"TOTAL",?PSXTH4,"TOTAL",?PSXTH5,"AVG COST",!
W "DRUG" W ?PSXTH1,"FILLS",?PSXTH2,"REFILLS",?PSXTH3,"FILLS",?PSXTH4," COST",?PSXTH5,"per FILL",!,PSXDLN
W !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCSDC1 3536 printed Nov 22, 2024@16:53:57 Page 2
PSXCSDC1 ;BIR/JMB-Drug Cost by Drug Report-CONTINUED ;04/08/97 2:06 PM
+1 ;;2.0;CMOP;**38**;11 Apr 97
PRINT DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PSXRUN=Y
+1 ;Sets tab stops based on if specific/all drugs is selected by user
+2 IF '$DATA(PSXID)
SET PSXTH1=37
SET PSXTH2=49
SET PSXTH3=62
SET PSXTH4=80
SET PSXTH5=89
SET PSXTH6=100
SET PSXT1=36
SET PSXT2=50
SET PSXT3=61
SET PSXT4=75
SET PSXT5=87
SET PSXT6=102
SET PSXLGN=115
+3 IF $DATA(PSXID)
SET PSXTH=27
SET PSXTH1=61
SET PSXTH2=71
SET PSXTH3=81
SET PSXTH4=91
SET PSXTH5=104
SET PSXTH6=118
SET PSXT=27
SET PSXT1=60
SET PSXT2=71
SET PSXT3=80
SET PSXT4=89
SET PSXT5=102
SET PSXT6=122
SET PSXLGN=132
+4 SET PSXLGN=$SELECT($DATA(PSXID):132,1:115)
SET $PIECE(PSXDLN,"=",PSXLGN)=""
SET $PIECE(PSXSLN,"-",PSXLGN)=""
SET PSXPG=1
+5 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PSXRUN=Y
SET Y=PSXBDT
XECUTE ^DD("DD")
SET PSXBDTR=Y
SET Y=PSXEDT
XECUTE ^DD("DD")
SET PSXEDTR=Y
+6 ;If no data found, prints header & "no data found"
+7 IF '$DATA(^TMP($JOB))
DO NODATA
GOTO EX
+8 ;If data found, loops thru ^TMP global & prints report
+9 FOR PSXFAC=0:0
SET PSXFAC=$ORDER(^TMP($JOB,PSXFAC))
if '+PSXFAC
QUIT
SET (PSXCNT,PSXCNTO,PSXCNTR,PSXCOST,PSXTOT)=0
if $DATA(PSXID)
DO HD
Begin DoDot:1
+10 KILL PSXSUB
SET PSXDV=""
FOR
SET PSXDV=$ORDER(^TMP($JOB,PSXFAC,PSXDV))
if PSXDV=""
QUIT
SET PSXSUB(PSXDV)="0^0^0^0^0^"
if '$DATA(PSXID)
DO HD
Begin DoDot:2
+11 SET PSXNAM=""
FOR
SET PSXNAM=$ORDER(^TMP($JOB,PSXFAC,PSXDV,PSXNAM))
if PSXNAM=""
QUIT
Begin DoDot:3
+12 if ($Y+4)>IOSL
DO HD
SET Y=^TMP($JOB,PSXFAC,PSXDV,PSXNAM)
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)
+13 if '$DATA(PSXID)
WRITE !,$EXTRACT(PSXNAM,1,36)
if $DATA(PSXID)
WRITE !,$EXTRACT(PSXDV,1,25),?27,$EXTRACT(PSXNAM,1,30)
+14 WRITE ?PSXT1,$JUSTIFY($PIECE(Y,"^"),6,0),?PSXT2,$JUSTIFY($PIECE(Y,"^",2),6,0),?PSXT3,$JUSTIFY(PSXFLS,6,0),?PSXT4,$JUSTIFY($PIECE(Y,"^",3),10,2),?PSXT5
SET PSXAVG=$SELECT(PSXFLS=0:0,1:($PIECE(Y,"^",3)/PSXFLS))
WRITE $JUSTIFY(PSXAVG,10,2)
+15 ; Y,"^",5 added as cmop-leav local code
SET PSXAVCST=$PIECE(Y,"^",3)/$PIECE(Y,"^",4)
WRITE ?PSXT6,$JUSTIFY(PSXAVCST,8,3),?122,$PIECE(Y,"^",5)
+16 SET $PIECE(PSXSUB(PSXDV),"^")=$PIECE(PSXSUB(PSXDV),"^")+$PIECE(Y,"^")
SET $PIECE(PSXSUB(PSXDV),"^",2)=$PIECE(PSXSUB(PSXDV),"^",2)+$PIECE(Y,"^",2)
+17 SET $PIECE(PSXSUB(PSXDV),"^",3)=$PIECE(PSXSUB(PSXDV),"^",3)+PSXFLS
SET $PIECE(PSXSUB(PSXDV),"^",4)=$PIECE(PSXSUB(PSXDV),"^",4)+$PIECE(Y,"^",3)
+18 SET $PIECE(PSXSUB(PSXDV),"^",5)=$PIECE(PSXSUB(PSXDV),"^",5)+$PIECE(Y,"^",4)
End DoDot:3
End DoDot:2
if '$DATA(PSXID)
DO SUBDV^PSXCSDC2
End DoDot:1
DO SUB^PSXCSDC2
EX WRITE !,@IOF
DO ^%ZISC
EX1 KILL ^TMP($JOB)
DO END^PSXCSUTL
QUIT
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 K DIC ;****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 if +Y
SET Y=$$GET1^DIQ(4,Y,.01)
+3 SET PSXFACN=$SELECT($GET(Y)]"":Y,1:"UNKNOWN")
KILL X,Y
+4 if PSXPG>1
WRITE @IOF
WRITE !,"PRINTED: ",PSXRUN,?PSXTH6,"PAGE ",PSXPG
SET PSXPG=PSXPG+1
+5 WRITE !!?(PSXLGN-18-$LENGTH(PSXFACN)/2),"DRUG COST BY DRUG FOR ",PSXFACN,!?(PSXLGN-4-$LENGTH(PSXBDTR)-$LENGTH(PSXEDTR)/2),PSXBDTR," TO ",PSXEDTR
+6 if '$DATA(PSXID)
WRITE !,"DIVISION: ",$SELECT(PSXTOT:"ALL DIVISIONS",1:PSXDV)
+7 WRITE !!?PSXTH1,"ORIGN",?PSXTH3,"TOTAL",?PSXTH4,"TOTAL",?PSXTH5,"AVG COST"
+8 WRITE ?PSXTH6,"AVG COST per"
+9 WRITE !
+10 if PSXTOT
WRITE "DIVISION"
if 'PSXTOT&('$DATA(PSXID))
WRITE "DRUG"
if $DATA(PSXID)
WRITE "DIVISION",?40,"DRUG"
+11 WRITE ?PSXTH1,"FILLS",?PSXTH2,"REFILLS",?PSXTH3,"FILLS",?PSXTH4," COST",?PSXTH5,"per FILL"
+12 WRITE ?PSXTH6,"DISPENSE UNIT"
+13 WRITE !,PSXDLN
+14 QUIT
NODATA ;Prints report for no data found
+1 WRITE !,"PRINTED: ",PSXRUN,?PSXTH6,"PAGE 1"
+2 WRITE !!?(PSXLGN-32),"DRUG COST BY DRUG FOR ALL FACILITIES",!?(PSXLGN-4-$LENGTH(PSXBDTR)-$LENGTH(PSXEDTR)/2),PSXBDTR," TO ",PSXEDTR
+3 if '$DATA(PSXID)
WRITE !,"DIVISION: ALL DIVISIONS"
+4 WRITE !!?PSXTH1,"ORIGN",?PSXTH3,"TOTAL",?PSXTH4,"TOTAL",?PSXTH5,"AVG COST",!
+5 WRITE "DRUG"
WRITE ?PSXTH1,"FILLS",?PSXTH2,"REFILLS",?PSXTH3,"FILLS",?PSXTH4," COST",?PSXTH5,"per FILL",!,PSXDLN
+6 WRITE !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<"
+7 QUIT
