AMQQDOW ; IHS/CMI/THL - GS&CS/OHPRD&ANMC/IHS DAY OF WEEK ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
; This routine is dedicated to my friend and management guru, Dr. Mike Westley, ANMC
;-----
I '$D(AMQRZZZ) S (AMQRZZZ,AMQRDXXX)=0
S AMQRZZZ=AMQRZZZ+1
I IOST["C-",AMQRZZZ>1 W *13,AMQRZZZ I AMQRDXXX W " (",AMQRDXXX,")"
I AMQRZZZ>1 D SET Q
I IOST["C-" W !!!!,"CRUNCH, CRUNCH....",!!
D PRE
D SET
Q
;
FAIL S AMQRDXXX=AMQRDXXX+1
I AMQRZZZ>1 W *13,AMQRZZZ," (",AMQRDXXX,")"
Q
;
COUNT F Y=2,1 S X=@("D"_Y) D H^%DTC S X(Y)=%H
S X(0)=%Y
S X=X(2)-X(1)+1
S Y=X\7,Z=X#7
S %=$E("01234560123456",%Y+1,%Y+Z)
S X=""
F I=1:1:7 S X=X_(Y+(%[(I-1)))_U
S AMQRDD=X
Q
;
PRE K ^UTILITY("AMQRD",$J)
S DIOEND="D BLIST^AMQRDOW"
F I=0:1:23 S ^UTILITY("AMQRD",$J,"B",I)=0
F I=0:1:6 S ^UTILITY("AMQRD",$J,"C",I)=0
S AMQRDTOT=0
Q
;
SET S %=+^AUPNVSIT(D0,0)
S AMQRDAY=%\1
I %'["." D FAIL Q
S %=$P(%,".",2)
S %="."_%
S %=$J(%,1,4)
S AMQRDTIM=(%*100)\1
S X=AMQRDAY
D H^%DTC
S AMQRDAY=%Y
S %=$G(^UTILITY("AMQRD",$J,"A",AMQRDTIM,AMQRDAY)),^(AMQRDAY)=%+1
S %=$G(^UTILITY("AMQRD",$J,"B",AMQRDTIM)),^(AMQRDTIM)=%+1
S %=$G(^UTILITY("AMQRD",$J,"C",AMQRDAY)),^(AMQRDAY)=%+1
S AMQRDTOT=AMQRDTOT+1
Q
;
BLIST I IOST["C-" R !!,"<>",AMQRX:DTIME
D HEADER
BLVAR S G="^UTILITY(""AMQRD"",$J)"
F AMQRLINE=0:1:23 D:AMQRLINE&'(AMQRLINE#(IOSL-4)) PAUSE G:AMQRLINE=999999 EXIT D B1
W !!,"TOTAL"
S I=0
F J=16:8 W ?J,@G@("C",I) S I=I+1 I I=7 W ?(J+8),AMQRDTOT Q
I $D(AMQRDD) W !,"DAYS" S (I,N)=0 F J=16:8 S I=I+1 W ?J,$P(AMQRDD,U,I) S N=N+$P(AMQRDD,U,I) I I=7 W ?(J+8),N Q
I $D(AMQRDD) W !,"AVERAGE" S I=0 F J=16:8 D AVE I I=7 W ?(J+8) S %=AMQRDTOT/N,%=$J(%,1,1) W % Q
I IOST'?1"C-".E W @IOF X ^%ZIS("C") G EXIT
X ^%ZIS("C")
R !!,"<>",AMQRX:DTIME
EXIT K X,Y,Z,A,G,AMQRZZZ,AMQRDXXX,AMQRLINE,N,AMQRDAY,AMQRDTIM,AMQRDTOT,%H,%Y,%T,AMQRX
Q
;
AVE S I=I+1
I '$P(AMQRDD,U,I) S %=0
E S %=@G@("C",I-1)/$P(AMQRDD,U,I)
S %=$J(%,1,1)
W ?J,%
Q
;
B1 S %=AMQRLINE
S %=%*100
S X=%
S Y=%+59
S I=0
I %<1000 S X="0"_X,Y="0"_Y
I X="00" S X="0000",Y="0059"
W !,X,"-",Y
F J=16:8 W ?J,$S($D(@G@("A",AMQRLINE,I)):^(I),1:".") S I=I+1 I I=7 W ?(J+8),@G@("B",AMQRLINE) Q
Q
;
PAUSE I IOST["C-" R !,"<>",AMQRQ:DTIME S:'$T!(AMQRQ=U) AMQRLINE=999999 K AMQRQ
I AMQRLINE=999999 Q
D HEADER
Q
;
W !,"WORKLOAD REPORT FOR ",$P(AMQRINFO,U),?54,$P(AMQRINFO,U,2)," to ",$P(AMQRINFO,U,3),!
W "VISIT TIME"
S I=0
F J=14:8 S I=I+1 W ?J,$P("SUN^MON^TUE^WED^THU^FRI^SAT",U,I) I I=7 W ?(J+8),"TOT" Q
S AMQRX=""
S $P(AMQRX,"-",80)=""
W !,AMQRX
K AMQRI,AMQRJ,AMQRX
Q
;
INFO ; GET TIME FRAME AND CLINIC TYPE
S DIR(0)="D"
S DIR("A")="Enter the starting date of the time frame"
S DIR("?")=""
D ^DIR
K DIR
I $D(DUOUT)!($D(DTOUT)) G EXITINFO
I X="" S Y=2600101
S D1=Y
S DIR(0)="D"
S DIR("A")="Enter the ending date of the time frame"
S DIR("?")=""
D ^DIR
K DIR
I $D(DUOUT)!($D(DTOUT)) G EXITINFO
I X="" S Y=DT
S D2=Y
D COUNT
S DIC=40.7
S DIC(0)="AEQ"
S DIC("A")="Enter the clinic: "
D ^DIC
K DIC
I $D(DUOUT)!($D(DTOUT)) G EXITINFO
I X="" S Y=0 G DIP
I Y=-1 G EXITINFO
DIP S DIC="^AUPNVSIT("
S FLDS="+.01,+D ^AMQRDOW"
S FR=D1
S TO=D2
S BY="@.01"
S DHD="@"
I Y S DIS(0)="N % S %=^(0),%=$P(%,U,8) I %="_+Y
S AMQRINFO=$P(Y,U,2)_U
S Y=D1
S %DT=""
X ^DD("DD")
S AMQRINFO=AMQRINFO_Y_U
S Y=D2
S %DT=""
X ^DD("DD")
S AMQRINFO=AMQRINFO_Y
PRINT S %IS="Q"
D ^%ZIS
I POP G EXITINFO
I $D(IO("Q")),IO=IO(0) W !!,"You can not queue a job to a slave printer..Try again",!!,*7 G PRINT
I '$D(IO("Q")) S IOP=IO K IOBS,IOF,ION,IOPAR,IOSL,IOT,POP D EN1^DIP X ^%ZIS("C") U 0 G EXITINFO
S ZTRTN="EN1^DIP"
S ZTIO=ION
S ZTDTH="NOW"
S ZTDESC="CLINIC WORKLOAD REPORT"
F I=1:1 S %=$P("DT;DTIME;DUZ(;DUZ;U;AMQRINFO;BY;FR;TO;FLDS;DIC;DHD",";",I) Q:%="" S ZTSAVE(%)=""
D ^%ZTLOAD
W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
H 3
Q
;
EXITINFO K DIC,AMQRINFO,AMQRDD,B,DIJ,DP,P,C
Q
;
AMQQDOW ; IHS/CMI/THL - GS&CS/OHPRD&ANMC/IHS DAY OF WEEK ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ; This routine is dedicated to my friend and management guru, Dr. Mike Westley, ANMC
+3 ;-----
+4 IF '$DATA(AMQRZZZ)
SET (AMQRZZZ,AMQRDXXX)=0
+5 SET AMQRZZZ=AMQRZZZ+1
+6 IF IOST["C-"
IF AMQRZZZ>1
WRITE *13,AMQRZZZ
IF AMQRDXXX
WRITE " (",AMQRDXXX,")"
+7 IF AMQRZZZ>1
DO SET
QUIT
+8 IF IOST["C-"
WRITE !!!!,"CRUNCH, CRUNCH....",!!
+9 DO PRE
+10 DO SET
+11 QUIT
+12 ;
FAIL SET AMQRDXXX=AMQRDXXX+1
+1 IF AMQRZZZ>1
WRITE *13,AMQRZZZ," (",AMQRDXXX,")"
+2 QUIT
+3 ;
COUNT FOR Y=2,1
SET X=@("D"_Y)
DO H^%DTC
SET X(Y)=%H
+1 SET X(0)=%Y
+2 SET X=X(2)-X(1)+1
+3 SET Y=X\7
SET Z=X#7
+4 SET %=$EXTRACT("01234560123456",%Y+1,%Y+Z)
+5 SET X=""
+6 FOR I=1:1:7
SET X=X_(Y+(%[(I-1)))_U
+7 SET AMQRDD=X
+8 QUIT
+9 ;
PRE KILL ^UTILITY("AMQRD",$JOB)
+1 SET DIOEND="D BLIST^AMQRDOW"
+2 FOR I=0:1:23
SET ^UTILITY("AMQRD",$JOB,"B",I)=0
+3 FOR I=0:1:6
SET ^UTILITY("AMQRD",$JOB,"C",I)=0
+4 SET AMQRDTOT=0
+5 QUIT
+6 ;
SET SET %=+^AUPNVSIT(D0,0)
+1 SET AMQRDAY=%\1
+2 IF %'["."
DO FAIL
QUIT
+3 SET %=$PIECE(%,".",2)
+4 SET %="."_%
+5 SET %=$JUSTIFY(%,1,4)
+6 SET AMQRDTIM=(%*100)\1
+7 SET X=AMQRDAY
+8 DO H^%DTC
+9 SET AMQRDAY=%Y
+10 SET %=$GET(^UTILITY("AMQRD",$JOB,"A",AMQRDTIM,AMQRDAY))
SET ^(AMQRDAY)=%+1
+11 SET %=$GET(^UTILITY("AMQRD",$JOB,"B",AMQRDTIM))
SET ^(AMQRDTIM)=%+1
+12 SET %=$GET(^UTILITY("AMQRD",$JOB,"C",AMQRDAY))
SET ^(AMQRDAY)=%+1
+13 SET AMQRDTOT=AMQRDTOT+1
+14 QUIT
+15 ;
BLIST IF IOST["C-"
READ !!,"<>",AMQRX:DTIME
+1 DO HEADER
BLVAR SET G="^UTILITY(""AMQRD"",$J)"
+1 FOR AMQRLINE=0:1:23
IF AMQRLINE&'(AMQRLINE#(IOSL-4))
DO PAUSE
IF AMQRLINE=999999
GOTO EXIT
DO B1
+2 WRITE !!,"TOTAL"
+3 SET I=0
+4 FOR J=16:8
WRITE ?J,@G@("C",I)
SET I=I+1
IF I=7
WRITE ?(J+8),AMQRDTOT
QUIT
+5 IF $DATA(AMQRDD)
WRITE !,"DAYS"
SET (I,N)=0
FOR J=16:8
SET I=I+1
WRITE ?J,$PIECE(AMQRDD,U,I)
SET N=N+$PIECE(AMQRDD,U,I)
IF I=7
WRITE ?(J+8),N
QUIT
+6 IF $DATA(AMQRDD)
WRITE !,"AVERAGE"
SET I=0
FOR J=16:8
DO AVE
IF I=7
WRITE ?(J+8)
SET %=AMQRDTOT/N
SET %=$JUSTIFY(%,1,1)
WRITE %
QUIT
+7 IF IOST'?1"C-".E
WRITE @IOF
XECUTE ^%ZIS("C")
GOTO EXIT
+8 XECUTE ^%ZIS("C")
+9 READ !!,"<>",AMQRX:DTIME
EXIT KILL X,Y,Z,A,G,AMQRZZZ,AMQRDXXX,AMQRLINE,N,AMQRDAY,AMQRDTIM,AMQRDTOT,%H,%Y,%T,AMQRX
+1 QUIT
+2 ;
AVE SET I=I+1
+1 IF '$PIECE(AMQRDD,U,I)
SET %=0
+2 IF '$TEST
SET %=@G@("C",I-1)/$PIECE(AMQRDD,U,I)
+3 SET %=$JUSTIFY(%,1,1)
+4 WRITE ?J,%
+5 QUIT
+6 ;
B1 SET %=AMQRLINE
+1 SET %=%*100
+2 SET X=%
+3 SET Y=%+59
+4 SET I=0
+5 IF %<1000
SET X="0"_X
SET Y="0"_Y
+6 IF X="00"
SET X="0000"
SET Y="0059"
+7 WRITE !,X,"-",Y
+8 FOR J=16:8
WRITE ?J,$SELECT($DATA(@G@("A",AMQRLINE,I)):^(I),1:".")
SET I=I+1
IF I=7
WRITE ?(J+8),@G@("B",AMQRLINE)
QUIT
+9 QUIT
+10 ;
PAUSE IF IOST["C-"
READ !,"<>",AMQRQ:DTIME
IF '$TEST!(AMQRQ=U)
SET AMQRLINE=999999
KILL AMQRQ
+1 IF AMQRLINE=999999
QUIT
+2 DO HEADER
+3 QUIT
+4 ;
+1 WRITE !,"WORKLOAD REPORT FOR ",$PIECE(AMQRINFO,U),?54,$PIECE(AMQRINFO,U,2)," to ",$PIECE(AMQRINFO,U,3),!
+2 WRITE "VISIT TIME"
+3 SET I=0
+4 FOR J=14:8
SET I=I+1
WRITE ?J,$PIECE("SUN^MON^TUE^WED^THU^FRI^SAT",U,I)
IF I=7
WRITE ?(J+8),"TOT"
QUIT
+5 SET AMQRX=""
+6 SET $PIECE(AMQRX,"-",80)=""
+7 WRITE !,AMQRX
+8 KILL AMQRI,AMQRJ,AMQRX
+9 QUIT
+10 ;
INFO ; GET TIME FRAME AND CLINIC TYPE
+1 SET DIR(0)="D"
+2 SET DIR("A")="Enter the starting date of the time frame"
+3 SET DIR("?")=""
+4 DO ^DIR
+5 KILL DIR
+6 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXITINFO
+7 IF X=""
SET Y=2600101
+8 SET D1=Y
+9 SET DIR(0)="D"
+10 SET DIR("A")="Enter the ending date of the time frame"
+11 SET DIR("?")=""
+12 DO ^DIR
+13 KILL DIR
+14 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXITINFO
+15 IF X=""
SET Y=DT
+16 SET D2=Y
+17 DO COUNT
+18 SET DIC=40.7
+19 SET DIC(0)="AEQ"
+20 SET DIC("A")="Enter the clinic: "
+21 DO ^DIC
+22 KILL DIC
+23 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXITINFO
+24 IF X=""
SET Y=0
GOTO DIP
+25 IF Y=-1
GOTO EXITINFO
DIP SET DIC="^AUPNVSIT("
+1 SET FLDS="+.01,+D ^AMQRDOW"
+2 SET FR=D1
+3 SET TO=D2
+4 SET BY="@.01"
+5 SET DHD="@"
+6 IF Y
SET DIS(0)="N % S %=^(0),%=$P(%,U,8) I %="_+Y
+7 SET AMQRINFO=$PIECE(Y,U,2)_U
+8 SET Y=D1
+9 SET %DT=""
+10 XECUTE ^DD("DD")
+11 SET AMQRINFO=AMQRINFO_Y_U
+12 SET Y=D2
+13 SET %DT=""
+14 XECUTE ^DD("DD")
+15 SET AMQRINFO=AMQRINFO_Y
PRINT SET %IS="Q"
+1 DO ^%ZIS
+2 IF POP
GOTO EXITINFO
+3 IF $DATA(IO("Q"))
IF IO=IO(0)
WRITE !!,"You can not queue a job to a slave printer..Try again",!!,*7
GOTO PRINT
+4 IF '$DATA(IO("Q"))
SET IOP=IO
KILL IOBS,IOF,ION,IOPAR,IOSL,IOT,POP
DO EN1^DIP
XECUTE ^%ZIS("C")
USE 0
GOTO EXITINFO
+5 SET ZTRTN="EN1^DIP"
+6 SET ZTIO=ION
+7 SET ZTDTH="NOW"
+8 SET ZTDESC="CLINIC WORKLOAD REPORT"
+9 FOR I=1:1
SET %=$PIECE("DT;DTIME;DUZ(;DUZ;U;AMQRINFO;BY;FR;TO;FLDS;DIC;DHD",";",I)
IF %=""
QUIT
SET ZTSAVE(%)=""
+10 DO ^%ZTLOAD
+11 WRITE !!,$SELECT($DATA(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
+12 HANG 3
+13 QUIT
+14 ;
EXITINFO KILL DIC,AMQRINFO,AMQRDD,B,DIJ,DP,P,C
+1 QUIT
+2 ;
