%ZTM1 ;SEA/RDS-TaskMan: Manager, Part 3 (Validate Task) ;07/27/2005 18:13
;;8.0;KERNEL;**118,127,275,355**;JUL 10, 1995;Build 9
MAIN ;
;SCHQ^%ZTM--examine task, determine device and destination, ^%ZTSK(ZTSK) lock at call.
D LOOKUP D D STORE
.D ZIS I %ZTREJCT Q
.D VOLUME I %ZTREJCT Q
.D UCI I %ZTREJCT Q
.Q
Q ;Un-lock back in %ZTM
LOOKUP ;
;MAIN--Unload Task Variables For Validation
S %ZTREJCT=0
D TSKSTAT(2,"Inspected")
S ZTREC=^%ZTSK(ZTSK,0)
S ZTREC02="",ZTREC1=$G(^%ZTSK(ZTSK,.1)),ZTREC2=$G(^%ZTSK(ZTSK,.2))
S ZTREC21="",ZTREC25=$G(^%ZTSK(ZTSK,.25)) ;,$P(ZTREC,U,6)=ZTDTH
S ^%ZTSK(ZTSK,.02)="" ;Clear
Q
;
ZIS ;MAIN--Determine Output Device
S ZTIO=$S($P(ZTREC2,U)]"":$P(ZTREC2,U),1:ZTST)
I ZTIO="" S (IO,ZTREC2,ZTREC21,ZTREC25)="" G ZISX
S $P(ZTREC2,U)=ZTIO,%ZIS="NQRST0",IOP=ZTIO,ZTIO(1)=$P(ZTREC2,U,5)
I ZTIO(1)="DIRECT" S %ZIS=%ZIS_"D"
D ^%ZIS K IO(1)
I $S($G(IOT)="VTRM":1,IO="":1,1:POP) D REJCT("INVALID OUTPUT DEVICE") G ZISX
I IOT="HG" S IO=""
;Check for IO queue at end
S $P(ZTREC2,U,1,4)=ZTIO_U_IO_U_IOT_U_IOST
S:'$D(IOCPU) IOCPU=$P($G(^%ZIS(1,+$G(IOS),0)),U,9) ;need IOCPU
S ZTREC21=$G(IOS)
ZISX Q
;
VOLUME ;determine destination volume set
S ZTDVOL(1)="",A=$P($G(IOCPU),":",2) ;device node
S ZTNODE=$S($L(A):A,1:$P($P(ZTREC,U,14),":",2))
S A=$S(ZTIO="":"",1:$P($G(IOCPU),":")) ;device cpu
S ZTDVOL=$S($L(A):A,1:$P($P(ZTREC,U,14),":")) ;Destination
S ZTCVOL=$P(ZTREC,U,12),ZTCVT=$$VSTYP(ZTCVOL) ;Creation
I ZTDVOL="" D
. I ZTCVT="C" S ZTDVOL=$S(%ZTYPE="P":%ZTVOL,ZTCVOL]"":ZTCVOL,1:%ZTVOL),ZTDVOL(1)=1 Q
. S ZTDVOL=$S(ZTCVOL]"":ZTCVOL,1:%ZTVOL) Q
S ZTREC02=U_ZTDVOL_U_ZTNODE_U_ZTDVOL(1)
;
V1 ;reject tasks with destination volume sets not in Volume Set file
S ZT1=$O(^%ZIS(14.5,"B",ZTDVOL,""))
I ZT1="" D REJCT("Task's volume set not listed in index.") Q
S ZTS=$G(^%ZIS(14.5,ZT1,0))
I ZTS="" D REJCT("Task's volume set not listed in file.") Q
;
V2 ;lookup type of volume set, and reject tasks to F or O types
S ZTYPE=$P(ZTS,U,10)
I ZTYPE="F"!(ZTYPE="O") D REJCT("Task's volume set can't accept tasks.") Q
;
V3 ;accept tasks with the current volume set as the destination
I ZTDVOL=%ZTVOL Q
;
V4 ;reject tasks whose destination volume sets lack link access
I $P(ZTS,U,3)="N" D REJCT("Task's volume set has no link access.") Q
Q
VSTYP(VS) ;Get a VS's type
Q:VS="" VS N %
S %=$O(^%ZIS(14.5,"B",VS,0)),%=$G(^%ZIS(14.5,+%,0))
Q $P(%,U,10)
;
UCI ;MAIN--determine destination UCI
S ZTUCI=$P($P(ZTREC,U,4),",")
S ZTUCI=$S(ZTUCI]"":ZTUCI,1:$P(ZTREC,U,11))
;
;reject tasks that lack a destination UCI
U1 ;
;reject tasks with no UCI of origin or requested destination
I ZTUCI="" D REJCT("Task has no destination UCI listed.") Q
U2 ;
;handle tasks whose destination volume set is the current one
;if UCI is here, accept the task; if not, reject it
I ZTDVOL=%ZTVOL D Q
. S X=ZTUCI_","_ZTDVOL X ^%ZOSF("UCICHECK")
. I 0[Y D REJCT("Task's UCI does not exist here.") Q
. S ZTUCI=$P(Y,",")
. S $P(ZTREC02,U)=ZTUCI
. I $E($P(ZTREC,U,2))'="%" Q
. S X=$P(ZTREC,U,2) X ^%ZOSF("TEST")
. I $T Q
. D REJCT("Task's entry routine does not exist here.")
.Q
U3 ;
;accept tasks whose dest. UCIs are listed under their dest. volume sets
I $O(^%ZIS(14.6,"AV",ZTDVOL,ZTUCI,"")) S $P(ZTREC02,U)=ZTUCI Q
U4 ;
;otherwise, the destination UCI must be a valid one here...
S X=ZTUCI X ^%ZOSF("UCICHECK")
I 0[Y D REJCT("Task's destination UCI failed check.") Q
U5 ;
;...and it must be changed to the associated UCI over there
S ZT1=$O(^%ZIS(14.6,"AT",ZTUCI,%ZTVOL,ZTDVOL,""))
I ZT1]"" S ZTUCI=ZT1
S $P(ZTREC02,U)=ZTUCI
Q
;
STORE ;Store Validated Data In Task Log, Quit If Needn't Do WAIT
I %ZTREJCT S $P(ZTREC1,U,1,2)="B^"_$H ;Rejected
I $D(^%ZTSK(ZTSK,0))[0 D TSKSTAT("I") S %ZTREJCT=1 Q
S ^%ZTSK(ZTSK,0)=ZTREC
S ^%ZTSK(ZTSK,.02)=ZTREC02
S ^%ZTSK(ZTSK,.1)=$P(ZTREC1,U,1,9)_U_$P(^(.1),U,10,11)
S ^%ZTSK(ZTSK,.2)=ZTREC2,^(.21)=ZTREC21,^(.25)=ZTREC25
K %ZTF,IOCPU
I ZTIO="" Q
I %ZTREJCT Q
I ZTDVOL'=%ZTVOL Q
I IOT'="TRM",IOT'="RES" Q
I $D(^%ZTSCH("IO",IO))>9 D IOWAIT
K X,Y
Q
;
IOWAIT ;If Device has a queue, Put Task On IO Queue.
S %ZTREJCT=1 D TSKSTAT("A","Put On The IO List")
S %ZTIO=IO,ZTIOS=ZTREC21,ZTIOT=IOT
D NQ^%ZTM4
Q
;
REJCT(MSG) ;Save reject msg, set flag
S %ZTREJCT=1,$P(ZTREC1,U,3)=MSG
I $G(DUZ)>.9 D
. N XQA,XQAMSG,XQADATA,XQAROU,ZTUCI
. S XQA(DUZ)="",XQAMSG="Your task #"_ZTSK_" rejected because: "_MSG,XQADATA=ZTSK,XQAROU="XQA^XUTMUTL"
. S ZTUCI=$P($P(ZTREC,U,4),","),ZTUCI=$S(ZTUCI]"":ZTUCI,1:$P(ZTREC,U,11))
. N ZTSK,ZTIO,ZTDTH,ZTCPU,ZTREC
. S ZTRTN="ALERT^%ZTMS4",ZTDTH=$H,ZTIO="",ZTSAVE("XQA*")=""
. D ^%ZTLOAD Q
Q
;
TSKSTAT(CODE,MSG) ; Update task's status
S $P(^%ZTSK(ZTSK,.1),"^",1,3)=$G(CODE)_U_$H_U_$G(MSG)
Q
;
H3(%) ;Convert $H to seconds.
Q 86400*%+$P(%,",",2)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTM1 4922 printed Dec 13, 2024@02:16:07 Page 2
%ZTM1 ;SEA/RDS-TaskMan: Manager, Part 3 (Validate Task) ;07/27/2005 18:13
+1 ;;8.0;KERNEL;**118,127,275,355**;JUL 10, 1995;Build 9
MAIN ;
+1 ;SCHQ^%ZTM--examine task, determine device and destination, ^%ZTSK(ZTSK) lock at call.
+2 DO LOOKUP
Begin DoDot:1
+3 DO ZIS
IF %ZTREJCT
QUIT
+4 DO VOLUME
IF %ZTREJCT
QUIT
+5 DO UCI
IF %ZTREJCT
QUIT
+6 QUIT
End DoDot:1
DO STORE
+7 ;Un-lock back in %ZTM
QUIT
LOOKUP ;
+1 ;MAIN--Unload Task Variables For Validation
+2 SET %ZTREJCT=0
+3 DO TSKSTAT(2,"Inspected")
+4 SET ZTREC=^%ZTSK(ZTSK,0)
+5 SET ZTREC02=""
SET ZTREC1=$GET(^%ZTSK(ZTSK,.1))
SET ZTREC2=$GET(^%ZTSK(ZTSK,.2))
+6 ;,$P(ZTREC,U,6)=ZTDTH
SET ZTREC21=""
SET ZTREC25=$GET(^%ZTSK(ZTSK,.25))
+7 ;Clear
SET ^%ZTSK(ZTSK,.02)=""
+8 QUIT
+9 ;
ZIS ;MAIN--Determine Output Device
+1 SET ZTIO=$SELECT($PIECE(ZTREC2,U)]"":$PIECE(ZTREC2,U),1:ZTST)
+2 IF ZTIO=""
SET (IO,ZTREC2,ZTREC21,ZTREC25)=""
GOTO ZISX
+3 SET $PIECE(ZTREC2,U)=ZTIO
SET %ZIS="NQRST0"
SET IOP=ZTIO
SET ZTIO(1)=$PIECE(ZTREC2,U,5)
+4 IF ZTIO(1)="DIRECT"
SET %ZIS=%ZIS_"D"
+5 DO ^%ZIS
KILL IO(1)
+6 IF $SELECT($GET(IOT)="VTRM":1,IO="":1,1:POP)
DO REJCT("INVALID OUTPUT DEVICE")
GOTO ZISX
+7 IF IOT="HG"
SET IO=""
+8 ;Check for IO queue at end
+9 SET $PIECE(ZTREC2,U,1,4)=ZTIO_U_IO_U_IOT_U_IOST
+10 ;need IOCPU
if '$DATA(IOCPU)
SET IOCPU=$PIECE($GET(^%ZIS(1,+$GET(IOS),0)),U,9)
+11 SET ZTREC21=$GET(IOS)
ZISX QUIT
+1 ;
VOLUME ;determine destination volume set
+1 ;device node
SET ZTDVOL(1)=""
SET A=$PIECE($GET(IOCPU),":",2)
+2 SET ZTNODE=$SELECT($LENGTH(A):A,1:$PIECE($PIECE(ZTREC,U,14),":",2))
+3 ;device cpu
SET A=$SELECT(ZTIO="":"",1:$PIECE($GET(IOCPU),":"))
+4 ;Destination
SET ZTDVOL=$SELECT($LENGTH(A):A,1:$PIECE($PIECE(ZTREC,U,14),":"))
+5 ;Creation
SET ZTCVOL=$PIECE(ZTREC,U,12)
SET ZTCVT=$$VSTYP(ZTCVOL)
+6 IF ZTDVOL=""
Begin DoDot:1
+7 IF ZTCVT="C"
SET ZTDVOL=$SELECT(%ZTYPE="P":%ZTVOL,ZTCVOL]"":ZTCVOL,1:%ZTVOL)
SET ZTDVOL(1)=1
QUIT
+8 SET ZTDVOL=$SELECT(ZTCVOL]"":ZTCVOL,1:%ZTVOL)
QUIT
End DoDot:1
+9 SET ZTREC02=U_ZTDVOL_U_ZTNODE_U_ZTDVOL(1)
+10 ;
V1 ;reject tasks with destination volume sets not in Volume Set file
+1 SET ZT1=$ORDER(^%ZIS(14.5,"B",ZTDVOL,""))
+2 IF ZT1=""
DO REJCT("Task's volume set not listed in index.")
QUIT
+3 SET ZTS=$GET(^%ZIS(14.5,ZT1,0))
+4 IF ZTS=""
DO REJCT("Task's volume set not listed in file.")
QUIT
+5 ;
V2 ;lookup type of volume set, and reject tasks to F or O types
+1 SET ZTYPE=$PIECE(ZTS,U,10)
+2 IF ZTYPE="F"!(ZTYPE="O")
DO REJCT("Task's volume set can't accept tasks.")
QUIT
+3 ;
V3 ;accept tasks with the current volume set as the destination
+1 IF ZTDVOL=%ZTVOL
QUIT
+2 ;
V4 ;reject tasks whose destination volume sets lack link access
+1 IF $PIECE(ZTS,U,3)="N"
DO REJCT("Task's volume set has no link access.")
QUIT
+2 QUIT
VSTYP(VS) ;Get a VS's type
+1 if VS=""
QUIT VS
NEW %
+2 SET %=$ORDER(^%ZIS(14.5,"B",VS,0))
SET %=$GET(^%ZIS(14.5,+%,0))
+3 QUIT $PIECE(%,U,10)
+4 ;
UCI ;MAIN--determine destination UCI
+1 SET ZTUCI=$PIECE($PIECE(ZTREC,U,4),",")
+2 SET ZTUCI=$SELECT(ZTUCI]"":ZTUCI,1:$PIECE(ZTREC,U,11))
+3 ;
+4 ;reject tasks that lack a destination UCI
U1 ;
+1 ;reject tasks with no UCI of origin or requested destination
+2 IF ZTUCI=""
DO REJCT("Task has no destination UCI listed.")
QUIT
U2 ;
+1 ;handle tasks whose destination volume set is the current one
+2 ;if UCI is here, accept the task; if not, reject it
+3 IF ZTDVOL=%ZTVOL
Begin DoDot:1
+4 SET X=ZTUCI_","_ZTDVOL
XECUTE ^%ZOSF("UCICHECK")
+5 IF 0[Y
DO REJCT("Task's UCI does not exist here.")
QUIT
+6 SET ZTUCI=$PIECE(Y,",")
+7 SET $PIECE(ZTREC02,U)=ZTUCI
+8 IF $EXTRACT($PIECE(ZTREC,U,2))'="%"
QUIT
+9 SET X=$PIECE(ZTREC,U,2)
XECUTE ^%ZOSF("TEST")
+10 IF $TEST
QUIT
+11 DO REJCT("Task's entry routine does not exist here.")
+12 QUIT
End DoDot:1
QUIT
U3 ;
+1 ;accept tasks whose dest. UCIs are listed under their dest. volume sets
+2 IF $ORDER(^%ZIS(14.6,"AV",ZTDVOL,ZTUCI,""))
SET $PIECE(ZTREC02,U)=ZTUCI
QUIT
U4 ;
+1 ;otherwise, the destination UCI must be a valid one here...
+2 SET X=ZTUCI
XECUTE ^%ZOSF("UCICHECK")
+3 IF 0[Y
DO REJCT("Task's destination UCI failed check.")
QUIT
U5 ;
+1 ;...and it must be changed to the associated UCI over there
+2 SET ZT1=$ORDER(^%ZIS(14.6,"AT",ZTUCI,%ZTVOL,ZTDVOL,""))
+3 IF ZT1]""
SET ZTUCI=ZT1
+4 SET $PIECE(ZTREC02,U)=ZTUCI
+5 QUIT
+6 ;
STORE ;Store Validated Data In Task Log, Quit If Needn't Do WAIT
+1 ;Rejected
IF %ZTREJCT
SET $PIECE(ZTREC1,U,1,2)="B^"_$HOROLOG
+2 IF $DATA(^%ZTSK(ZTSK,0))[0
DO TSKSTAT("I")
SET %ZTREJCT=1
QUIT
+3 SET ^%ZTSK(ZTSK,0)=ZTREC
+4 SET ^%ZTSK(ZTSK,.02)=ZTREC02
+5 SET ^%ZTSK(ZTSK,.1)=$PIECE(ZTREC1,U,1,9)_U_$PIECE(^(.1),U,10,11)
+6 SET ^%ZTSK(ZTSK,.2)=ZTREC2
SET ^(.21)=ZTREC21
SET ^(.25)=ZTREC25
+7 KILL %ZTF,IOCPU
+8 IF ZTIO=""
QUIT
+9 IF %ZTREJCT
QUIT
+10 IF ZTDVOL'=%ZTVOL
QUIT
+11 IF IOT'="TRM"
IF IOT'="RES"
QUIT
+12 IF $DATA(^%ZTSCH("IO",IO))>9
DO IOWAIT
+13 KILL X,Y
+14 QUIT
+15 ;
IOWAIT ;If Device has a queue, Put Task On IO Queue.
+1 SET %ZTREJCT=1
DO TSKSTAT("A","Put On The IO List")
+2 SET %ZTIO=IO
SET ZTIOS=ZTREC21
SET ZTIOT=IOT
+3 DO NQ^%ZTM4
+4 QUIT
+5 ;
REJCT(MSG) ;Save reject msg, set flag
+1 SET %ZTREJCT=1
SET $PIECE(ZTREC1,U,3)=MSG
+2 IF $GET(DUZ)>.9
Begin DoDot:1
+3 NEW XQA,XQAMSG,XQADATA,XQAROU,ZTUCI
+4 SET XQA(DUZ)=""
SET XQAMSG="Your task #"_ZTSK_" rejected because: "_MSG
SET XQADATA=ZTSK
SET XQAROU="XQA^XUTMUTL"
+5 SET ZTUCI=$PIECE($PIECE(ZTREC,U,4),",")
SET ZTUCI=$SELECT(ZTUCI]"":ZTUCI,1:$PIECE(ZTREC,U,11))
+6 NEW ZTSK,ZTIO,ZTDTH,ZTCPU,ZTREC
+7 SET ZTRTN="ALERT^%ZTMS4"
SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTSAVE("XQA*")=""
+8 DO ^%ZTLOAD
QUIT
End DoDot:1
+9 QUIT
+10 ;
TSKSTAT(CODE,MSG) ; Update task's status
+1 SET $PIECE(^%ZTSK(ZTSK,.1),"^",1,3)=$GET(CODE)_U_$HOROLOG_U_$GET(MSG)
+2 QUIT
+3 ;
H3(%) ;Convert $H to seconds.
+1 QUIT 86400*%+$PIECE(%,",",2)
