- 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
