| 1 | %ZTLOAD1 ;SEA/RDS-TaskMan: P I: Queue ;01/16/2007
|
|---|
| 2 | ;;8.0;KERNEL;**112,118,127,162,275,363,409,415,425**;Jul 10, 1995;Build 18
|
|---|
| 3 | ;
|
|---|
| 4 | GET ;get task data
|
|---|
| 5 | N %X,%Y,X,Y,X1,ZT,ZTC1,ZTC2,ZTA1,ZTA4,ZTA5,ZTINC,ZTGOT,ZTC34P
|
|---|
| 6 | K %ZTLOAD
|
|---|
| 7 | I ("^"[$G(ZTRTN))!($L($G(ZTRTN),"^")>2) D REJECT^%ZTLOAD2("Bad Routine") G EXIT
|
|---|
| 8 | S U="^" I ZTRTN'[U S ZTRTN=U_ZTRTN
|
|---|
| 9 | S ZTC1=$G(DUZ),ZTC2=""
|
|---|
| 10 | I ZTC1>0 S ZTC2=$P($G(^VA(200,ZTC1,0)),U)
|
|---|
| 11 | ;Check Date/Time
|
|---|
| 12 | 1 I $D(ZTDTH)[0 S ZTDTH=""
|
|---|
| 13 | I ZTDTH?7N.".".N S ZTDTH=$$FMTH^%ZTLOAD7(ZTDTH)
|
|---|
| 14 | I $P($G(XQY0),U,18) D RESTRCT^%ZTLOAD2
|
|---|
| 15 | I ZTDTH'="@",ZTDTH'?1.5N1","1.5N D ASK^%ZTLOAD2 I ZTDTH'>0 D REJECT^%ZTLOAD2("Bad Date/Time") G EXIT
|
|---|
| 16 | ;
|
|---|
| 17 | S ZTA1="R",ZTA4="",ZTA5=""
|
|---|
| 18 | I ZTRTN="ZTSK^XQ1" D OPTION^%ZTLOAD2 I ZTA1="" D REJECT^%ZTLOAD2("Bad Option") G EXIT
|
|---|
| 19 | I ZTA1="R" D
|
|---|
| 20 | . S ZTSAVE("XQY")="",ZTSAVE("XQY0")="",ZTA4=$G(XQY),ZTA5=$P($G(XQY0),U)
|
|---|
| 21 | ;
|
|---|
| 22 | D GETENV^%ZOSV S ZTC34P=Y
|
|---|
| 23 | ;Description
|
|---|
| 24 | 2 I $D(ZTDESC)[0 S ZTDESC="No Description (%ZTLOAD)"
|
|---|
| 25 | ;
|
|---|
| 26 | I $G(ZTKIL)]"" D ZTKIL^%ZTLOAD2
|
|---|
| 27 | S:$G(ZTUCI)["," ZTUCI=$P(ZTUCI,",") S:$G(ZTCPU)["," ZTCPU=$P(ZTCPU,",",2)
|
|---|
| 28 | DEVICE ;get device data
|
|---|
| 29 | I $D(ZTIO)#2,$G(ION)=$P(ZTIO,";"),$G(IOT)="SPL" D SPOOL^%ZTLOAD2
|
|---|
| 30 | ;If no ZTIO, build from symbol table
|
|---|
| 31 | I $D(ZTIO)[0 S ZTIO=$G(ION) I $L(ZTIO) D
|
|---|
| 32 | . S:$G(IOST)]"" $P(ZTIO,";",2)=IOST
|
|---|
| 33 | . I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_IO("DOC")
|
|---|
| 34 | . E I $G(IOM)]"" S ZTIO=ZTIO_";"_IOM I $G(IOSL)]"" S ZTIO=ZTIO_";"_IOSL
|
|---|
| 35 | . Q
|
|---|
| 36 | ;
|
|---|
| 37 | I $E(ZTIO,1)="`" S $P(ZTIO,";")=$P(^%ZIS(1,+$E(ZTIO,2,99),0),"^") ;Convert `IEN format
|
|---|
| 38 | S ZTIO(1)=$S($G(ZTIO(1))'="D":"Q",1:"DIRECT")
|
|---|
| 39 | I $L(ZTIO) D ;Skip if no device
|
|---|
| 40 | . ;IO("HFSIO") and IOPAR are how %ZIS reports the user selected file name and parameters
|
|---|
| 41 | . S:'$D(ZTIO("H")) ZTIO("H")=$G(IO("HFSIO"))
|
|---|
| 42 | . S:'$D(ZTIO("P")) ZTIO("P")=$G(IOPAR)
|
|---|
| 43 | . I $G(IO("P"))]"",ZTIO'[";/" S ZTIO=ZTIO_";/"_IO("P")
|
|---|
| 44 | . I $$NOQ^%ZISUTL($P(ZTIO,";")) D BADDEV^%ZTLOAD2("Restricted Device")
|
|---|
| 45 | . I $E(ZTIO,1,9)="P-MESSAGE" S ZTSAVE("^TMP(""XM-MESS"",$J,")=""
|
|---|
| 46 | . Q
|
|---|
| 47 | ;
|
|---|
| 48 | I $D(%ZTLOAD("ERROR")) G EXIT
|
|---|
| 49 | ;
|
|---|
| 50 | ;See that ^%ZTSK(-1) is set
|
|---|
| 51 | I $D(^%ZTSK(-1))[0 S ^%ZTSK(-1)=$S($P($G(^%ZTSK(0)),U,3):$P(^(0),U,3),1:1000)
|
|---|
| 52 | RECORD ;build record
|
|---|
| 53 | S ZTINC=$G(^%ZOSF("$INC"),1) ;Set to 1 if this system has $INCREMENT, otherwise 0.
|
|---|
| 54 | S ZTGOT=0
|
|---|
| 55 | I 'ZTINC D ;For System that don't have $INC (GT.M, DTM, MSM)
|
|---|
| 56 | . ;Find a free entry, Claim it and Lock it.
|
|---|
| 57 | . L +^%ZTSK(-1):0 S ZTSK=^%ZTSK(-1) ;This is just a starting point
|
|---|
| 58 | . F S ZTSK=ZTSK+1 I '$D(^%ZTSK(ZTSK)) D Q:ZTGOT
|
|---|
| 59 | . . L +^%ZTSK(ZTSK):0 Q:'$T ;Can we lock it
|
|---|
| 60 | . . I $D(^%ZTSK(ZTSK)) L -^%ZTSK(ZTSK) ;Already claimed
|
|---|
| 61 | . . S ^%ZTSK(ZTSK,.1)=0,^%ZTSK(-1)=ZTSK,ZTGOT=1 ;Claim it
|
|---|
| 62 | . . Q
|
|---|
| 63 | . L -^%ZTSK(-1) ;
|
|---|
| 64 | . Q
|
|---|
| 65 | I ZTINC D ;For DSM and OpenM. Faster over network(DDP)
|
|---|
| 66 | . S ZTSK=$INCREMENT(^%ZTSK(-1))
|
|---|
| 67 | . L +^%ZTSK(ZTSK):0 S ZTGOT=$T
|
|---|
| 68 | I 'ZTGOT!($D(^%ZTSK(ZTSK,0))) L -^%ZTSK(ZTSK) G RECORD
|
|---|
| 69 | S ^%ZTSK(ZTSK,0)=ZTRTN_U_ZTC1_U_$G(ZTUCI)_U_$H_U_ZTDTH_U_ZTA1_U_ZTA4_U_ZTA5_U_ZTC2_U_$P(ZTC34P,U,1,2)_U_"ZTDESC"_U_$G(ZTCPU)_U_$G(ZTPRI)
|
|---|
| 70 | S ^%ZTSK(ZTSK,.1)=0,^%ZTSK(ZTSK,.03)=ZTDESC
|
|---|
| 71 | S ^%ZTSK(ZTSK,.2)=ZTIO_"^^^^"_ZTIO(1)_U_$G(ZTIO("H")) S:$D(ZTSYNC) $P(^%ZTSK(ZTSK,.2),U,7)=ZTSYNC
|
|---|
| 72 | I $G(ZTIO("P"))]"" S ^%ZTSK(ZTSK,.25)=ZTIO("P")
|
|---|
| 73 | ;
|
|---|
| 74 | D ZTSAVE
|
|---|
| 75 | ;
|
|---|
| 76 | SCHED ;schedule task and quit
|
|---|
| 77 | S ZTSTAT=$S(ZTDTH'="@":1,1:"K")_"^"_$H,$P(ZTSTAT,U,8)=$G(ZTKIL)
|
|---|
| 78 | S ^%ZTSK(ZTSK,.1)=ZTSTAT
|
|---|
| 79 | I ZTDTH'="@" S ZT=$$H3(ZTDTH),^%ZTSK(ZTSK,.04)=ZT,^%ZTSCH(ZT,ZTSK)=""
|
|---|
| 80 | L -^%ZTSK(ZTSK) S ZTSK("D")=ZTDTH
|
|---|
| 81 | EXIT ;Clean up
|
|---|
| 82 | I $E($G(ZTIO),1,9)="P-MESSAGE" K ^TMP("XM-MESS",$J) ;Clean up the Global
|
|---|
| 83 | K X1,ZT,ZT1,ZTDTH,ZTKIL,ZTSAVE,ZTSTAT,ZTIO
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | ZTSAVE ;save variables
|
|---|
| 87 | N ZTIO
|
|---|
| 88 | K %H,%T,ZTA1,ZTA4,ZTA5,ZTC1,ZTC2,ZTC34P,ZTCPU,ZTDESC,ZTIO,ZTNOGO,ZTPRI,ZTRTN,ZTUCI,ZTSYNC
|
|---|
| 89 | S ZTSAVE("DUZ(")=""
|
|---|
| 90 | S ZT1="" F S ZT1=$O(ZTSAVE(ZT1)) Q:ZT1="" D EVAL
|
|---|
| 91 | K ^%ZTSK(ZTSK,.3,"DUZ(","NEWCODE")
|
|---|
| 92 | K ^%ZTSK(ZTSK,.3,"ZTSK"),^("ZTSAVE"),^("ZTDTH")
|
|---|
| 93 | K ^%ZTSK(ZTSK,.3,"XQNOGO")
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | EVAL ;ZTSAVE--evaluate expression
|
|---|
| 97 | I ZT1="*" S X="^%ZTSK(ZTSK,.3," D DOLRO^%ZOSV Q
|
|---|
| 98 | I ZT1["*",$P(ZT1,"*")'["(" S X="^%ZTSK(ZTSK,.3,",Y=ZT1 D ORDER^%ZOSV Q
|
|---|
| 99 | I $S($E(ZT1)="""":1,+ZT1'=ZT1:0,1:ZT1]0),$D(ZTSAVE(ZT1))#2 S @("^%ZTSK(ZTSK,"_ZT1_")=ZTSAVE(ZT1)") Q
|
|---|
| 100 | I $S(ZT1'["(":1,1:$E(ZT1,$L(ZT1))=")"),$S($D(@ZT1)#2:1,1:ZTSAVE(ZT1)]"") S ^%ZTSK(ZTSK,.3,ZT1)=$S(ZTSAVE(ZT1)]"":ZTSAVE(ZT1),1:@ZT1) Q
|
|---|
| 101 | I $E(ZT1)="^",ZT1["(" S %X=ZT1,%Y="^%ZTSK(ZTSK,.3,ZT1," D %XY^%RCR Q
|
|---|
| 102 | I ZT1["(" S %X=ZT1,%Y="^%ZTSK(ZTSK,.3,ZT1," D %XY^%RCR
|
|---|
| 103 | ;I ZT1["(" M ^%ZTSK(ZTSK,.3,ZT1)=@$P(ZT1,"(")
|
|---|
| 104 | Q
|
|---|
| 105 | ;
|
|---|
| 106 | H3(%) ;Convert $H to seconds.
|
|---|
| 107 | Q 86400*%+$P(%,",",2)
|
|---|
| 108 | H0(%) ;Covert from seconds to $H
|
|---|
| 109 | Q (%\86400)_","_(%#86400)
|
|---|
