Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMQQRMT

AMQQRMT.m

Go to the documentation of this file.
AMQQRMT ; IHS/CMI/THL - TIME SERIES REPORT ;
 ;;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(AMQQTZ) S (AMQQTZ,AMQQTX)=0
 S AMQQTZ=AMQQTZ+1
 I IOST["C-",AMQQTZ>1 W $C(13),AMQQTZ I AMQQTX W "  (",AMQQTX,")"
 I AMQQTZ>1 D SET Q
 I IOST["C-" W !!!!,"CRUNCH, CRUNCH....",!!
 D PRE
 D SET
EXIT K %,%H,%T,%Y,A,G,I,J,N
 Q
 ;
FAIL S AMQQTX=AMQQTX+1
 I AMQQTZ>1 W $C(13),AMQQTZ,"  (",AMQQTX,")"
 Q
 ;
RANGE S AMQQTDS=AMQQTDS\1
 S AMQQTDF=AMQQTDF\1
 S (Z(1),Y)=AMQQTDS\1
 X ^DD("DD")
 S AMQQTDS=Y
 S (Z(2),Y)=AMQQTDF\1
 X ^DD("DD")
 S AMQQTDF=Y
 S Z(3)=Z(2)-Z(1)+1
 S AMQQTDS=$P(AMQQTDS,",",2)
 S AMQQTDF=$P(AMQQTDF,",",2)
 S (Z,AMQQTY2)=1700+$E(Z(2),1,3)
 S AMQQTY1=1700+$E(Z(1),1,3)
 I Z(3)>6 S Z(3)=6
 F I=1:1:Z(3) S $P(AMQQTCS,U,I)=(Z-I+1)
 S AMQQTST=(+$E(Z(2),1,3)-5)*10000
 S AMQQTNM=Z(3)*12
 K Z
 Q
 ;
PRE K ^UTILITY("AMQQ",$J,"TS")
 S AMQQTGR="^UTILITY(""AMQQ"",$J,""TS"")"
 S AMQQTTOT=0
 Q
 ;
SET S %=+^AUPNVSIT(AMQP(1),0)
 I %'["." D FAIL Q
 I '$D(AMQQTDS) S AMQQTDS=%
 I '$D(AMQQTDF) S AMQQTDF=%
 I %<AMQQTDS S AMQQTDS=%
 I %>AMQQTDF S AMQQTDF=%
 S AMQQTMON=+$E(%,4,5),AMQQTYR=1700+$E(%,1,3)
 S %=$G(@AMQQTGR@(AMQQTYR,AMQQTMON)),^(AMQQTMON)=%+1
 S %=$G(@AMQQTGR@(AMQQTYR)),^(AMQQTYR)=%+1
 S %=$G(@AMQQTGR@(AMQQTMON)),^(AMQQTMON)=%+1
 S AMQQTTOT=AMQQTTOT+1
 Q
 ;
PRINT I '$D(AMQQTDS) G PEXIT
 D RANGE
 D HEADER
 F AMQQTMON=1:1:12 D
 .W !,$P("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER",U,AMQQTMON)
 .S AMQQTAB=11 F AMQQTYR=AMQQTY2:-1:AMQQTY1 D
 ..W ?AMQQTAB,$J(+$G(@AMQQTGR@(AMQQTYR,AMQQTMON)),6) S AMQQTAB=AMQQTAB+11
 ..I AMQQTYR=AMQQTY1 W ?66,$J(+$G(@AMQQTGR@(AMQQTMON)),6)
 W !!,"TOTAL"
 S AMQQTAB=11
 F AMQQTYR=AMQQTY2:-1:AMQQTY1 W ?AMQQTAB,$J(+$G(@AMQQTGR@(AMQQTYR)),6) S AMQQTAB=AMQQTAB+11 I AMQQTYR=AMQQTY1 W ?66,$J(AMQQTOT,6)
 W !,"CUMUL."
 S X=0
 S AMQQTAB=11
 F AMQQTYR=AMQQTY2:-1:AMQQTY1 S X=X+$G(@AMQQTGR@(AMQQTYR)) W ?AMQQTAB,$J(X,6) S AMQQTAB=AMQQTAB+11 I AMQQTYR=AMQQTY1 W ?66,$J(X,6)
 W !,"AVG/MONTH"
 S AMQQTAB=11
 F AMQQTYR=AMQQTY2:-1:AMQQTY1 S X=+$G(@AMQQTGR@(AMQQTYR))\12 W ?AMQQTAB,$J(X,6) S AMQQTAB=AMQQTAB+11 I AMQQTYR=AMQQTY1 W ?66,$J((AMQQTOT\AMQQTNM),6)
 I IOST'?1"C-".E W @IOF D ^%ZISC G PEXIT
 D ^%ZISC
 R !!,"<>",AMQQTY:DTIME
PEXIT K X,Y,Z,A,G,AMQQTZ,AMQQTX,AMQQTLIN,N,AMQQTAY,AMQQTTIM,AMQQTTOT,%H,%Y,%T,AMQQTY,AMQQTGR,AMQQTDS,AMQQTDF,AMQQTCS,AMQQTST,AMQQTY1,AMQQTY2,AMQQTNM,AMQQTMON,AMQQTYR,AMQQTAB,AMQQRMFL
 Q
 ;
AVE S I=I+1
 I '$P(AMQQTD,U,I) S %=0
 E  S %=@AMQQTGR@("C",I-1)/$P(AMQQTD,U,I)
 S %=$J(%,1,1)
 W ?J,%
 Q
 ;
B1 S %=AMQQTLIN
 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(@AMQQTGR@("A",AMQQTLIN,I)):^(I),1:".") S I=I+1 I I=7 W ?(J+8),@AMQQTGR@("B",AMQQTLIN) Q
 Q
 ;
PAUSE I IOST["C-" R !,"<>",AMQQRQ:DTIME S:'$T!(AMQQRQ=U) AMQQTLIN=999999 K AMQQRQ
 I AMQQTLIN=999999 Q
 D HEADER
 Q
 ;
 W !,"TIME SERIES REPORT: ",AMQQTDS," to ",AMQQTDF,!!
 S I=0
 F X=13:11:60 S I=I+1 W ?X,$P(AMQQTCS,U,I)
 W ?66,"TOTAL"
 S AMQQTY=""
 S $P(AMQQTY,"-",75)=""
 W !,AMQQTY
 K AMQQRI,AMQQRJ,AMQQTY
 Q
 ;
TIMETASK S ZTRTN="TIMERUN^AMQQRMT"
 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 TIME-SERIES REPORT"
 D ^%ZTLOAD
 D ^%ZISC
 W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
 H 3
 Q
 ;
TIME ; ENTRY POINT FROM AMQQCMPL
 D DEV
 I $D(AMQQQUIT) Q
 S AMQQRMFL="^AMQQRMT"
 I $D(IO("Q")) D TIMETASK D ^%ZISC W @IOF Q
 U IO D TIMERUN D ^%ZISC
 Q
 ;
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
 Q
 ;
TIMERUN W @IOF
 X AMQV(0)
 D PRINT
 I IOST["P-" W @IOF
 I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
 Q
 ;