- XUTMTAL ;SEA/RDS - TaskMan: ToolKit, Select List ;06/27/94 14:01 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;8.0;KERNEL;;Jul 10, 1995
- ;
- START G SELECT
- ;
- SETUP ;SELECT--Setup Reader Input Parameters
- S DIR(0)="FAO^^D XFORM^XUTMTAL"
- S DIR("A")=$S($D(XUTMT("A"))#2:XUTMT("A"),1:"Select TASK: ")
- S DIR("?")=$S($D(XUTMT("?"))#2:XUTMT("?"),1:"^D HELP1^XUTMTAL")
- S DIR("??")=$S($D(XUTMT("??"))#2:XUTMT("??"),1:"^D ^XUTMQ")
- I DIR("??")="@" K DIR("??")
- I $D(XUTMT("B"))#2 S DIR("B")=XUTMT("B")
- I $D(DTIME)[0 S DIR("T")=60
- Q
- ;
- XFORM ;SELECT--Input Transform
- N ZT,ZT1,ZT2,ZT3,ZT4,ZTIGNORE,ZTOUT,ZTYPE
- K ^TMP($J,"XUTMT") S ZTOUT=0
- I $D(XUTMT("S1"))#2 X XUTMT("S1") I ZTOUT Q
- S ZTIGNORE=0,ZTYPE=$L(X,",")>1!(X["-")
- F ZT=1:1:$L(X,",") S ZT1=$P(X,",",ZT) D ELEMNT
- S ZT1="",ZT3="" F ZT=0:0 S ZT1=$O(^TMP($J,"XUTMT",ZT1)),ZT2="" Q:ZT1="" S:$D(^(ZT1))=1 ZT3=ZT3_","_ZT1 I $D(^(ZT1))=10 F ZT=0:0 S ZT2=$O(^TMP($J,"XUTMT",ZT1,ZT2)) Q:ZT2="" S ZT3=ZT3_","_ZT2_"-"_ZT1
- I ZT3'["-",ZT3'["," K ^TMP($J,"XUTMT")
- I ZT3="",'ZTYPE W !!?5,"That is not a valid task number." K X Q
- I ZT3="" W !!?5,"That is not a valid list of task numbers." K X Q
- I ZTIGNORE W !?5,"(Irregular list elements ignored)"
- S Y=$E(ZT3,2,$L(ZT3))
- I $D(XUTMT("S2"))#2 X XUTMT("S2") I '$D(X) K Y,^TMP($J,"XUTMT")
- Q
- ;
- ELEMNT ;XFORM--process each element in the list
- S ZT2=ZT1
- I ZT1["-" S ZT1=+ZT1,ZT2=$P(ZT2,"-",2)
- I $S(ZT1=0:1,ZT2=0:1,ZT1'?1N.N:1,1:ZT2'?1N.N) S ZTIGNORE=1 Q
- I ZT1>ZT2 S ZT3=ZT1,ZT1=ZT2,ZT2=ZT3
- D ADDTR
- Q
- ;
- ADDTR ;XFORM--Add Task Range To Compression List
- S ZT3=$O(^TMP($J,"XUTMT",ZT1-2)) I ZT3]"",ZT3<ZT2 S:$D(^(ZT3))=1&(ZT1-1=ZT3) ZT1=ZT3 I $D(^(ZT3))>9 S ZT4=$O(^(ZT3,"")) I ZT4<ZT1 S ZT1=ZT4
- S ZT3=$O(^TMP($J,"XUTMT",ZT2-1)) I ZT3]"" S:$D(^(ZT3))=1&(ZT2+1=ZT3) ZT2=ZT3 I $D(^(ZT3))>9 S ZT4=$O(^(ZT3,"")) I ZT4'>(ZT2+1) S ZT2=ZT3
- S ZT3=ZT1-1 F ZT4=0:0 S ZT3=$O(^TMP($J,"XUTMT",ZT3)) Q:ZT3=""!(ZT3>ZT2) K ^TMP($J,"XUTMT",ZT3)
- S:ZT1'=ZT2 ^TMP($J,"XUTMT",ZT2,ZT1)="" S:ZT1=ZT2 ^TMP($J,"XUTMT",ZT1)="" Q
- ;
- HELP1 ;SELECT--Default Help For '?'
- W !!?5,"Answer must be the internal number(s) of the task(s) to be selected."
- W !!?5,"Answer must be an integer between 1 and 999999999."
- W !?5,"Answer may be a range, for example 4000-5000."
- W !?5,"Answer may be a list, for example 4001,4004,4010-4020."
- Q
- ;
- SELECT ;Main Section--Select Task
- N DIR,DIRUT,DTOUT,DUOUT,X,Y,ZT
- D SETUP,^DIR K DIR
- I $D(DTOUT) W " ** TIME-OUT **",$C(7)
- I $D(DUOUT) W " ** ^-ESCAPE **"
- K XUTMT,ZTSK S ZTSK=$S(U[Y:"",1:Y) Q
- ;
- XUTMTAL ;SEA/RDS - TaskMan: ToolKit, Select List ;06/27/94 14:01 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;8.0;KERNEL;;Jul 10, 1995
- +3 ;
- START GOTO SELECT
- +1 ;
- SETUP ;SELECT--Setup Reader Input Parameters
- +1 SET DIR(0)="FAO^^D XFORM^XUTMTAL"
- +2 SET DIR("A")=$SELECT($DATA(XUTMT("A"))#2:XUTMT("A"),1:"Select TASK: ")
- +3 SET DIR("?")=$SELECT($DATA(XUTMT("?"))#2:XUTMT("?"),1:"^D HELP1^XUTMTAL")
- +4 SET DIR("??")=$SELECT($DATA(XUTMT("??"))#2:XUTMT("??"),1:"^D ^XUTMQ")
- +5 IF DIR("??")="@"
- KILL DIR("??")
- +6 IF $DATA(XUTMT("B"))#2
- SET DIR("B")=XUTMT("B")
- +7 IF $DATA(DTIME)[0
- SET DIR("T")=60
- +8 QUIT
- +9 ;
- XFORM ;SELECT--Input Transform
- +1 NEW ZT,ZT1,ZT2,ZT3,ZT4,ZTIGNORE,ZTOUT,ZTYPE
- +2 KILL ^TMP($JOB,"XUTMT")
- SET ZTOUT=0
- +3 IF $DATA(XUTMT("S1"))#2
- XECUTE XUTMT("S1")
- IF ZTOUT
- QUIT
- +4 SET ZTIGNORE=0
- SET ZTYPE=$LENGTH(X,",")>1!(X["-")
- +5 FOR ZT=1:1:$LENGTH(X,",")
- SET ZT1=$PIECE(X,",",ZT)
- DO ELEMNT
- +6 SET ZT1=""
- SET ZT3=""
- FOR ZT=0:0
- SET ZT1=$ORDER(^TMP($JOB,"XUTMT",ZT1))
- SET ZT2=""
- IF ZT1=""
- QUIT
- IF $DATA(^(ZT1))=1
- SET ZT3=ZT3_","_ZT1
- IF $DATA(^(ZT1))=10
- FOR ZT=0:0
- SET ZT2=$ORDER(^TMP($JOB,"XUTMT",ZT1,ZT2))
- IF ZT2=""
- QUIT
- SET ZT3=ZT3_","_ZT2_"-"_ZT1
- +7 IF ZT3'["-"
- IF ZT3'[","
- KILL ^TMP($JOB,"XUTMT")
- +8 IF ZT3=""
- IF 'ZTYPE
- WRITE !!?5,"That is not a valid task number."
- KILL X
- QUIT
- +9 IF ZT3=""
- WRITE !!?5,"That is not a valid list of task numbers."
- KILL X
- QUIT
- +10 IF ZTIGNORE
- WRITE !?5,"(Irregular list elements ignored)"
- +11 SET Y=$EXTRACT(ZT3,2,$LENGTH(ZT3))
- +12 IF $DATA(XUTMT("S2"))#2
- XECUTE XUTMT("S2")
- IF '$DATA(X)
- KILL Y,^TMP($JOB,"XUTMT")
- +13 QUIT
- +14 ;
- ELEMNT ;XFORM--process each element in the list
- +1 SET ZT2=ZT1
- +2 IF ZT1["-"
- SET ZT1=+ZT1
- SET ZT2=$PIECE(ZT2,"-",2)
- +3 IF $SELECT(ZT1=0:1,ZT2=0:1,ZT1'?1N.N:1,1:ZT2'?1N.N)
- SET ZTIGNORE=1
- QUIT
- +4 IF ZT1>ZT2
- SET ZT3=ZT1
- SET ZT1=ZT2
- SET ZT2=ZT3
- +5 DO ADDTR
- +6 QUIT
- +7 ;
- ADDTR ;XFORM--Add Task Range To Compression List
- +1 SET ZT3=$ORDER(^TMP($JOB,"XUTMT",ZT1-2))
- IF ZT3]""
- IF ZT3<ZT2
- IF $DATA(^(ZT3))=1&(ZT1-1=ZT3)
- SET ZT1=ZT3
- IF $DATA(^(ZT3))>9
- SET ZT4=$ORDER(^(ZT3,""))
- IF ZT4<ZT1
- SET ZT1=ZT4
- +2 SET ZT3=$ORDER(^TMP($JOB,"XUTMT",ZT2-1))
- IF ZT3]""
- IF $DATA(^(ZT3))=1&(ZT2+1=ZT3)
- SET ZT2=ZT3
- IF $DATA(^(ZT3))>9
- SET ZT4=$ORDER(^(ZT3,""))
- IF ZT4'>(ZT2+1)
- SET ZT2=ZT3
- +3 SET ZT3=ZT1-1
- FOR ZT4=0:0
- SET ZT3=$ORDER(^TMP($JOB,"XUTMT",ZT3))
- IF ZT3=""!(ZT3>ZT2)
- QUIT
- KILL ^TMP($JOB,"XUTMT",ZT3)
- +4 IF ZT1'=ZT2
- SET ^TMP($JOB,"XUTMT",ZT2,ZT1)=""
- IF ZT1=ZT2
- SET ^TMP($JOB,"XUTMT",ZT1)=""
- QUIT
- +5 ;
- HELP1 ;SELECT--Default Help For '?'
- +1 WRITE !!?5,"Answer must be the internal number(s) of the task(s) to be selected."
- +2 WRITE !!?5,"Answer must be an integer between 1 and 999999999."
- +3 WRITE !?5,"Answer may be a range, for example 4000-5000."
- +4 WRITE !?5,"Answer may be a list, for example 4001,4004,4010-4020."
- +5 QUIT
- +6 ;
- SELECT ;Main Section--Select Task
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,ZT
- +2 DO SETUP
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DTOUT)
- WRITE " ** TIME-OUT **",$CHAR(7)
- +4 IF $DATA(DUOUT)
- WRITE " ** ^-ESCAPE **"
- +5 KILL XUTMT,ZTSK
- SET ZTSK=$SELECT(U[Y:"",1:Y)
- QUIT
- +6 ;
