AMQQDOW.m

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

 ;

HEADER W @IOF

 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       ;

HEADER     WRITE @IOF

 +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       ;