source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOBRPRT.m@ 628

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