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 ---[H[J[2J[HPSOBRPRT 4698 printed Sep 02, 2024@19:10:12 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
