PSDCSL ;BIR/JPW-List Drug Name & Stats from DRUG file (#50) ; 29 Aug 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
W !!,"This report lists Drug name, order unit, price per order unit, dispense unit,",!,"dispense units per order unit, and price per dispense unit.",!
W !,"This report is designed for a 132 column format.",!!
DEV ;asks device and queueing information
K %ZIS,IOP,IO("Q"),POP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END
I $D(IO("Q")) K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSDCSL",ZTDESC="CS PHARM LIST DATA FOR DRUG STATS" D ^%ZTLOAD,HOME^%ZIS K ZTSK G END
U IO
START ;compiles and prints data for report
K ^TMP("PSDCSL",$J)
S (PG,PSDOUT)=0,%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y
S PSD="" F S PSD=$O(^PSDRUG("AIUN",PSD)) Q:PSD="" F NUM=0:0 S NUM=$O(^PSDRUG("AIUN",PSD,NUM)) Q:'NUM I $D(^PSDRUG(NUM,0)) D
.S OK=$S('$D(^PSDRUG(PSD,"I")):1,'+^("I"):1,+^("I")>DT:1,1:0) Q:'OK
.S PSDRN=$S($P(^PSDRUG(NUM,0),"^")]"":$P(^(0),"^"),1:"ZZ #"_NUM_" DRUG NAME MISSING")
.I '$D(^PSDRUG(NUM,660)) S (ORU,ORUP,ORD,ORDP,ORDU)="NO DATA"
.I $D(^PSDRUG(NUM,660)) S NODE=^PSDRUG(NUM,660),ORU=+$P(NODE,"^",2),ORU=$S(ORU:$P($G(^DIC(51.5,ORU,0)),"^"),1:"NO DATA"),ORUP=$S($P(NODE,"^",3)]"":$P(NODE,"^",3),1:"NO DATA") D
..S ORD=$S($P(NODE,"^",5)]"":$P(NODE,"^",5),1:"NO DATA"),ORDP=$S($P(NODE,"^",6)]"":$P(NODE,"^",6),1:"NO DATA"),ORDU=$S($P(NODE,"^",8)]"":$P(NODE,"^",8),1:"NO DATA")
.S ^TMP("PSDCSL",$J,PSDRN,NUM)=ORU_"^"_ORUP_"^"_ORDU_"^"_ORD_"^"_ORDP
PRINT ;prints data from ^tmp
K LN S $P(LN,"-",132)="" D HEADER
I '$D(^TMP("PSDCSL",$J)) W !!,?30,"NO DATA FOR THE DRUG FILE STATS REPORT!!",!! G DONE
S PSD="" F S PSD=$O(^TMP("PSDCSL",$J,PSD)) Q:PSD=""!(PSDOUT) D:$Y+5>IOSL HEADER F NUM=0:0 S NUM=$O(^TMP("PSDCSL",$J,PSD,NUM)) Q:'NUM!(PSDOUT) D
.W !,?2,PSD
.S NODE=$G(^TMP("PSDCSL",$J,PSD,NUM)),ORU=$P(NODE,"^"),ORUP=$P(NODE,"^",2),ORDU=$P(NODE,"^",3),ORD=$P(NODE,"^",4),ORDP=$P(NODE,"^",5)
.W ?47,$S(ORU="NO DATA":ORU,1:$J(ORU,4)),?61,$S(ORUP="NO DATA":ORUP,1:$J(ORUP,7)),?80,$S(ORDU="NO DATA":ORDU,1:$J(ORDU,6))
.W ?100,$S(ORD="NO DATA":ORD,1:$J(ORD,6)),?120,$S(ORDP="NO DATA":ORDP,1:$J(ORDP,6))
W !
DONE I $E(IOST)'="C" W @IOF
I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu" D ^DIR K DIR
END ;
K %DT,%ZIS,DA,DEA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LN,NODE,NUM,OK,ORD,ORDP,ORDU,ORU,ORUP,PG,POP,PSD,PSDRN,PSDOUT,RPDT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSK
K ^TMP("PSDCSL",$J)
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
W:$Y @IOF S PG=PG+1 W !,?45,"DRUG FILE STATS FOR CS PHARM DRUGS",!,?55,RPDT,?120,"PAGE: "_PG,!!
W ?47,"ORDER",?59,"PRICE PER",?80,"DISPENSE",?97,"DISPENSE UNITS",?118,"PRICE PER"
W !,"DRUG NAME",?47,"UNIT",?59,"ORDER UNIT",?82,"UNIT",?97,"PER ORDER UNIT",?118,"DISPENSE UNIT",!,LN,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDCSL 2993 printed Nov 22, 2024@16:55:40 Page 2
PSDCSL ;BIR/JPW-List Drug Name & Stats from DRUG file (#50) ; 29 Aug 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
+2 WRITE !!,"This report lists Drug name, order unit, price per order unit, dispense unit,",!,"dispense units per order unit, and price per dispense unit.",!
+3 WRITE !,"This report is designed for a 132 column format.",!!
DEV ;asks device and queueing information
+1 KILL %ZIS,IOP,IO("Q"),POP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
GOTO END
+2 IF $DATA(IO("Q"))
KILL IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
SET ZTRTN="START^PSDCSL"
SET ZTDESC="CS PHARM LIST DATA FOR DRUG STATS"
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
GOTO END
+3 USE IO
START ;compiles and prints data for report
+1 KILL ^TMP("PSDCSL",$JOB)
+2 SET (PG,PSDOUT)=0
SET %DT=""
SET X="T"
DO ^%DT
XECUTE ^DD("DD")
SET RPDT=Y
+3 SET PSD=""
FOR
SET PSD=$ORDER(^PSDRUG("AIUN",PSD))
if PSD=""
QUIT
FOR NUM=0:0
SET NUM=$ORDER(^PSDRUG("AIUN",PSD,NUM))
if 'NUM
QUIT
IF $DATA(^PSDRUG(NUM,0))
Begin DoDot:1
+4 SET OK=$SELECT('$DATA(^PSDRUG(PSD,"I")):1,'+^("I"):1,+^("I")>DT:1,1:0)
if 'OK
QUIT
+5 SET PSDRN=$SELECT($PIECE(^PSDRUG(NUM,0),"^")]"":$PIECE(^(0),"^"),1:"ZZ #"_NUM_" DRUG NAME MISSING")
+6 IF '$DATA(^PSDRUG(NUM,660))
SET (ORU,ORUP,ORD,ORDP,ORDU)="NO DATA"
+7 IF $DATA(^PSDRUG(NUM,660))
SET NODE=^PSDRUG(NUM,660)
SET ORU=+$PIECE(NODE,"^",2)
SET ORU=$SELECT(ORU:$PIECE($GET(^DIC(51.5,ORU,0)),"^"),1:"NO DATA")
SET ORUP=$SELECT($PIECE(NODE,"^",3)]"":$PIECE(NODE,"^",3),1:"NO DATA")
Begin DoDot:2
+8 SET ORD=$SELECT($PIECE(NODE,"^",5)]"":$PIECE(NODE,"^",5),1:"NO DATA")
SET ORDP=$SELECT($PIECE(NODE,"^",6)]"":$PIECE(NODE,"^",6),1:"NO DATA")
SET ORDU=$SELECT($PIECE(NODE,"^",8)]"":$PIECE(NODE,"^",8),1:"NO DATA")
End DoDot:2
+9 SET ^TMP("PSDCSL",$JOB,PSDRN,NUM)=ORU_"^"_ORUP_"^"_ORDU_"^"_ORD_"^"_ORDP
End DoDot:1
PRINT ;prints data from ^tmp
+1 KILL LN
SET $PIECE(LN,"-",132)=""
DO HEADER
+2 IF '$DATA(^TMP("PSDCSL",$JOB))
WRITE !!,?30,"NO DATA FOR THE DRUG FILE STATS REPORT!!",!!
GOTO DONE
+3 SET PSD=""
FOR
SET PSD=$ORDER(^TMP("PSDCSL",$JOB,PSD))
if PSD=""!(PSDOUT)
QUIT
if $Y+5>IOSL
DO HEADER
FOR NUM=0:0
SET NUM=$ORDER(^TMP("PSDCSL",$JOB,PSD,NUM))
if 'NUM!(PSDOUT)
QUIT
Begin DoDot:1
+4 WRITE !,?2,PSD
+5 SET NODE=$GET(^TMP("PSDCSL",$JOB,PSD,NUM))
SET ORU=$PIECE(NODE,"^")
SET ORUP=$PIECE(NODE,"^",2)
SET ORDU=$PIECE(NODE,"^",3)
SET ORD=$PIECE(NODE,"^",4)
SET ORDP=$PIECE(NODE,"^",5)
+6 WRITE ?47,$SELECT(ORU="NO DATA":ORU,1:$JUSTIFY(ORU,4)),?61,$SELECT(ORUP="NO DATA":ORUP,1:$JUSTIFY(ORUP,7)),?80,$SELECT(ORDU="NO DATA":ORDU,1:$JUSTIFY(ORDU,6))
+7 WRITE ?100,$SELECT(ORD="NO DATA":ORD,1:$JUSTIFY(ORD,6)),?120,$SELECT(ORDP="NO DATA":ORDP,1:$JUSTIFY(ORDP,6))
End DoDot:1
+8 WRITE !
DONE IF $EXTRACT(IOST)'="C"
WRITE @IOF
+1 IF $EXTRACT(IOST,1,2)="C-"
IF 'PSDOUT
WRITE !
KILL DIR,DIRUT
SET DIR(0)="EA"
SET DIR("A")="END OF REPORT! Press <RET> to return to the menu"
DO ^DIR
KILL DIR
END ;
+1 KILL %DT,%ZIS,DA,DEA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LN,NODE,NUM,OK,ORD,ORDP,ORDU,ORU,ORUP,PG,POP,PSD,PSDRN,PSDOUT,RPDT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSK
+2 KILL ^TMP("PSDCSL",$JOB)
+3 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
+1 IF $EXTRACT(IOST,1,2)="C-"
IF PG
WRITE !
KILL DA,DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSDOUT=1
QUIT
+2 if $Y
WRITE @IOF
SET PG=PG+1
WRITE !,?45,"DRUG FILE STATS FOR CS PHARM DRUGS",!,?55,RPDT,?120,"PAGE: "_PG,!!
+3 WRITE ?47,"ORDER",?59,"PRICE PER",?80,"DISPENSE",?97,"DISPENSE UNITS",?118,"PRICE PER"
+4 WRITE !,"DRUG NAME",?47,"UNIT",?59,"ORDER UNIT",?82,"UNIT",?97,"PER ORDER UNIT",?118,"DISPENSE UNIT",!,LN,!
+5 QUIT
