source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOBRPRT.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1PSOBRPRT ;BHAM ISC/LC - BINGO BOARD REPORT GENERATOR ; 1/27/93
2 ;;7.0;OUTPATIENT PHARMACY;**28**;DEC 1997
3A1 K %DT W !! S %DT(0)=-DT,%DT="AEP",%DT("A")="Start Date: " D ^%DT
4 G:Y<0!($D(DTOUT)) END
5 K %DT S (%DT(0),BDATE)=Y
6EDATE W ! S %DT="AE",%DT("A")="Ending Date: " D ^%DT G:Y<0!($D(DTOUT)) A1
7 I Y>DT W !!,$C(7),"*** Future dates are not permitted ***",! G EDATE
8 S EDATE=Y
9SELECT W ! S (TD,FLAG)=0 F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX S TD=TD+1,NDIV=XX
10 I $G(TD)=1,'$D(^PS(59.2,"C",NDIV)) W !!,"No data found for ",$P(^PS(59,NDIV,0),"^")," division." G END
11 I $G(TD)=1 S PDIV(NDIV)=$P(^PS(59,NDIV,0),"^") G SETUP
12 S DIR(0)="Y",DIR("B")="N",DIR("A")="Report all Divisions" D ^DIR K DIR G:$D(DIRUT) END
13 S FLAG=Y G:'Y LOOP
14SETUP G:'$D(PDIV)&('FLAG) END S %ZIS="QM" D ^%ZIS Q:POP
15 I $D(IO("Q")) D QUE G END
16 G:'FLAG LOAD1
17LOAD ;PRINT ALL DIVISIONS
18 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
19 D TPE G END
20LOOP ;SELECT DIVISIONS TO PRINT
21 W ! K X S DIR(0)="PO^59:EMZ",DIR("A")="Select Division(s) to Report"
22 D ^DIR K DIR G:$D(DUOUT) END G:X="" SETUP
23 I '$D(^PS(59.2,"C",+Y)) W !!,"No data found for ",$P($G(Y),"^",2)," division." G LOOP
24 S PDIV(+Y)=$P(Y,"^",2)
25 G:$G(FLAG)=0 LOOP
26LOAD1 ;PRINT SELECTED DIVISIONS
27 D CV F S PS1=$O(PDIV(PS1)) Q:'PS1!(PSOUT) S WDIV=PDIV(PS1) D LD Q:PSOUT
28 I TD>1 D TPE
29 G END
30CV 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
31 S Y=DT D DD^%DT S NOW=Y Q
32LD S (TPD,TWD)=0
33 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)
34 Q:$G(PSOUT)
35 I 'TPD W !!,"No data found for "_WDIV_" division for this date range" Q
36 S NPT=TPD,TTM=TWD,TD=TD+1 D TP
37 Q
38TPE S NPT=TP,TTM=TW S:FLAG WDIV="All Divisions" S:'FLAG&(TD>1) WDIV="Selected Divisions"
39TP I LINE>1&('PS2) D PAGE
40 S HEAD=1 D HEADING K HEAD
41 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
42 Q
43FILL 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"
44 Q:NODATA="STOP" S (NPT1,TTM1)=0
45 F APE=2:2:22 D
46 .I $G(NO(APE))'>0 S TOT(KEEP)=0,KEEP=KEEP+1 Q
47 .S TOT(KEEP)=NO(APE+1)/NO(APE),KEEP=KEEP+1
48 .S NPT1=NPT1+NO(APE),TTM1=TTM1+NO(APE+1),TP=TP+NO(APE),TW=TW+NO(APE+1)
49 .S TPD=TPD+NO(APE),TWD=TWD+NO(APE+1)
50 D HEADING Q
51HEADING ;I PAGE>1,($E(IOST,1,2)="C-") S DIR(0)="E" D ^DIR K DIR
52 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,!
53 D STARS
54PRINT S Y=PS2 D DD^%DT
55 W ?5,"|"," DIVISION: ",WDIV,?40,"DATE: ",Y,?74,"|"
56 W !?5,"|",?47,"(Time In Minutes)",?74,"|"
57 W !?5,"|"," TIME PERIOD",?22,"# PATIENTS SERVED",?42,"TOT WAIT TIME",?60,"AVG WAIT TIME",?74,"|" Q:$D(HEAD)
58 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,"|"
59 W:NPT1 !?5,"| Subtotal ",?28,$J(NPT1,4),?47,$J(TTM1,6,2),?65,$J((TTM1/NPT1),5,2),?74,"|"
60 D STARS S LINE=LINE+19
61 I LINE+24>IOSL D PAGE
62 Q
63PAGE F ZZ=1:1:IOSL-(LINE+3) W !
64 W ?40,"PAGE ",PAGE,! S PAGE=PAGE+1,LINE=1
65 I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) PSOUT=1
66 Q
67ZIP ;
68 ;;"^| 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^"
69 Q
70QUE F G="BDATE","EDATE","FLAG","PDIV(" S ZTSAVE($G(G))=""
71 K G I FLAG=1 S ZTRTN="LOAD^PSOBRPRT" G SKIP
72 S ZTRTN="LOAD1^PSOBRPRT"
73SKIP S ZTDESC="Outpatient Pharmacy Bingo Board Report"
74 D ^%ZTLOAD G END
75STARS W !?5 F STAR=1:1:70 W "_"
76 W ! Q
77STATS1 ; statistical file entry (from PSOBINGO)
78 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
79 S:FLD<2 FLD=2 S:FLD>22 FLD=22
80 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
81 S $P(^PS(59.2,DATE,1,JOES,0),"^")=JOES
82 S $P(^PS(59.2,DATE,1,JOES,0),"^",FLD+1)=$P($G(^PS(59.2,DATE,1,JOES,0)),"^",FLD+1)+DIF
83 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
84 Q
85BBWAIT ;print bingo board wait time min, max, mean
86 S DIC="^PS(52.11,",L=0,FLDS="[PSO BBWAIT PRINT]",BY="[PSO BBWAIT SORT]" D EN1^DIP
87 Q
88END D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
89 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
90 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
91 Q
Note: See TracBrowser for help on using the repository browser.