92 lines
4.5 KiB
Mathematica
92 lines
4.5 KiB
Mathematica
|
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
|