- 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
- 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
