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