- 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 Mar 13, 2025@20:50:09 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
