- %ZTLOAD1 ;SEA/RDS-TaskMan: P I: Queue ;09/23/08 10:06
- ;;8.0;KERNEL;**112,118,127,162,275,363,409,415,425,446**;Jul 10, 1995;Build 44
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- GET ;get task data
- N %X,%Y,X,Y,X1,ZT,ZTC1,ZTC2,ZTA1,ZTA4,ZTA5,ZTINC,ZTGOT,ZTC34P
- K %ZTLOAD
- I ("^"[$G(ZTRTN))!($L($G(ZTRTN),"^")>2) D REJECT^%ZTLOAD2("Bad Routine") G EXIT
- S U="^" I ZTRTN'[U S ZTRTN=U_ZTRTN
- S ZTC1=+$G(DUZ),ZTC2=""
- I ZTC1>0 S ZTC2=$P($G(^VA(200,ZTC1,0)),U)
- ;Check Date/Time
- 1 I $D(ZTDTH)[0 S ZTDTH=""
- I ZTDTH?7N.".".N S ZTDTH=$$FMTH^%ZTLOAD7(ZTDTH)
- I $P($G(XQY0),U,18) D RESTRCT^%ZTLOAD2
- I ZTDTH'="@",ZTDTH'?1.5N1","1.5N D ASK^%ZTLOAD2 I ZTDTH'>0 D REJECT^%ZTLOAD2("Bad Date/Time") G EXIT
- ;
- S ZTA1="R",ZTA4="",ZTA5=""
- I ZTRTN="ZTSK^XQ1" D OPTION^%ZTLOAD2 I ZTA1="" D REJECT^%ZTLOAD2("Bad Option") G EXIT
- I ZTA1="R" D
- . S ZTSAVE("XQY")="",ZTSAVE("XQY0")="",ZTA4=$G(XQY),ZTA5=$P($G(XQY0),U)
- ;
- D GETENV^%ZOSV S ZTC34P=Y
- ;Description
- 2 I $D(ZTDESC)[0 S ZTDESC="No Description (%ZTLOAD)"
- ;
- I $G(ZTKIL)]"" D ZTKIL^%ZTLOAD2
- S:$G(ZTUCI)["," ZTUCI=$P(ZTUCI,",") S:$G(ZTCPU)["," ZTCPU=$P(ZTCPU,",",2)
- DEVICE ;get device data
- I $D(ZTIO)#2,$G(ION)=$P(ZTIO,";"),$G(IOT)="SPL" D SPOOL^%ZTLOAD2
- ;If no ZTIO, build from symbol table
- I $D(ZTIO)[0 S ZTIO=$G(ION) I $L(ZTIO) D
- . S:$G(IOST)]"" $P(ZTIO,";",2)=IOST
- . I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_IO("DOC")
- . E I $G(IOM)]"" S ZTIO=ZTIO_";"_IOM I $G(IOSL)]"" S ZTIO=ZTIO_";"_IOSL
- . Q
- ;
- I $E(ZTIO,1)="`" S $P(ZTIO,";")=$P(^%ZIS(1,+$E(ZTIO,2,99),0),"^") ;Convert `IEN format
- S ZTIO(1)=$S($G(ZTIO(1))'="D":"Q",1:"DIRECT")
- I $L(ZTIO) D ;Skip if no device
- . ;IO("HFSIO") and IOPAR are how %ZIS reports the user selected file name and parameters
- . S:'$D(ZTIO("H")) ZTIO("H")=$G(IO("HFSIO"))
- . S:'$D(ZTIO("P")) ZTIO("P")=$G(IOPAR)
- . I $G(IO("P"))]"",ZTIO'[";/" S ZTIO=ZTIO_";/"_IO("P")
- . I $$NOQ^%ZISUTL($P(ZTIO,";")) D BADDEV^%ZTLOAD2("Restricted Device")
- . I $E(ZTIO,1,9)="P-MESSAGE" S ZTSAVE("^TMP(""XM-MESS"",$J,")=""
- . Q
- ;
- I $D(%ZTLOAD("ERROR")) G EXIT
- ;
- ;See that ^%ZTSK(-1) is set
- I $D(^%ZTSK(-1))[0 S ^%ZTSK(-1)=$S($P($G(^%ZTSK(0)),U,3):$P(^(0),U,3),1:1000)
- RECORD ;build record
- S ZTINC=$G(^%ZOSF("$INC"),1) ;Set to 1 if this system has $INCREMENT, otherwise 0.
- S ZTGOT=0
- I 'ZTINC D ;For System that don't have $INC (GT.M, DTM, MSM)
- . ;Find a free entry, Claim it and Lock it.
- . L +^%ZTSK(-1):0 S ZTSK=^%ZTSK(-1) ;This is just a starting point
- . F S ZTSK=ZTSK+1 I '$D(^%ZTSK(ZTSK)) D Q:ZTGOT
- . . L +^%ZTSK(ZTSK):$G(DILOCKTM,3) Q:'$T ;Can we lock it
- . . I $D(^%ZTSK(ZTSK)) L -^%ZTSK(ZTSK) ;Already claimed
- . . S ^%ZTSK(ZTSK,.1)=0,^%ZTSK(-1)=ZTSK,ZTGOT=1 ;Claim it
- . . Q
- . L -^%ZTSK(-1) ;
- . Q
- I ZTINC D ;For DSM and OpenM. Faster over network(DDP)
- . S ZTSK=$INCREMENT(^%ZTSK(-1))
- . L +^%ZTSK(ZTSK):$G(DILOCKTM,3) S ZTGOT=$T ;p446
- I 'ZTGOT!($D(^%ZTSK(ZTSK,0))) L -^%ZTSK(ZTSK) G RECORD
- TSTART ;
- 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)
- S ^%ZTSK(ZTSK,.1)=0,^%ZTSK(ZTSK,.03)=ZTDESC
- S ^%ZTSK(ZTSK,.2)=ZTIO_"^^^^"_ZTIO(1)_U_$G(ZTIO("H")) S:$D(ZTSYNC) $P(^%ZTSK(ZTSK,.2),U,7)=ZTSYNC
- I $G(ZTIO("P"))]"" S ^%ZTSK(ZTSK,.25)=ZTIO("P")
- ;
- D ZTSAVE
- ;
- SCHED ;schedule task and quit
- S ZTSTAT=$S(ZTDTH'="@":1,1:"K")_"^"_$H,$P(ZTSTAT,U,8)=$G(ZTKIL)
- S ^%ZTSK(ZTSK,.1)=ZTSTAT
- I ZTDTH'="@" L +^%ZTSCH("SCHQ"):$G(DILOCKTM,3) S ZT=$$H3(ZTDTH),^%ZTSK(ZTSK,.04)=ZT,^%ZTSCH(ZT,ZTSK)="" L -^%ZTSCH("SCHQ")
- L -^%ZTSK(ZTSK) S ZTSK("D")=ZTDTH
- TCOMMIT ;
- EXIT ;Clean up
- I $E($G(ZTIO),1,9)="P-MESSAGE" K ^TMP("XM-MESS",$J) ;Clean up the Global
- K X1,ZT,ZT1,ZTDTH,ZTKIL,ZTSAVE,ZTSTAT,ZTIO
- Q
- ;
- ZTSAVE ;save variables
- N ZTIO
- K %H,%T,ZTA1,ZTA4,ZTA5,ZTC1,ZTC2,ZTC34P,ZTCPU,ZTDESC,ZTIO,ZTNOGO,ZTPRI,ZTRTN,ZTUCI,ZTSYNC
- S ZTSAVE("DUZ(")=""
- S ZT1="" F S ZT1=$O(ZTSAVE(ZT1)) Q:ZT1="" D EVAL
- K ^%ZTSK(ZTSK,.3,"DUZ(","NEWCODE")
- K ^%ZTSK(ZTSK,.3,"ZTSK"),^("ZTSAVE"),^("ZTDTH")
- K ^%ZTSK(ZTSK,.3,"XQNOGO")
- Q
- ;
- EVAL ;ZTSAVE--evaluate expression
- I ZT1="*" S X="^%ZTSK(ZTSK,.3," D DOLRO^%ZOSV Q
- I ZT1["*",$P(ZT1,"*")'["(" S X="^%ZTSK(ZTSK,.3,",Y=ZT1 D ORDER^%ZOSV Q
- I $S($E(ZT1)="""":1,+ZT1'=ZT1:0,1:ZT1]0),$D(ZTSAVE(ZT1))#2 S @("^%ZTSK(ZTSK,"_ZT1_")=ZTSAVE(ZT1)") Q
- 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
- I $E(ZT1)="^",ZT1["(" S %X=ZT1,%Y="^%ZTSK(ZTSK,.3,ZT1," D %XY^%RCR Q
- I ZT1["(" S %X=ZT1,%Y="^%ZTSK(ZTSK,.3,ZT1," D %XY^%RCR
- ;I ZT1["(" M ^%ZTSK(ZTSK,.3,ZT1)=@$P(ZT1,"(")
- Q
- ;
- H3(%) ;Convert $H to seconds.
- Q 86400*%+$P(%,",",2)
- H0(%) ;Covert from seconds to $H
- Q (%\86400)_","_(%#86400)
- %ZTLOAD1 ;SEA/RDS-TaskMan: P I: Queue ;09/23/08 10:06
- +1 ;;8.0;KERNEL;**112,118,127,162,275,363,409,415,425,446**;Jul 10, 1995;Build 44
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- GET ;get task data
- +1 NEW %X,%Y,X,Y,X1,ZT,ZTC1,ZTC2,ZTA1,ZTA4,ZTA5,ZTINC,ZTGOT,ZTC34P
- +2 KILL %ZTLOAD
- +3 IF ("^"[$GET(ZTRTN))!($LENGTH($GET(ZTRTN),"^")>2)
- DO REJECT^%ZTLOAD2("Bad Routine")
- GOTO EXIT
- +4 SET U="^"
- IF ZTRTN'[U
- SET ZTRTN=U_ZTRTN
- +5 SET ZTC1=+$GET(DUZ)
- SET ZTC2=""
- +6 IF ZTC1>0
- SET ZTC2=$PIECE($GET(^VA(200,ZTC1,0)),U)
- +7 ;Check Date/Time
- 1 IF $DATA(ZTDTH)[0
- SET ZTDTH=""
- +1 IF ZTDTH?7N.".".N
- SET ZTDTH=$$FMTH^%ZTLOAD7(ZTDTH)
- +2 IF $PIECE($GET(XQY0),U,18)
- DO RESTRCT^%ZTLOAD2
- +3 IF ZTDTH'="@"
- IF ZTDTH'?1.5N1","1.5N
- DO ASK^%ZTLOAD2
- IF ZTDTH'>0
- DO REJECT^%ZTLOAD2("Bad Date/Time")
- GOTO EXIT
- +4 ;
- +5 SET ZTA1="R"
- SET ZTA4=""
- SET ZTA5=""
- +6 IF ZTRTN="ZTSK^XQ1"
- DO OPTION^%ZTLOAD2
- IF ZTA1=""
- DO REJECT^%ZTLOAD2("Bad Option")
- GOTO EXIT
- +7 IF ZTA1="R"
- Begin DoDot:1
- +8 SET ZTSAVE("XQY")=""
- SET ZTSAVE("XQY0")=""
- SET ZTA4=$GET(XQY)
- SET ZTA5=$PIECE($GET(XQY0),U)
- End DoDot:1
- +9 ;
- +10 DO GETENV^%ZOSV
- SET ZTC34P=Y
- +11 ;Description
- 2 IF $DATA(ZTDESC)[0
- SET ZTDESC="No Description (%ZTLOAD)"
- +1 ;
- +2 IF $GET(ZTKIL)]""
- DO ZTKIL^%ZTLOAD2
- +3 IF $GET(ZTUCI)[","
- SET ZTUCI=$PIECE(ZTUCI,",")
- IF $GET(ZTCPU)[","
- SET ZTCPU=$PIECE(ZTCPU,",",2)
- DEVICE ;get device data
- +1 IF $DATA(ZTIO)#2
- IF $GET(ION)=$PIECE(ZTIO,";")
- IF $GET(IOT)="SPL"
- DO SPOOL^%ZTLOAD2
- +2 ;If no ZTIO, build from symbol table
- +3 IF $DATA(ZTIO)[0
- SET ZTIO=$GET(ION)
- IF $LENGTH(ZTIO)
- Begin DoDot:1
- +4 IF $GET(IOST)]""
- SET $PIECE(ZTIO,";",2)=IOST
- +5 IF $GET(IO("DOC"))]""
- SET ZTIO=ZTIO_";"_IO("DOC")
- +6 IF '$TEST
- IF $GET(IOM)]""
- SET ZTIO=ZTIO_";"_IOM
- IF $GET(IOSL)]""
- SET ZTIO=ZTIO_";"_IOSL
- +7 QUIT
- End DoDot:1
- +8 ;
- +9 ;Convert `IEN format
- IF $EXTRACT(ZTIO,1)="`"
- SET $PIECE(ZTIO,";")=$PIECE(^%ZIS(1,+$EXTRACT(ZTIO,2,99),0),"^")
- +10 SET ZTIO(1)=$SELECT($GET(ZTIO(1))'="D":"Q",1:"DIRECT")
- +11 ;Skip if no device
- IF $LENGTH(ZTIO)
- Begin DoDot:1
- +12 ;IO("HFSIO") and IOPAR are how %ZIS reports the user selected file name and parameters
- +13 IF '$DATA(ZTIO("H"))
- SET ZTIO("H")=$GET(IO("HFSIO"))
- +14 IF '$DATA(ZTIO("P"))
- SET ZTIO("P")=$GET(IOPAR)
- +15 IF $GET(IO("P"))]""
- IF ZTIO'[";/"
- SET ZTIO=ZTIO_";/"_IO("P")
- +16 IF $$NOQ^%ZISUTL($PIECE(ZTIO,";"))
- DO BADDEV^%ZTLOAD2("Restricted Device")
- +17 IF $EXTRACT(ZTIO,1,9)="P-MESSAGE"
- SET ZTSAVE("^TMP(""XM-MESS"",$J,")=""
- +18 QUIT
- End DoDot:1
- +19 ;
- +20 IF $DATA(%ZTLOAD("ERROR"))
- GOTO EXIT
- +21 ;
- +22 ;See that ^%ZTSK(-1) is set
- +23 IF $DATA(^%ZTSK(-1))[0
- SET ^%ZTSK(-1)=$SELECT($PIECE($GET(^%ZTSK(0)),U,3):$PIECE(^(0),U,3),1:1000)
- RECORD ;build record
- +1 ;Set to 1 if this system has $INCREMENT, otherwise 0.
- SET ZTINC=$GET(^%ZOSF("$INC"),1)
- +2 SET ZTGOT=0
- +3 ;For System that don't have $INC (GT.M, DTM, MSM)
- IF 'ZTINC
- Begin DoDot:1
- +4 ;Find a free entry, Claim it and Lock it.
- +5 ;This is just a starting point
- LOCK +^%ZTSK(-1):0
- SET ZTSK=^%ZTSK(-1)
- +6 FOR
- SET ZTSK=ZTSK+1
- IF '$DATA(^%ZTSK(ZTSK))
- Begin DoDot:2
- +7 ;Can we lock it
- LOCK +^%ZTSK(ZTSK):$GET(DILOCKTM,3)
- IF '$TEST
- QUIT
- +8 ;Already claimed
- IF $DATA(^%ZTSK(ZTSK))
- LOCK -^%ZTSK(ZTSK)
- +9 ;Claim it
- SET ^%ZTSK(ZTSK,.1)=0
- SET ^%ZTSK(-1)=ZTSK
- SET ZTGOT=1
- +10 QUIT
- End DoDot:2
- IF ZTGOT
- QUIT
- +11 ;
- LOCK -^%ZTSK(-1)
- +12 QUIT
- End DoDot:1
- +13 ;For DSM and OpenM. Faster over network(DDP)
- IF ZTINC
- Begin DoDot:1
- +14
- *** ERROR ***
- SET ZTSK=$INCREMENT(^%ZTSK(-1))
- +15 ;p446
- LOCK +^%ZTSK(ZTSK):$GET(DILOCKTM,3)
- SET ZTGOT=$TEST
- End DoDot:1
- +16 IF 'ZTGOT!($DATA(^%ZTSK(ZTSK,0)))
- LOCK -^%ZTSK(ZTSK)
- GOTO RECORD
- +17 ;
- TSTART
- +18 SET ^%ZTSK(ZTSK,0)=ZTRTN_U_ZTC1_U_$GET(ZTUCI)_U_$HOROLOG_U_ZTDTH_U_ZTA1_U_ZTA4_U_ZTA5_U_ZTC2_U_$PIECE(ZTC34P,U,1,2)_U_"ZTDESC"_U_$GET(ZTCPU)_U_$GET(ZTPRI)
- +19 SET ^%ZTSK(ZTSK,.1)=0
- SET ^%ZTSK(ZTSK,.03)=ZTDESC
- +20 SET ^%ZTSK(ZTSK,.2)=ZTIO_"^^^^"_ZTIO(1)_U_$GET(ZTIO("H"))
- IF $DATA(ZTSYNC)
- SET $PIECE(^%ZTSK(ZTSK,.2),U,7)=ZTSYNC
- +21 IF $GET(ZTIO("P"))]""
- SET ^%ZTSK(ZTSK,.25)=ZTIO("P")
- +22 ;
- +23 DO ZTSAVE
- +24 ;
- SCHED ;schedule task and quit
- +1 SET ZTSTAT=$SELECT(ZTDTH'="@":1,1:"K")_"^"_$HOROLOG
- SET $PIECE(ZTSTAT,U,8)=$GET(ZTKIL)
- +2 SET ^%ZTSK(ZTSK,.1)=ZTSTAT
- +3 IF ZTDTH'="@"
- LOCK +^%ZTSCH("SCHQ"):$GET(DILOCKTM,3)
- SET ZT=$$H3(ZTDTH)
- SET ^%ZTSK(ZTSK,.04)=ZT
- SET ^%ZTSCH(ZT,ZTSK)=""
- LOCK -^%ZTSCH("SCHQ")
- +4 LOCK -^%ZTSK(ZTSK)
- SET ZTSK("D")=ZTDTH
- +5 ;
- TCOMMIT
- EXIT ;Clean up
- +1 ;Clean up the Global
- IF $EXTRACT($GET(ZTIO),1,9)="P-MESSAGE"
- KILL ^TMP("XM-MESS",$JOB)
- +2 KILL X1,ZT,ZT1,ZTDTH,ZTKIL,ZTSAVE,ZTSTAT,ZTIO
- +3 QUIT
- +4 ;
- ZTSAVE ;save variables
- +1 NEW ZTIO
- +2 KILL %H,%T,ZTA1,ZTA4,ZTA5,ZTC1,ZTC2,ZTC34P,ZTCPU,ZTDESC,ZTIO,ZTNOGO,ZTPRI,ZTRTN,ZTUCI,ZTSYNC
- +3 SET ZTSAVE("DUZ(")=""
- +4 SET ZT1=""
- FOR
- SET ZT1=$ORDER(ZTSAVE(ZT1))
- IF ZT1=""
- QUIT
- DO EVAL
- +5 KILL ^%ZTSK(ZTSK,.3,"DUZ(","NEWCODE")
- +6 KILL ^%ZTSK(ZTSK,.3,"ZTSK"),^("ZTSAVE"),^("ZTDTH")
- +7 KILL ^%ZTSK(ZTSK,.3,"XQNOGO")
- +8 QUIT
- +9 ;
- EVAL ;ZTSAVE--evaluate expression
- +1 IF ZT1="*"
- SET X="^%ZTSK(ZTSK,.3,"
- DO DOLRO^%ZOSV
- QUIT
- +2 IF ZT1["*"
- IF $PIECE(ZT1,"*")'["("
- SET X="^%ZTSK(ZTSK,.3,"
- SET Y=ZT1
- DO ORDER^%ZOSV
- QUIT
- +3 IF $SELECT($EXTRACT(ZT1)="""":1,+ZT1'=ZT1:0,1:ZT1]0)
- IF $DATA(ZTSAVE(ZT1))#2
- SET @("^%ZTSK(ZTSK,"_ZT1_")=ZTSAVE(ZT1)")
- QUIT
- +4 IF $SELECT(ZT1'["(":1,1:$EXTRACT(ZT1,$LENGTH(ZT1))=")")
- IF $SELECT($DATA(@ZT1)#2:1,1:ZTSAVE(ZT1)]"")
- SET ^%ZTSK(ZTSK,.3,ZT1)=$SELECT(ZTSAVE(ZT1)]"":ZTSAVE(ZT1),1:@ZT1)
- QUIT
- +5 IF $EXTRACT(ZT1)="^"
- IF ZT1["("
- SET %X=ZT1
- SET %Y="^%ZTSK(ZTSK,.3,ZT1,"
- DO %XY^%RCR
- QUIT
- +6 IF ZT1["("
- SET %X=ZT1
- SET %Y="^%ZTSK(ZTSK,.3,ZT1,"
- DO %XY^%RCR
- +7 ;I ZT1["(" M ^%ZTSK(ZTSK,.3,ZT1)=@$P(ZT1,"(")
- +8 QUIT
- +9 ;
- H3(%) ;Convert $H to seconds.
- +1 QUIT 86400*%+$PIECE(%,",",2)
- H0(%) ;Covert from seconds to $H
- +1 QUIT (%\86400)_","_(%#86400)
