Routine: AMQQRMM

AMQQRMM ; IHS/CMI/THL - MONTH CATEGORIES ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;-----

 I AMQQCCLS="V" G:$D(AMQP(1)) START Q

 I '$D(AMQQHOLD)!('$D(AMQQUATN)) Q

 S %=$P($G(^UTILITY("AMQQ",$J,"AG",AMQQUATN,AMQQHOLD)),U,3)

 I '% Q

 S AMQP(1)=%

START I '$D(AMQQMZ) S (AMQQMZ,AMQQMX)=0

 S AMQQMZ=AMQQMZ+1

 I IOST["C-",AMQQMZ>1 W $C(13),AMQQMZ I AMQQMX W "  (",AMQQMX,")"

 I AMQQMZ>1 D SET Q

 I IOST["C-" W !!!!,"CRUNCH, CRUNCH....",!!

 D PRE

 D SET

EXIT K %,%H,%T,%Y,A,G,I,J,M,N,Z

FAIL S AMQQMX=AMQQMX+1

 I AMQQMZ>1 W $C(13),AMQQMZ,"  (",AMQQMX,")"

RANGE S AMQQMDS=AMQQMDS\1

 S AMQQMDF=AMQQMDF\1

 S (Z(1),Y)=AMQQMDS\1

 X ^DD("DD")

 S AMQQMDS=Y

 S (Z(2),Y)=AMQQMDF\1

 X ^DD("DD")

 S AMQQMDF=Y

 S AMQQMDS=$P(AMQQMDS," ")_" "_$P(AMQQMDS,",",2)

 S AMQQMDF=$P(AMQQMDF," ")_" "_$P(AMQQMDF,",",2)

 S Y(1)=+$E(Z(1),1,3)

 S Y(2)=+$E(Z(2),1,3)

 S M(1)=+$E(Z(1),4,5)

 S M(2)=+$E(Z(2),4,5)

 S %=1+(M(2)-M(1))+((Y(2)-Y(1))*12)

 S X=%\12

 S Y=%#12

 F I=1:1:12 S $P(AMQQMCS,U,I)=X

 F I=M(1):1:(M(1)+Y-1) S Z=$P("1^2^3^4^5^6^7^8^9^10^11^12^1^2^3^4^5^6^7^8^9^10^11^12",U,I) S $P(AMQQMCS,U,Z)=X+1

 K X,Y,Z,%,M,I

PRE K ^UTILITY("AMQQ",$J,"MON")

 S AMQQMGR="^UTILITY(""AMQQ"",$J,""MON"")"

 F I=0:1:12 S @AMQQMGR@(I)=0

 S AMQQMTOT=0

SET S %=+^AUPNVSIT(AMQP(1),0)

 I %'["." D FAIL Q

 I '$D(AMQQMDS) S AMQQMDS=%

 I '$D(AMQQMDF) S AMQQMDF=%

 I %<AMQQMDS S AMQQMDS=%

 I %>AMQQMDF S AMQQMDF=%

 S AMQQMON=+$E(%,4,5)

 S AMQQMYR=1700+$E(%,1,3)

 S @AMQQMGR@(AMQQMON,AMQQMYR)=""

 S %=$G(@AMQQMGR@(AMQQMON)),^(AMQQMON)=%+1

 S AMQQMTOT=AMQQMTOT+1

PRINT I '$D(AMQQMDS) G PEXIT

 D RANGE

 D HEADER

 F AMQQMON=1:1:12 D

 .W !,$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,AMQQMON)

 .S X=^UTILITY("AMQQ",$J,"MON",AMQQMON) W ?8,$J(X,6)

 .S Y=$P(AMQQMCS,U,AMQQMON) W ?18,Y

 .W ?24,$S(Y=0:0,1:$J((X/Y),8,2))

 I IOST'?1"C-".E W @IOF D ^%ZISC G PEXIT

 D ^%ZISC

 R !!,"<>",AMQQMY:DTIME

PEXIT K X,Y,Z,A,G,AMQQMZ,AMQQMX,AMQQMLIN,N,AMQQMAY,AMQQMTIM,AMQQMTOT,%H,%Y,%T,AMQQMY,AMQQMGR,AMQQMDS,AMQQMDF,AMQQMCS,AMQQMON,AMQQMYR,AMQQRMFL

AVE S I=I+1

 I '$P(AMQQMD,U,I) S %=0

 E  S %=@AMQQMGR@("C",I-1)/$P(AMQQMD,U,I)

 S %=$J(%,1,1)

 W ?J,%

B1 S %=AMQQMLIN

 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(@AMQQMGR@("A",AMQQMLIN,I)):^(I),1:".") S I=I+1 I I=7 W ?(J+8),@AMQQMGR@("B",AMQQMLIN) Q

PAUSE I IOST["C-" R !,"<>",AMQQRQ:DTIME S:'$T!(AMQQRQ=U) AMQQMLIN=999999 K AMQQRQ

 I AMQQMLIN=999999 Q

 D HEADER

HEADER W @IOF

 W !,"MONTH CATEGORY REPORT: ",AMQQMDS," to ",AMQQMDF,!!

 W "MONTH",?9,"TOTAL",?16,"MONTH",?27,"AVG",!?16,"COUNT",?24,"PER MONTH"

 S AMQQMY="",$P(AMQQMY,"-",35)="" W !,AMQQMY

 K AMQQRI,AMQQRJ,AMQQMY

MONTASK S ZTRTN="MONRUN^AMQQRMM"

 S ZTIO=ION

 S ZTDTH="NOW"

 F I=1:1 S %=$P("AMQQRMFL;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%=""  S ZTSAVE(%)=""

 S ZTDESC="Q-MAN MONTHLY WORKLOADLOAD REPORT"

 D ^%ZTLOAD

 D ^%ZISC

 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!

H 3

MON ; ENTRY POINT FROM AMQQCMPL

 D DEV

 I $D(AMQQQUIT) Q

 S AMQQRMFL="^AMQQRMM"

 I $D(IO("Q")) D MONTASK D ^%ZISC W @IOF Q

 U IO D MONRUN D ^%ZISC

DEV W !!!

 S %ZIS="Q"

 D ^%ZIS

 I POP K DUOUT,DTOUT,POP S AMQQQUIT=""

 D PRINT^AMQQSEC E  W "  <= Not a secure device!!",*7 G DEV

 I $D(IO("Q")),IO=IO(0) W !!,"You can not queue a job to a slave printer..Try again",!!,*7 G DEV

MONRUN W @IOF

 X AMQV(0)

 D PRINT

 I IOST["P-" W @IOF

 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"

AMQQRMM   ; IHS/CMI/THL - MONTH CATEGORIES ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;-----

 +3        IF AMQQCCLS="V"

               IF $DATA(AMQP(1))

                   GOTO START

               QUIT

 +4        IF '$DATA(AMQQHOLD)!('$DATA(AMQQUATN))

               QUIT

 +5        SET %=$PIECE($GET(^UTILITY("AMQQ",$JOB,"AG",AMQQUATN,AMQQHOLD)),U,3)

 +6        IF '%

               QUIT

 +7        SET AMQP(1)=%

START      IF '$DATA(AMQQMZ)

               SET (AMQQMZ,AMQQMX)=0

 +1        SET AMQQMZ=AMQQMZ+1

 +2        IF IOST["C-"

               IF AMQQMZ>1

                   WRITE $CHAR(13),AMQQMZ

                   IF AMQQMX

                       WRITE "  (",AMQQMX,")"

 +3        IF AMQQMZ>1

               DO SET

               QUIT

 +4        IF IOST["C-"

               WRITE !!!!,"CRUNCH, CRUNCH....",!!

 +5        DO PRE

 +6        DO SET

EXIT       KILL %,%H,%T,%Y,A,G,I,J,M,N,Z

 +1        QUIT

 +2       ;

FAIL       SET AMQQMX=AMQQMX+1

 +1        IF AMQQMZ>1

               WRITE $CHAR(13),AMQQMZ,"  (",AMQQMX,")"

 +2        QUIT

 +3       ;

RANGE      SET AMQQMDS=AMQQMDS\1

 +1        SET AMQQMDF=AMQQMDF\1

 +2        SET (Z(1),Y)=AMQQMDS\1

 +3        XECUTE ^DD("DD")

 +4        SET AMQQMDS=Y

 +5        SET (Z(2),Y)=AMQQMDF\1

 +6        XECUTE ^DD("DD")

 +7        SET AMQQMDF=Y

 +8        SET AMQQMDS=$PIECE(AMQQMDS," ")_" "_$PIECE(AMQQMDS,",",2)

 +9        SET AMQQMDF=$PIECE(AMQQMDF," ")_" "_$PIECE(AMQQMDF,",",2)

 +10       SET Y(1)=+$EXTRACT(Z(1),1,3)

 +11       SET Y(2)=+$EXTRACT(Z(2),1,3)

 +12       SET M(1)=+$EXTRACT(Z(1),4,5)

 +13       SET M(2)=+$EXTRACT(Z(2),4,5)

 +14       SET %=1+(M(2)-M(1))+((Y(2)-Y(1))*12)

 +15       SET X=%\12

 +16       SET Y=%#12

 +17       FOR I=1:1:12

               SET $PIECE(AMQQMCS,U,I)=X

 +18       FOR I=M(1):1:(M(1)+Y-1)

               SET Z=$PIECE("1^2^3^4^5^6^7^8^9^10^11^12^1^2^3^4^5^6^7^8^9^10^11^12",U,I)

               SET $PIECE(AMQQMCS,U,Z)=X+1

 +19       KILL X,Y,Z,%,M,I

 +20       QUIT

 +21      ;

PRE        KILL ^UTILITY("AMQQ",$JOB,"MON")

 +1        SET AMQQMGR="^UTILITY(""AMQQ"",$J,""MON"")"

 +2        FOR I=0:1:12

               SET @AMQQMGR@(I)=0

 +3        SET AMQQMTOT=0

 +4        QUIT

 +5       ;

SET        SET %=+^AUPNVSIT(AMQP(1),0)

 +1        IF %'["."

               DO FAIL

               QUIT

 +2        IF '$DATA(AMQQMDS)

               SET AMQQMDS=%

 +3        IF '$DATA(AMQQMDF)

               SET AMQQMDF=%

 +4        IF %<AMQQMDS

               SET AMQQMDS=%

 +5        IF %>AMQQMDF

               SET AMQQMDF=%

 +6        SET AMQQMON=+$EXTRACT(%,4,5)

 +7        SET AMQQMYR=1700+$EXTRACT(%,1,3)

 +8        SET @AMQQMGR@(AMQQMON,AMQQMYR)=""

 +9        SET %=$GET(@AMQQMGR@(AMQQMON))

           SET ^(AMQQMON)=%+1

 +10       SET AMQQMTOT=AMQQMTOT+1

 +11       QUIT

 +12      ;

PRINT      IF '$DATA(AMQQMDS)

               GOTO PEXIT

 +1        DO RANGE

 +2        DO HEADER

 +3        FOR AMQQMON=1:1:12

               Begin DoDot:1

 +4                WRITE !,$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,AMQQMON)

 +5                SET X=^UTILITY("AMQQ",$JOB,"MON",AMQQMON)

                   WRITE ?8,$JUSTIFY(X,6)

 +6                SET Y=$PIECE(AMQQMCS,U,AMQQMON)

                   WRITE ?18,Y

 +7                WRITE ?24,$SELECT(Y=0:0,1:$JUSTIFY((X/Y),8,2))

               End DoDot:1

 +8        IF IOST'?1"C-".E

               WRITE @IOF

               DO ^%ZISC

               GOTO PEXIT

 +9        DO ^%ZISC

 +10       READ !!,"<>",AMQQMY:DTIME

PEXIT      KILL X,Y,Z,A,G,AMQQMZ,AMQQMX,AMQQMLIN,N,AMQQMAY,AMQQMTIM,AMQQMTOT,%H,%Y,%T,AMQQMY,AMQQMGR,AMQQMDS,AMQQMDF,AMQQMCS,AMQQMON,AMQQMYR,AMQQRMFL

 +1        QUIT

 +2       ;

AVE        SET I=I+1

 +1        IF '$PIECE(AMQQMD,U,I)

               SET %=0

 +2       IF '$TEST

               SET %=@AMQQMGR@("C",I-1)/$PIECE(AMQQMD,U,I)

 +3        SET %=$JUSTIFY(%,1,1)

 +4        WRITE ?J,%

 +5        QUIT

 +6       ;

B1         SET %=AMQQMLIN

 +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(@AMQQMGR@("A",AMQQMLIN,I)):^(I),1:".")

               SET I=I+1

               IF I=7

                   WRITE ?(J+8),@AMQQMGR@("B",AMQQMLIN)

                   QUIT

 +9        QUIT

 +10      ;

PAUSE      IF IOST["C-"

               READ !,"<>",AMQQRQ:DTIME

               IF '$TEST!(AMQQRQ=U)

                   SET AMQQMLIN=999999

               KILL AMQQRQ

 +1        IF AMQQMLIN=999999

               QUIT

 +2        DO HEADER

 +3        QUIT

 +4       ;

HEADER     WRITE @IOF

 +1        WRITE !,"MONTH CATEGORY REPORT: ",AMQQMDS," to ",AMQQMDF,!!

 +2        WRITE "MONTH",?9,"TOTAL",?16,"MONTH",?27,"AVG",!?16,"COUNT",?24,"PER MONTH"

 +3        SET AMQQMY=""

           SET $PIECE(AMQQMY,"-",35)=""

           WRITE !,AMQQMY

 +4        KILL AMQQRI,AMQQRJ,AMQQMY

 +5        QUIT

 +6       ;

MONTASK    SET ZTRTN="MONRUN^AMQQRMM"

 +1        SET ZTIO=ION

 +2        SET ZTDTH="NOW"

 +3        FOR I=1:1

               SET %=$PIECE("AMQQRMFL;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I)

               IF %=""

                   QUIT

               SET ZTSAVE(%)=""

 +4        SET ZTDESC="Q-MAN MONTHLY WORKLOADLOAD REPORT"

 +5        DO ^%ZTLOAD

 +6        DO ^%ZISC

 +7        WRITE !!,$SELECT($DATA(ZTSK):"Request queued!",1:"Request cancelled!"),!!!

 +8        HANG 3

 +9        QUIT

 +10      ;

MON       ; ENTRY POINT FROM AMQQCMPL

 +1        DO DEV

 +2        IF $DATA(AMQQQUIT)

               QUIT

 +3        SET AMQQRMFL="^AMQQRMM"

 +4        IF $DATA(IO("Q"))

               DO MONTASK

               DO ^%ZISC

               WRITE @IOF

               QUIT

 +5        USE IO

           DO MONRUN

           DO ^%ZISC

 +6        QUIT

 +7       ;

DEV        WRITE !!!

 +1        SET %ZIS="Q"

 +2        DO ^%ZIS

 +3        IF POP

               KILL DUOUT,DTOUT,POP

               SET AMQQQUIT=""

 +4        DO PRINT^AMQQSEC

          IF '$TEST

               WRITE "  <= Not a secure device!!",*7

               GOTO DEV

 +5        IF $DATA(IO("Q"))

               IF IO=IO(0)

                   WRITE !!,"You can not queue a job to a slave printer..Try again",!!,*7

                   GOTO DEV

 +6        QUIT

 +7       ;

MONRUN     WRITE @IOF

 +1        XECUTE AMQV(0)

 +2        DO PRINT

 +3        IF IOST["P-"

               WRITE @IOF

 +4        IF $DATA(ZTQUEUED)

               DO EXIT2^AMQQKILL

               SET ZTREQ="@"

 +5        QUIT

 +6       ;

AMQQRMM.m