PSXCSMN1 ;BIR/JMB-Drug Cost by Drug for One Month CONTINUED ;10 Feb 2000 1:46 PM
;;2.0;CMOP;**22,38**;11 Apr 97
PRINT S $P(PSXDLN,"=",132)="" I $D(PSXID) S PSXDGID=PSXID D NAME^PSXCSUTL
S Y=PSXBDTH X ^DD("DD") S PSXBDTR=Y D NOW^%DTC S Y=% X ^DD("DD") S PSXRUN=Y
;Prints report if no data found
I '$D(^TMP($J)) D HD W !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<" G EX
;If no data found, loop thru ^TMP global
F PSXFAC=0:0 S PSXFAC=$O(^TMP($J,PSXFAC)) Q:'+PSXFAC S (PSXCNT,PSXCOST,PSXQTY,PSXTOT)=0 D D SUB
.K PSXSUB S PSXDV="",PSXCNT=1 F S PSXDV=$O(^TMP($J,PSXFAC,PSXDV)) Q:PSXDV="" S PSXSUB(PSXDV)="0^0^0^0^" D:'$D(PSXID)!($D(PSXID)&(PSXCNT=1)) HD S PSXCNT=2 D D:'$D(PSXID) SUBDV
..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),PSXCNT=PSXCNT+$P(Y,"^"),PSXCOST=PSXCOST+$P(Y,"^",2),PSXQTY=PSXQTY+$P(Y,"^",3)
...S $P(PSXSUB(PSXDV),"^")=$P(PSXSUB(PSXDV),"^")+$P(Y,"^"),$P(PSXSUB(PSXDV),"^",2)=$P(PSXSUB(PSXDV),"^",2)+$P(Y,"^",2),$P(PSXSUB(PSXDV),"^",3)=$P(PSXSUB(PSXDV),"^",3)+$P(Y,"^",3)
...S PSXAVCST=$P(Y,"^",2)/$P(Y,"^",3)
...W:'$D(PSXID) !,PSXNAM,?50,$J($P(Y,"^"),6,0),?65,$J($P(Y,"^",3),6,0)
...W:'$D(PSXID) ?75,$J($P(Y,"^",2),10,2),?95,$J(PSXAVCST,8,3),?120,$P(Y,"^",4)
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 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),Y=$$GET1^DIQ(4,Y,.01)
S PSXFACN=$S($G(Y)]"":Y,1:"UNKNOWN") K X,Y S PSXPG=PSXPG+1
W:PSXPG>1 @IOF W !,"PRINTED: ",PSXRUN,?121,"PAGE: "_PSXPG
W !?47,"MONTHLY DRUG COST REPORT FOR "_$S('$D(^TMP($J)):"ALL",1:PSXFACN),!?(132-$L(PSXBDTR)/2),PSXBDTR,!
W:'$D(PSXID) ?(90-$L(+$G(PSXRF))-$L(+$G(PSXMC))/2),"MINIMUM REFILLS OF "_+$G(PSXRF)_" AT A MINIMUM COST OF $"_+$G(PSXMC)
W:$D(PSXID) ?(128-$L(PSXNAM)/2),"FOR "_PSXNAM
W !,"DIVISION: "_$S($G(PSXTOT)!('$D(^TMP($J))):"ALL",1:PSXDV)
W !!,?51,"TOTAL",?65,"TOTAL",?80,"TOTAL" W:'$G(PSXTOT) ?91,"AVG COST per"
W ! W:$G(PSXTOT)!($D(PSXID)) "DIVISION" W:'$G(PSXTOT)&('$D(PSXID)) "DRUG"
W ?50,"FILLED",?64,"QUANTITY",?81,"COST" W:'PSXTOT ?91,"DISPENSE UNIT"
W ?125,"N/F",!,PSXDLN
Q
SUBDV ;Division subtotal
W !?47,"----------",?62,"----------",?76,"----------"
W !,"DIVISION TOTAL",?49,$J($P(PSXSUB(PSXDV),"^"),7,0),?64,$J($P(PSXSUB(PSXDV),"^",3),7,0),?75,$J($P(PSXSUB(PSXDV),"^",2),10,2),!
Q
SUB ;Facility grand total
G:$G(PSXSPDV)&($G(PSXID)'="") ONE S PSXCNTDV=0,PSXX="" F S PSXX=$O(PSXSUB(PSXX)) Q:PSXX="" S PSXCNTDV=PSXCNTDV+1
G:PSXCNTDV&($G(PSXID)'="") ONE
S PSXTOT=1 D:$Y+4>IOSL HD D:'$D(PSXID) HD S PSXTOT="0^0^0^0^",PSXX="" F S PSXX=$O(PSXSUB(PSXX)) Q:PSXX="" D
.S $P(PSXTOT,"^")=$P(PSXTOT,"^")+$P(PSXSUB(PSXX),"^"),$P(PSXTOT,"^",2)=$P(PSXTOT,"^",2)+$P(PSXSUB(PSXX),"^",2),$P(PSXTOT,"^",3)=$P(PSXTOT,"^",3)+$P(PSXSUB(PSXX),"^",3)
.W !,PSXX,?50,$J($P(PSXSUB(PSXX),"^"),6,0),?64,$J($P(PSXSUB(PSXX),"^",3),6,0),?75,$J($P(PSXSUB(PSXX),"^",2),10,2)
D:$Y+4>IOSL HD W !?47,"----------",?61,"----------",?75,"----------"
W !,"FACILITY TOTAL",?50,$J($P(PSXTOT,"^"),6,0),?63,$J($P(PSXTOT,"^",3),7,0),?75,$J($P(PSXTOT,"^",2),10,2)
Q
ONE ;Print if facility has only 1 division
S PSXX="",PSXX=$O(PSXSUB(PSXX)) W !,PSXX,?50,$J($P(PSXSUB(PSXX),"^"),6,0),?65,$J($P(PSXSUB(PSXX),"^",3),6,0),?75,$J($P(PSXSUB(PSXX),"^",2),10,2)
S PSXAVCST=$P(PSXSUB(PSXX),"^",2)/$P(PSXSUB(PSXX),"^",3) W ?91,$J(PSXAVCST,8,3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCSMN1 3538 printed Dec 13, 2024@01:43:51 Page 2
PSXCSMN1 ;BIR/JMB-Drug Cost by Drug for One Month CONTINUED ;10 Feb 2000 1:46 PM
+1 ;;2.0;CMOP;**22,38**;11 Apr 97
PRINT SET $PIECE(PSXDLN,"=",132)=""
IF $DATA(PSXID)
SET PSXDGID=PSXID
DO NAME^PSXCSUTL
+1 SET Y=PSXBDTH
XECUTE ^DD("DD")
SET PSXBDTR=Y
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PSXRUN=Y
+2 ;Prints report if no data found
+3 IF '$DATA(^TMP($JOB))
DO HD
WRITE !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<"
GOTO EX
+4 ;If no data found, loop thru ^TMP global
+5 FOR PSXFAC=0:0
SET PSXFAC=$ORDER(^TMP($JOB,PSXFAC))
if '+PSXFAC
QUIT
SET (PSXCNT,PSXCOST,PSXQTY,PSXTOT)=0
Begin DoDot:1
+6 KILL PSXSUB
SET PSXDV=""
SET PSXCNT=1
FOR
SET PSXDV=$ORDER(^TMP($JOB,PSXFAC,PSXDV))
if PSXDV=""
QUIT
SET PSXSUB(PSXDV)="0^0^0^0^"
if '$DATA(PSXID)!($DATA(PSXID)&(PSXCNT=1))
DO HD
SET PSXCNT=2
Begin DoDot:2
+7 SET PSXNAM=""
FOR
SET PSXNAM=$ORDER(^TMP($JOB,PSXFAC,PSXDV,PSXNAM))
if PSXNAM=""
QUIT
Begin DoDot:3
+8 if ($Y+4)>IOSL
DO HD
SET Y=^TMP($JOB,PSXFAC,PSXDV,PSXNAM)
SET PSXCNT=PSXCNT+$PIECE(Y,"^")
SET PSXCOST=PSXCOST+$PIECE(Y,"^",2)
SET PSXQTY=PSXQTY+$PIECE(Y,"^",3)
+9 SET $PIECE(PSXSUB(PSXDV),"^")=$PIECE(PSXSUB(PSXDV),"^")+$PIECE(Y,"^")
SET $PIECE(PSXSUB(PSXDV),"^",2)=$PIECE(PSXSUB(PSXDV),"^",2)+$PIECE(Y,"^",2)
SET $PIECE(PSXSUB(PSXDV),"^",3)=$PIECE(PSXSUB(PSXDV),"^",3)+$PIECE(Y,"^",3)
+10 SET PSXAVCST=$PIECE(Y,"^",2)/$PIECE(Y,"^",3)
+11 if '$DATA(PSXID)
WRITE !,PSXNAM,?50,$JUSTIFY($PIECE(Y,"^"),6,0),?65,$JUSTIFY($PIECE(Y,"^",3),6,0)
+12 if '$DATA(PSXID)
WRITE ?75,$JUSTIFY($PIECE(Y,"^",2),10,2),?95,$JUSTIFY(PSXAVCST,8,3),?120,$PIECE(Y,"^",4)
End DoDot:3
End DoDot:2
if '$DATA(PSXID)
DO SUBDV
End DoDot:1
DO SUB
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 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)
SET Y=$$GET1^DIQ(4,Y,.01)
+2 SET PSXFACN=$SELECT($GET(Y)]"":Y,1:"UNKNOWN")
KILL X,Y
SET PSXPG=PSXPG+1
+3 if PSXPG>1
WRITE @IOF
WRITE !,"PRINTED: ",PSXRUN,?121,"PAGE: "_PSXPG
+4 WRITE !?47,"MONTHLY DRUG COST REPORT FOR "_$SELECT('$DATA(^TMP($JOB)):"ALL",1:PSXFACN),!?(132-$LENGTH(PSXBDTR)/2),PSXBDTR,!
+5 if '$DATA(PSXID)
WRITE ?(90-$LENGTH(+$GET(PSXRF))-$LENGTH(+$GET(PSXMC))/2),"MINIMUM REFILLS OF "_+$GET(PSXRF)_" AT A MINIMUM COST OF $"_+$GET(PSXMC)
+6 if $DATA(PSXID)
WRITE ?(128-$LENGTH(PSXNAM)/2),"FOR "_PSXNAM
+7 WRITE !,"DIVISION: "_$SELECT($GET(PSXTOT)!('$DATA(^TMP($JOB))):"ALL",1:PSXDV)
+8 WRITE !!,?51,"TOTAL",?65,"TOTAL",?80,"TOTAL"
if '$GET(PSXTOT)
WRITE ?91,"AVG COST per"
+9 WRITE !
if $GET(PSXTOT)!($DATA(PSXID))
WRITE "DIVISION"
if '$GET(PSXTOT)&('$DATA(PSXID))
WRITE "DRUG"
+10 WRITE ?50,"FILLED",?64,"QUANTITY",?81,"COST"
if 'PSXTOT
WRITE ?91,"DISPENSE UNIT"
+11 WRITE ?125,"N/F",!,PSXDLN
+12 QUIT
SUBDV ;Division subtotal
+1 WRITE !?47,"----------",?62,"----------",?76,"----------"
+2 WRITE !,"DIVISION TOTAL",?49,$JUSTIFY($PIECE(PSXSUB(PSXDV),"^"),7,0),?64,$JUSTIFY($PIECE(PSXSUB(PSXDV),"^",3),7,0),?75,$JUSTIFY($PIECE(PSXSUB(PSXDV),"^",2),10,2),!
+3 QUIT
SUB ;Facility grand total
+1 if $GET(PSXSPDV)&($GET(PSXID)'="")
GOTO ONE
SET PSXCNTDV=0
SET PSXX=""
FOR
SET PSXX=$ORDER(PSXSUB(PSXX))
if PSXX=""
QUIT
SET PSXCNTDV=PSXCNTDV+1
+2 if PSXCNTDV&($GET(PSXID)'="")
GOTO ONE
+3 SET PSXTOT=1
if $Y+4>IOSL
DO HD
if '$DATA(PSXID)
DO HD
SET PSXTOT="0^0^0^0^"
SET PSXX=""
FOR
SET PSXX=$ORDER(PSXSUB(PSXX))
if PSXX=""
QUIT
Begin DoDot:1
+4 SET $PIECE(PSXTOT,"^")=$PIECE(PSXTOT,"^")+$PIECE(PSXSUB(PSXX),"^")
SET $PIECE(PSXTOT,"^",2)=$PIECE(PSXTOT,"^",2)+$PIECE(PSXSUB(PSXX),"^",2)
SET $PIECE(PSXTOT,"^",3)=$PIECE(PSXTOT,"^",3)+$PIECE(PSXSUB(PSXX),"^",3)
+5 WRITE !,PSXX,?50,$JUSTIFY($PIECE(PSXSUB(PSXX),"^"),6,0),?64,$JUSTIFY($PIECE(PSXSUB(PSXX),"^",3),6,0),?75,$JUSTIFY($PIECE(PSXSUB(PSXX),"^",2),10,2)
End DoDot:1
+6 if $Y+4>IOSL
DO HD
WRITE !?47,"----------",?61,"----------",?75,"----------"
+7 WRITE !,"FACILITY TOTAL",?50,$JUSTIFY($PIECE(PSXTOT,"^"),6,0),?63,$JUSTIFY($PIECE(PSXTOT,"^",3),7,0),?75,$JUSTIFY($PIECE(PSXTOT,"^",2),10,2)
+8 QUIT
ONE ;Print if facility has only 1 division
+1 SET PSXX=""
SET PSXX=$ORDER(PSXSUB(PSXX))
WRITE !,PSXX,?50,$JUSTIFY($PIECE(PSXSUB(PSXX),"^"),6,0),?65,$JUSTIFY($PIECE(PSXSUB(PSXX),"^",3),6,0),?75,$JUSTIFY($PIECE(PSXSUB(PSXX),"^",2),10,2)
+2 SET PSXAVCST=$PIECE(PSXSUB(PSXX),"^",2)/$PIECE(PSXSUB(PSXX),"^",3)
WRITE ?91,$JUSTIFY(PSXAVCST,8,3)
+3 QUIT
