PSSCOMMN ;BIR/RTR-Most Common Dosages Report ;06/07/00
;;1.0;PHARMACY DATA MANAGEMENT;**34**;9/30/97
;Reference to ^DGPM supported by DBIA 1865
EN ;
W !!,"This report displays common dosages of Dispense Drugs for Unit Dose orders",!,"based on the time frame entered. Unit Dose orders without a Dosage Ordered",!,"are not included on this report."
W !,"If there are multiple Dispense Drugs associated with an order, only the first",!,"Dispense Drug of the order will print with the Dosage Ordered.",!
K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y!(Y["^") W !!,"Nothing queued to print.",! G ENDX
W ! K %DT S %DT="AEPX",%DT(0)=-DT,%DT("A")="Enter start date for gathering Dosages: " D ^%DT K %DT I Y<0!($G(DTOUT)) W !!,"Nothing queued to print.",! G ENDX
S PSSBEG=+Y
W ! K DIR S DIR(0)="N^1:100^",DIR("A")="Do not print Dosage if frequency is less than"
S DIR("?")=" ",DIR("?",1)="This number represents the minimum number of times a Dosage was entered",DIR("?",2)="for a Dispense Drug in a Unit Dose order."
S DIR("B")=1 D ^DIR K DIR I 'Y!($D(DIRUT)) W !!,"Nothing queued to print.",! G ENDX
S PSSMIN=Y
W !!,"Because of the length of this report, and the time needed to gather the",!,"information, this report must be queued to a printer.",!
QUEUE ;
K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G ENDX
I '$D(IO("Q")) W !!,"This report must be queued to a printer.",! G QUEUE
S ZTRTN="START^PSSCOMMN",ZTDESC="Most Common Dosages Report",ZTSAVE("PSSBEG")="",ZTSAVE("PSSMIN")="" D ^%ZTLOAD W !!,"Report queued to print.",! G ENDX
Q
START ;
U IO
I '$G(DT) S DT=$$DT^XLFDT
S PSSOUT=0,PSSDV="P",PSSCT=1
K ^TMP("PSSPAT",$J),^TMP("PSSDOS",$J),PSSD,PSSDV,PSSLINE,PSSP,PSSIEN,PSSPAT,PSSOR,PSSORDA,PSSDO,PSSONE,PSSDIEN,PSSDNAME,PSSPFLAG,PSSDNM,PSSDCT,PSSDOSEG,PSSPRINT,PSSXXX
S $P(PSSLINE,"-",79)=""
I $G(PSSBEG) S PSSPRINT=$E(PSSBEG,4,5)_"/"_$E(PSSBEG,6,7)_"/"_$E(PSSBEG,2,3)
D COMMH
I '$G(PSSBEG) G END
S PSSD=PSSBEG-.001
F PSSP=PSSD:0 S PSSP=$O(^DGPM("ATT1",PSSP)) Q:'PSSP!(PSSP>DT) F PSSIEN=0:0 S PSSIEN=$O(^DGPM("ATT1",PSSP,PSSIEN)) Q:'PSSIEN D
.S PSSPAT=$P($G(^DGPM(PSSIEN,0)),"^",3) Q:'PSSPAT
.Q:$D(^TMP("PSSPAT",$J,PSSPAT))
.S ^TMP("PSSPAT",$J,PSSPAT)=""
.F PSSOR=PSSD:0 S PSSOR=$O(^PS(55,PSSPAT,5,"AUS",PSSOR)) Q:'PSSOR F PSSORDA=0:0 S PSSORDA=$O(^PS(55,PSSPAT,5,"AUS",PSSOR,PSSORDA)) Q:'PSSORDA D
..S PSSDO=$P($G(^PS(55,PSSPAT,5,PSSORDA,.2)),"^",2) Q:PSSDO=""
..S PSSONE=$O(^PS(55,PSSPAT,5,PSSORDA,1,0)) Q:'PSSONE
..S PSSDIEN=$P($G(^PS(55,PSSPAT,5,PSSORDA,1,PSSONE,0)),"^") Q:'PSSDIEN!($P($G(^PSDRUG(PSSDIEN,0)),"^")="")
..S PSSDNAME=$P($G(^PSDRUG(PSSDIEN,0)),"^")
..I '$D(^TMP("PSSDOS",$J,PSSDNAME,PSSDO)) S ^TMP("PSSDOS",$J,PSSDNAME,PSSDO)=1 Q
..S ^TMP("PSSDOS",$J,PSSDNAME,PSSDO)=^TMP("PSSDOS",$J,PSSDNAME,PSSDO)+1
S PSSPFLAG=0
S PSSDNM="" F S PSSDNM=$O(^TMP("PSSDOS",$J,PSSDNM)) Q:PSSDNM="" S PSSDCT=1 S PSSDOSEG="" F S PSSDOSEG=$O(^TMP("PSSDOS",$J,PSSDNM,PSSDOSEG)) Q:PSSDOSEG="" D
.Q:^TMP("PSSDOS",$J,PSSDNM,PSSDOSEG)<$G(PSSMIN)
.S PSSXXX=0
.I ($Y+5)>IOSL S PSSXXX=1 D COMMH
.S PSSPFLAG=1
.I PSSDCT=1 W:'$G(PSSXXX) ! W !,PSSDNM
.W:PSSDCT'=1 ! W ?43,PSSDOSEG,?65,^TMP("PSSDOS",$J,PSSDNM,PSSDOSEG)
.S PSSDCT=PSSDCT+1
I '$G(PSSPFLAG) W !!,"NO DATA TO PRINT",!!
END ;
W @IOF
ENDX ;
K ^TMP("PSSPAT",$J),^TMP("PSSDOS",$J),PSSD,PSSDV,PSSLINE,PSSMIN,PSSBEG,PSSP,PSSIEN,PSSPAT,PSSOR,PSSORDA,PSSDO,PSSONE,PSSDIEN,PSSDNAME,PSSPFLAG,PSSDNM,PSSDCT,PSSDOSEG,PSSPRINT,PSSXXX
K %ZIS D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
COMMH ;
W @IOF W !?3,"COMMON DOSAGES REPORT STARTING FROM "_$G(PSSPRINT)_$S($G(PSSCT)=1:"",1:" (cont.)"),?67,"PAGE: "_$G(PSSCT) S PSSCT=PSSCT+1
W !!,"DRUG",?43,"DOSAGE",?62,"FREQUENCY",!,PSSLINE,!
Q
PSSCOMMN ;BIR/RTR-Most Common Dosages Report ;06/07/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**34**;9/30/97
+2 ;Reference to ^DGPM supported by DBIA 1865
EN ;
+1 WRITE !!,"This report displays common dosages of Dispense Drugs for Unit Dose orders",!,"based on the time frame entered. Unit Dose orders without a Dosage Ordered",!,"are not included on this report."
+2 WRITE !,"If there are multiple Dispense Drugs associated with an order, only the first",!,"Dispense Drug of the order will print with the Dosage Ordered.",!
+3 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y!(Y["^")
WRITE !!,"Nothing queued to print.",!
GOTO ENDX
+4 WRITE !
KILL %DT
SET %DT="AEPX"
SET %DT(0)=-DT
SET %DT("A")="Enter start date for gathering Dosages: "
DO ^%DT
KILL %DT
IF Y<0!($GET(DTOUT))
WRITE !!,"Nothing queued to print.",!
GOTO ENDX
+5 SET PSSBEG=+Y
+6 WRITE !
KILL DIR
SET DIR(0)="N^1:100^"
SET DIR("A")="Do not print Dosage if frequency is less than"
+7 SET DIR("?")=" "
SET DIR("?",1)="This number represents the minimum number of times a Dosage was entered"
SET DIR("?",2)="for a Dispense Drug in a Unit Dose order."
+8 SET DIR("B")=1
DO ^DIR
KILL DIR
IF 'Y!($DATA(DIRUT))
WRITE !!,"Nothing queued to print.",!
GOTO ENDX
+9 SET PSSMIN=Y
+10 WRITE !!,"Because of the length of this report, and the time needed to gather the",!,"information, this report must be queued to a printer.",!
QUEUE ;
+1 KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)
WRITE !!,"Nothing queued to print.",!
GOTO ENDX
+2 IF '$DATA(IO("Q"))
WRITE !!,"This report must be queued to a printer.",!
GOTO QUEUE
+3 SET ZTRTN="START^PSSCOMMN"
SET ZTDESC="Most Common Dosages Report"
SET ZTSAVE("PSSBEG")=""
SET ZTSAVE("PSSMIN")=""
DO ^%ZTLOAD
WRITE !!,"Report queued to print.",!
GOTO ENDX
+4 QUIT
START ;
+1 USE IO
+2 IF '$GET(DT)
SET DT=$$DT^XLFDT
+3 SET PSSOUT=0
SET PSSDV="P"
SET PSSCT=1
+4 KILL ^TMP("PSSPAT",$JOB),^TMP("PSSDOS",$JOB),PSSD,PSSDV,PSSLINE,PSSP,PSSIEN,PSSPAT,PSSOR,PSSORDA,PSSDO,PSSONE,PSSDIEN,PSSDNAME,PSSPFLAG,PSSDNM,PSSDCT,PSSDOSEG,PSSPRINT,PSSXXX
+5 SET $PIECE(PSSLINE,"-",79)=""
+6 IF $GET(PSSBEG)
SET PSSPRINT=$EXTRACT(PSSBEG,4,5)_"/"_$EXTRACT(PSSBEG,6,7)_"/"_$EXTRACT(PSSBEG,2,3)
+7 DO COMMH
+8 IF '$GET(PSSBEG)
GOTO END
+9 SET PSSD=PSSBEG-.001
+10 FOR PSSP=PSSD:0
SET PSSP=$ORDER(^DGPM("ATT1",PSSP))
IF 'PSSP!(PSSP>DT)
QUIT
FOR PSSIEN=0:0
SET PSSIEN=$ORDER(^DGPM("ATT1",PSSP,PSSIEN))
IF 'PSSIEN
QUIT
Begin DoDot:1
+11 SET PSSPAT=$PIECE($GET(^DGPM(PSSIEN,0)),"^",3)
IF 'PSSPAT
QUIT
+12 IF $DATA(^TMP("PSSPAT",$JOB,PSSPAT))
QUIT
+13 SET ^TMP("PSSPAT",$JOB,PSSPAT)=""
+14 FOR PSSOR=PSSD:0
SET PSSOR=$ORDER(^PS(55,PSSPAT,5,"AUS",PSSOR))
IF 'PSSOR
QUIT
FOR PSSORDA=0:0
SET PSSORDA=$ORDER(^PS(55,PSSPAT,5,"AUS",PSSOR,PSSORDA))
IF 'PSSORDA
QUIT
Begin DoDot:2
+15 SET PSSDO=$PIECE($GET(^PS(55,PSSPAT,5,PSSORDA,.2)),"^",2)
IF PSSDO=""
QUIT
+16 SET PSSONE=$ORDER(^PS(55,PSSPAT,5,PSSORDA,1,0))
IF 'PSSONE
QUIT
+17 SET PSSDIEN=$PIECE($GET(^PS(55,PSSPAT,5,PSSORDA,1,PSSONE,0)),"^")
IF 'PSSDIEN!($PIECE($GET(^PSDRUG(PSSDIEN,0)),"^")="")
QUIT
+18 SET PSSDNAME=$PIECE($GET(^PSDRUG(PSSDIEN,0)),"^")
+19 IF '$DATA(^TMP("PSSDOS",$JOB,PSSDNAME,PSSDO))
SET ^TMP("PSSDOS",$JOB,PSSDNAME,PSSDO)=1
QUIT
+20 SET ^TMP("PSSDOS",$JOB,PSSDNAME,PSSDO)=^TMP("PSSDOS",$JOB,PSSDNAME,PSSDO)+1
End DoDot:2
End DoDot:1
+21 SET PSSPFLAG=0
+22 SET PSSDNM=""
FOR
SET PSSDNM=$ORDER(^TMP("PSSDOS",$JOB,PSSDNM))
IF PSSDNM=""
QUIT
SET PSSDCT=1
SET PSSDOSEG=""
FOR
SET PSSDOSEG=$ORDER(^TMP("PSSDOS",$JOB,PSSDNM,PSSDOSEG))
IF PSSDOSEG=""
QUIT
Begin DoDot:1
+23 IF ^TMP("PSSDOS",$JOB,PSSDNM,PSSDOSEG)<$GET(PSSMIN)
QUIT
+24 SET PSSXXX=0
+25 IF ($Y+5)>IOSL
SET PSSXXX=1
DO COMMH
+26 SET PSSPFLAG=1
+27 IF PSSDCT=1
IF '$GET(PSSXXX)
WRITE !
WRITE !,PSSDNM
+28 IF PSSDCT'=1
WRITE !
WRITE ?43,PSSDOSEG,?65,^TMP("PSSDOS",$JOB,PSSDNM,PSSDOSEG)
+29 SET PSSDCT=PSSDCT+1
End DoDot:1
+30 IF '$GET(PSSPFLAG)
WRITE !!,"NO DATA TO PRINT",!!
END ;
+1 WRITE @IOF
ENDX ;
+1 KILL ^TMP("PSSPAT",$JOB),^TMP("PSSDOS",$JOB),PSSD,PSSDV,PSSLINE,PSSMIN,PSSBEG,PSSP,PSSIEN,PSSPAT,PSSOR,PSSORDA,PSSDO,PSSONE,PSSDIEN,PSSDNAME,PSSPFLAG,PSSDNM,PSSDCT,PSSDOSEG,PSSPRINT,PSSXXX
+2 KILL %ZIS
DO ^%ZISC
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
COMMH ;
+1 WRITE @IOF
WRITE !?3,"COMMON DOSAGES REPORT STARTING FROM "_$GET(PSSPRINT)_$SELECT($GET(PSSCT)=1:"",1:" (cont.)"),?67,"PAGE: "_$GET(PSSCT)
SET PSSCT=PSSCT+1
+2 WRITE !!,"DRUG",?43,"DOSAGE",?62,"FREQUENCY",!,PSSLINE,!
+3 QUIT
