PSOBRPRT.m

PSOBRPRT ;BHAM ISC/LC - BINGO BOARD REPORT GENERATOR ; 1/27/93

 ;;7.0;OUTPATIENT PHARMACY;**28**;DEC 1997

A1 K %DT W !! S %DT(0)=-DT,%DT="AEP",%DT("A")="Start Date:   " D ^%DT

 G:Y<0!($D(DTOUT)) END

 K %DT S (%DT(0),BDATE)=Y

EDATE W ! S %DT="AE",%DT("A")="Ending Date:  " D ^%DT G:Y<0!($D(DTOUT)) A1

 I Y>DT W !!,$C(7),"*** Future dates are not permitted ***",! G EDATE

 S EDATE=Y

SELECT W ! S (TD,FLAG)=0 F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX  S TD=TD+1,NDIV=XX

 I $G(TD)=1,'$D(^PS(59.2,"C",NDIV)) W !!,"No data found for ",$P(^PS(59,NDIV,0),"^")," division." G END

 I $G(TD)=1 S PDIV(NDIV)=$P(^PS(59,NDIV,0),"^") G SETUP

 S DIR(0)="Y",DIR("B")="N",DIR("A")="Report all Divisions" D ^DIR K DIR G:$D(DIRUT) END

 S FLAG=Y G:'Y LOOP

SETUP G:'$D(PDIV)&('FLAG) END S %ZIS="QM" D ^%ZIS Q:POP

 I $D(IO("Q")) D QUE G END

 G:'FLAG LOAD1

LOAD ;PRINT ALL DIVISIONS

 D CV F  S PS1=$O(^PS(59.2,"C",PS1)) Q:PS1=""!(PSOUT)  S WDIV=$P($G(^PS(59,PS1,0)),"^",1) D LD Q:PSOUT

 D TPE G END

LOOP ;SELECT DIVISIONS TO PRINT

 W ! K X S DIR(0)="PO^59:EMZ",DIR("A")="Select Division(s) to Report"

 D ^DIR K DIR G:$D(DUOUT) END G:X="" SETUP

 I '$D(^PS(59.2,"C",+Y)) W !!,"No data found for ",$P($G(Y),"^",2)," division." G LOOP

 S PDIV(+Y)=$P(Y,"^",2)

 G:$G(FLAG)=0 LOOP

LOAD1 ;PRINT SELECTED DIVISIONS

 D CV F  S PS1=$O(PDIV(PS1)) Q:'PS1!(PSOUT)  S WDIV=PDIV(PS1) D LD Q:PSOUT

 I TD>1 D TPE

 G END

CV U IO S (PSOUT,NPT,TTM,TP,TW,TD,PS1)=0,(PAGE,LINE)=1 S Y=BDATE D DD^%DT S BDAT=Y S Y=EDATE D DD^%DT S EDAT=Y

 S Y=DT D DD^%DT S NOW=Y Q

LD S (TPD,TWD)=0

 F PS2=BDATE-.0001:0 S PS2=$O(^PS(59.2,"C",PS1,PS2)) Q:'PS2!(PS2>EDATE)  S NODE=$G(^PS(59.2,PS2,1,PS1,0)) D:$D(NODE) FILL Q:$G(PSOUT)

 Q:$G(PSOUT)

 I 'TPD W !!,"No data found for "_WDIV_" division for this date range" Q

 S NPT=TPD,TTM=TWD,TD=TD+1 D TP

 Q

TPE S NPT=TP,TTM=TW S:FLAG WDIV="All Divisions" S:'FLAG&(TD>1) WDIV="Selected Divisions"

TP I LINE>1&('PS2) D PAGE

 S HEAD=1 D HEADING K HEAD

 W !?5,"|",?74,"|",!?5,"|",?74,"|",!?5,"|  Total ",?23,$J(NPT,4),?42,$J(TTM,6,2) W:NPT ?60,$J((TTM/NPT),5,2) W ?74,"|" S LINE=LINE+10 D STARS,PAGE

 Q

FILL S NODATA=0,KEEP=1 F APE=1:1:23 S NO(APE)=+$P(NODE,"^",APE) I $G(NO(APE))'>0 S NODATA=NODATA+1 S:NODATA>22 NODATA="STOP"

 Q:NODATA="STOP"  S (NPT1,TTM1)=0

 F APE=2:2:22 D

 .I $G(NO(APE))'>0 S TOT(KEEP)=0,KEEP=KEEP+1 Q

 .S TOT(KEEP)=NO(APE+1)/NO(APE),KEEP=KEEP+1

 .S NPT1=NPT1+NO(APE),TTM1=TTM1+NO(APE+1),TP=TP+NO(APE),TW=TW+NO(APE+1)

 .S TPD=TPD+NO(APE),TWD=TWD+NO(APE+1)

 D HEADING Q

HEADING ;I PAGE>1,($E(IOST,1,2)="C-") S DIR(0)="E" D ^DIR K DIR

 I LINE=1 W @IOF,!,?15,"B I N G O   B O A R D  R E P O R T   ",NOW,!?5,"REPORT PERIOD:  ",BDAT,"  through  ",EDAT,!

 D STARS

PRINT S Y=PS2 D DD^%DT

 W ?5,"|"," DIVISION:  ",WDIV,?40,"DATE:  ",Y,?74,"|"

 W !?5,"|",?47,"(Time In Minutes)",?74,"|"

 W !?5,"|","  TIME PERIOD",?22,"# PATIENTS SERVED",?42,"TOT WAIT TIME",?60,"AVG WAIT TIME",?74,"|" Q:$D(HEAD)

 F ZZ=1:1:11 W !?5,$P($T(ZIP+1),"^",ZZ+1),?28,$J(NO(ZZ*2),4),?47,$J(NO(ZZ+(ZZ+1)),6,2),?65,$J(TOT(ZZ),5,2),?74,"|"

 W:NPT1 !?5,"|  Subtotal ",?28,$J(NPT1,4),?47,$J(TTM1,6,2),?65,$J((TTM1/NPT1),5,2),?74,"|"

 D STARS S LINE=LINE+19

 I LINE+24>IOSL D PAGE

 Q

PAGE F ZZ=1:1:IOSL-(LINE+3) W !

 W ?40,"PAGE  ",PAGE,! S PAGE=PAGE+1,LINE=1

 I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) PSOUT=1

 Q

ZIP ;

 ;;"^| Before 8 AM^| 8-9 AM^| 9-10 AM^| 10-11 AM^| 11AM-12PM^| 12-1 PM^| 1-2 PM^| 2-3 PM^| 3-4 PM^| 4-5 PM^| After 5 PM^"

 Q

QUE F G="BDATE","EDATE","FLAG","PDIV(" S ZTSAVE($G(G))=""

 K G I FLAG=1 S ZTRTN="LOAD^PSOBRPRT" G SKIP

 S ZTRTN="LOAD1^PSOBRPRT"

SKIP S ZTDESC="Outpatient Pharmacy Bingo Board Report"

 D ^%ZTLOAD G END

STARS W !?5 F STAR=1:1:70 W "_"

 W ! Q

STATS1 ; statistical file entry (from PSOBINGO)

 N TM2 S TM2=$E(TM1_"0000",1,4),CNT=1,DATE=$P($P(^PS(52.11,DA,0),"^",5),"."),FLD=+$E(TM2,1,2)*2-12

 S:FLD<2 FLD=2 S:FLD>22 FLD=22

 S START=$P(RX0,"^",6),S1=+$E(START,1,2)*60+(+$E(START,3,4)),S2=+$E(TM2,1,2)*60+(+$E(TM2,3,4)),DIF=S2-S1 S:DIF'>0 DIF=(-1)*DIF

 S $P(^PS(59.2,DATE,1,JOES,0),"^")=JOES

 S $P(^PS(59.2,DATE,1,JOES,0),"^",FLD+1)=$P($G(^PS(59.2,DATE,1,JOES,0)),"^",FLD+1)+DIF

 S $P(^PS(59.2,DATE,1,JOES,0),"^",FLD)=$P($G(^PS(59.2,DATE,1,JOES,0)),"^",FLD)+1 K FLD,S1,S2,START

 Q

BBWAIT ;print bingo board wait time min, max, mean

 S DIC="^PS(52.11,",L=0,FLDS="[PSO BBWAIT PRINT]",BY="[PSO BBWAIT SORT]" D EN1^DIP

 Q

END D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"

 K %DT,APE,BDAT,BDATE,CNT,DA,DIRUT,DTOUT,DUOUT,EDATE,EDAT,FLAG,HEAD,I,JOES,KEEP,LINE,NDIV,NO,NODATA,NODE,NOW,NPT,NPT1

 K PAGE,PDIV,PS1,PS2,PS3,PSDA,PSOUT,RDIV,RXO,SAVE,STAR,TOT,TTM,TTM1,WDIV,X,XX,X1,XX1,Y,ZTDESC,ZTRTN,ZTSAVE,ZZ

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOBRPRT   4698     printed  Feb 18, 2025@23:51:34                                                                                                                                                                                                    Page 2

PSOBRPRT  ;BHAM ISC/LC - BINGO BOARD REPORT GENERATOR ; 1/27/93

 +1       ;;7.0;OUTPATIENT PHARMACY;**28**;DEC 1997

A1         KILL %DT

           WRITE !!

           SET %DT(0)=-DT

           SET %DT="AEP"

           SET %DT("A")="Start Date:   "

           DO ^%DT

 +1        if Y<0!($DATA(DTOUT))

               GOTO END

 +2        KILL %DT

           SET (%DT(0),BDATE)=Y

EDATE      WRITE !

           SET %DT="AE"

           SET %DT("A")="Ending Date:  "

           DO ^%DT

           if Y<0!($DATA(DTOUT))

               GOTO A1

 +1        IF Y>DT

               WRITE !!,$CHAR(7),"*** Future dates are not permitted ***",!

               GOTO EDATE

 +2        SET EDATE=Y

SELECT     WRITE !

           SET (TD,FLAG)=0

           FOR XX=0:0

               SET XX=$ORDER(^PS(59,XX))

               if 'XX

                   QUIT 

               SET TD=TD+1

               SET NDIV=XX

 +1        IF $GET(TD)=1

               IF '$DATA(^PS(59.2,"C",NDIV))

                   WRITE !!,"No data found for ",$PIECE(^PS(59,NDIV,0),"^")," division."

                   GOTO END

 +2        IF $GET(TD)=1

               SET PDIV(NDIV)=$PIECE(^PS(59,NDIV,0),"^")

               GOTO SETUP

 +3        SET DIR(0)="Y"

           SET DIR("B")="N"

           SET DIR("A")="Report all Divisions"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO END

 +4        SET FLAG=Y

           if 'Y

               GOTO LOOP

SETUP      if '$DATA(PDIV)&('FLAG)

               GOTO END

           SET %ZIS="QM"

           DO ^%ZIS

           if POP

               QUIT 

 +1        IF $DATA(IO("Q"))

               DO QUE

               GOTO END

 +2        if 'FLAG

               GOTO LOAD1

LOAD      ;PRINT ALL DIVISIONS

 +1        DO CV

           FOR 

               SET PS1=$ORDER(^PS(59.2,"C",PS1))

               if PS1=""!(PSOUT)

                   QUIT 

               SET WDIV=$PIECE($GET(^PS(59,PS1,0)),"^",1)

               DO LD

               if PSOUT

                   QUIT 

 +2        DO TPE

           GOTO END

LOOP      ;SELECT DIVISIONS TO PRINT

 +1        WRITE !

           KILL X

           SET DIR(0)="PO^59:EMZ"

           SET DIR("A")="Select Division(s) to Report"

 +2        DO ^DIR

           KILL DIR

           if $DATA(DUOUT)

               GOTO END

           if X=""

               GOTO SETUP

 +3        IF '$DATA(^PS(59.2,"C",+Y))

               WRITE !!,"No data found for ",$PIECE($GET(Y),"^",2)," division."

               GOTO LOOP

 +4        SET PDIV(+Y)=$PIECE(Y,"^",2)

 +5        if $GET(FLAG)=0

               GOTO LOOP

LOAD1     ;PRINT SELECTED DIVISIONS

 +1        DO CV

           FOR 

               SET PS1=$ORDER(PDIV(PS1))

               if 'PS1!(PSOUT)

                   QUIT 

               SET WDIV=PDIV(PS1)

               DO LD

               if PSOUT

                   QUIT 

 +2        IF TD>1

               DO TPE

 +3        GOTO END

CV         USE IO

           SET (PSOUT,NPT,TTM,TP,TW,TD,PS1)=0

           SET (PAGE,LINE)=1

           SET Y=BDATE

           DO DD^%DT

           SET BDAT=Y

           SET Y=EDATE

           DO DD^%DT

           SET EDAT=Y

 +1        SET Y=DT

           DO DD^%DT

           SET NOW=Y

           QUIT 

LD         SET (TPD,TWD)=0

 +1        FOR PS2=BDATE-.0001:0

               SET PS2=$ORDER(^PS(59.2,"C",PS1,PS2))

               if 'PS2!(PS2>EDATE)

                   QUIT 

               SET NODE=$GET(^PS(59.2,PS2,1,PS1,0))

               if $DATA(NODE)

                   DO FILL

               if $GET(PSOUT)

                   QUIT 

 +2        if $GET(PSOUT)

               QUIT 

 +3        IF 'TPD

               WRITE !!,"No data found for "_WDIV_" division for this date range"

               QUIT 

 +4        SET NPT=TPD

           SET TTM=TWD

           SET TD=TD+1

           DO TP

 +5        QUIT 

TPE        SET NPT=TP

           SET TTM=TW

           if FLAG

               SET WDIV="All Divisions"

           if 'FLAG&(TD>1)

               SET WDIV="Selected Divisions"

TP         IF LINE>1&('PS2)

               DO PAGE

 +1        SET HEAD=1

           DO HEADING

           KILL HEAD

 +2        WRITE !?5,"|",?74,"|",!?5,"|",?74,"|",!?5,"|  Total ",?23,$JUSTIFY(NPT,4),?42,$JUSTIFY(TTM,6,2)

           if NPT

               WRITE ?60,$JUSTIFY((TTM/NPT),5,2)

           WRITE ?74,"|"

           SET LINE=LINE+10

           DO STARS

           DO PAGE

 +3        QUIT 

FILL       SET NODATA=0

           SET KEEP=1

           FOR APE=1:1:23

               SET NO(APE)=+$PIECE(NODE,"^",APE)

               IF $GET(NO(APE))'>0

                   SET NODATA=NODATA+1

                   if NODATA>22

                       SET NODATA="STOP"

 +1        if NODATA="STOP"

               QUIT 

           SET (NPT1,TTM1)=0

 +2        FOR APE=2:2:22

               Begin DoDot:1

 +3                IF $GET(NO(APE))'>0

                       SET TOT(KEEP)=0

                       SET KEEP=KEEP+1

                       QUIT 

 +4                SET TOT(KEEP)=NO(APE+1)/NO(APE)

                   SET KEEP=KEEP+1

 +5                SET NPT1=NPT1+NO(APE)

                   SET TTM1=TTM1+NO(APE+1)

                   SET TP=TP+NO(APE)

                   SET TW=TW+NO(APE+1)

 +6                SET TPD=TPD+NO(APE)

                   SET TWD=TWD+NO(APE+1)

               End DoDot:1

 +7        DO HEADING

           QUIT 

HEADING   ;I PAGE>1,($E(IOST,1,2)="C-") S DIR(0)="E" D ^DIR K DIR

 +1        IF LINE=1

               WRITE @IOF,!,?15,"B I N G O   B O A R D  R E P O R T   ",NOW,!?5,"REPORT PERIOD:  ",BDAT,"  through  ",EDAT,!

 +2        DO STARS

PRINT      SET Y=PS2

           DO DD^%DT

 +1        WRITE ?5,"|"," DIVISION:  ",WDIV,?40,"DATE:  ",Y,?74,"|"

 +2        WRITE !?5,"|",?47,"(Time In Minutes)",?74,"|"

 +3        WRITE !?5,"|","  TIME PERIOD",?22,"# PATIENTS SERVED",?42,"TOT WAIT TIME",?60,"AVG WAIT TIME",?74,"|"

           if $DATA(HEAD)

               QUIT 

 +4        FOR ZZ=1:1:11

               WRITE !?5,$PIECE($TEXT(ZIP+1),"^",ZZ+1),?28,$JUSTIFY(NO(ZZ*2),4),?47,$JUSTIFY(NO(ZZ+(ZZ+1)),6,2),?65,$JUSTIFY(TOT(ZZ),5,2),?74,"|"

 +5        if NPT1

               WRITE !?5,"|  Subtotal ",?28,$JUSTIFY(NPT1,4),?47,$JUSTIFY(TTM1,6,2),?65,$JUSTIFY((TTM1/NPT1),5,2),?74,"|"

 +6        DO STARS

           SET LINE=LINE+19

 +7        IF LINE+24>IOSL

               DO PAGE

 +8        QUIT 

PAGE       FOR ZZ=1:1:IOSL-(LINE+3)

               WRITE !

 +1        WRITE ?40,"PAGE  ",PAGE,!

           SET PAGE=PAGE+1

           SET LINE=1

 +2        IF $EXTRACT(IOST,1,2)="C-"

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

               if $DATA(DTOUT)!($DATA(DUOUT))

                   SET PSOUT=1

 +3        QUIT 

ZIP       ;

 +1       ;;"^| Before 8 AM^| 8-9 AM^| 9-10 AM^| 10-11 AM^| 11AM-12PM^| 12-1 PM^| 1-2 PM^| 2-3 PM^| 3-4 PM^| 4-5 PM^| After 5 PM^"

 +2        QUIT 

QUE        FOR G="BDATE","EDATE","FLAG","PDIV("

               SET ZTSAVE($GET(G))=""

 +1        KILL G

           IF FLAG=1

               SET ZTRTN="LOAD^PSOBRPRT"

               GOTO SKIP

 +2        SET ZTRTN="LOAD1^PSOBRPRT"

SKIP       SET ZTDESC="Outpatient Pharmacy Bingo Board Report"

 +1        DO ^%ZTLOAD

           GOTO END

STARS      WRITE !?5

           FOR STAR=1:1:70

               WRITE "_"

 +1        WRITE !

           QUIT 

STATS1    ; statistical file entry (from PSOBINGO)

 +1        NEW TM2

           SET TM2=$EXTRACT(TM1_"0000",1,4)

           SET CNT=1

           SET DATE=$PIECE($PIECE(^PS(52.11,DA,0),"^",5),".")

           SET FLD=+$EXTRACT(TM2,1,2)*2-12

 +2        if FLD<2

               SET FLD=2

           if FLD>22

               SET FLD=22

 +3        SET START=$PIECE(RX0,"^",6)

           SET S1=+$EXTRACT(START,1,2)*60+(+$EXTRACT(START,3,4))

           SET S2=+$EXTRACT(TM2,1,2)*60+(+$EXTRACT(TM2,3,4))

           SET DIF=S2-S1

           if DIF'>0

               SET DIF=(-1)*DIF

 +4        SET $PIECE(^PS(59.2,DATE,1,JOES,0),"^")=JOES

 +5        SET $PIECE(^PS(59.2,DATE,1,JOES,0),"^",FLD+1)=$PIECE($GET(^PS(59.2,DATE,1,JOES,0)),"^",FLD+1)+DIF

 +6        SET $PIECE(^PS(59.2,DATE,1,JOES,0),"^",FLD)=$PIECE($GET(^PS(59.2,DATE,1,JOES,0)),"^",FLD)+1

           KILL FLD,S1,S2,START

 +7        QUIT 

BBWAIT    ;print bingo board wait time min, max, mean

 +1        SET DIC="^PS(52.11,"

           SET L=0

           SET FLDS="[PSO BBWAIT PRINT]"

           SET BY="[PSO BBWAIT SORT]"

           DO EN1^DIP

 +2        QUIT 

END        DO ^%ZISC

           if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +1        KILL %DT,APE,BDAT,BDATE,CNT,DA,DIRUT,DTOUT,DUOUT,EDATE,EDAT,FLAG,HEAD,I,JOES,KEEP,LINE,NDIV,NO,NODATA,NODE,NOW,NPT,NPT1

 +2        KILL PAGE,PDIV,PS1,PS2,PS3,PSDA,PSOUT,RDIV,RXO,SAVE,STAR,TOT,TTM,TTM1,WDIV,X,XX,X1,XX1,Y,ZTDESC,ZTRTN,ZTSAVE,ZZ

 +3        QUIT