| 1 | %ZTM1 ;SEA/RDS-TaskMan: Manager, Part 3 (Validate Task) ;07/27/2005 18:13
|
---|
| 2 | ;;8.0;KERNEL;**118,127,275,355**;JUL 10, 1995;Build 9
|
---|
| 3 | MAIN ;
|
---|
| 4 | ;SCHQ^%ZTM--examine task, determine device and destination, ^%ZTSK(ZTSK) lock at call.
|
---|
| 5 | D LOOKUP D D STORE
|
---|
| 6 | .D ZIS I %ZTREJCT Q
|
---|
| 7 | .D VOLUME I %ZTREJCT Q
|
---|
| 8 | .D UCI I %ZTREJCT Q
|
---|
| 9 | .Q
|
---|
| 10 | Q ;Un-lock back in %ZTM
|
---|
| 11 | LOOKUP ;
|
---|
| 12 | ;MAIN--Unload Task Variables For Validation
|
---|
| 13 | S %ZTREJCT=0
|
---|
| 14 | D TSKSTAT(2,"Inspected")
|
---|
| 15 | S ZTREC=^%ZTSK(ZTSK,0)
|
---|
| 16 | S ZTREC02="",ZTREC1=$G(^%ZTSK(ZTSK,.1)),ZTREC2=$G(^%ZTSK(ZTSK,.2))
|
---|
| 17 | S ZTREC21="",ZTREC25=$G(^%ZTSK(ZTSK,.25)) ;,$P(ZTREC,U,6)=ZTDTH
|
---|
| 18 | S ^%ZTSK(ZTSK,.02)="" ;Clear
|
---|
| 19 | Q
|
---|
| 20 | ;
|
---|
| 21 | ZIS ;MAIN--Determine Output Device
|
---|
| 22 | S ZTIO=$S($P(ZTREC2,U)]"":$P(ZTREC2,U),1:ZTST)
|
---|
| 23 | I ZTIO="" S (IO,ZTREC2,ZTREC21,ZTREC25)="" G ZISX
|
---|
| 24 | S $P(ZTREC2,U)=ZTIO,%ZIS="NQRST0",IOP=ZTIO,ZTIO(1)=$P(ZTREC2,U,5)
|
---|
| 25 | I ZTIO(1)="DIRECT" S %ZIS=%ZIS_"D"
|
---|
| 26 | D ^%ZIS K IO(1)
|
---|
| 27 | I $S($G(IOT)="VTRM":1,IO="":1,1:POP) D REJCT("INVALID OUTPUT DEVICE") G ZISX
|
---|
| 28 | I IOT="HG" S IO=""
|
---|
| 29 | ;Check for IO queue at end
|
---|
| 30 | S $P(ZTREC2,U,1,4)=ZTIO_U_IO_U_IOT_U_IOST
|
---|
| 31 | S:'$D(IOCPU) IOCPU=$P($G(^%ZIS(1,+$G(IOS),0)),U,9) ;need IOCPU
|
---|
| 32 | S ZTREC21=$G(IOS)
|
---|
| 33 | ZISX Q
|
---|
| 34 | ;
|
---|
| 35 | VOLUME ;determine destination volume set
|
---|
| 36 | S ZTDVOL(1)="",A=$P($G(IOCPU),":",2) ;device node
|
---|
| 37 | S ZTNODE=$S($L(A):A,1:$P($P(ZTREC,U,14),":",2))
|
---|
| 38 | S A=$S(ZTIO="":"",1:$P($G(IOCPU),":")) ;device cpu
|
---|
| 39 | S ZTDVOL=$S($L(A):A,1:$P($P(ZTREC,U,14),":")) ;Destination
|
---|
| 40 | S ZTCVOL=$P(ZTREC,U,12),ZTCVT=$$VSTYP(ZTCVOL) ;Creation
|
---|
| 41 | I ZTDVOL="" D
|
---|
| 42 | . I ZTCVT="C" S ZTDVOL=$S(%ZTYPE="P":%ZTVOL,ZTCVOL]"":ZTCVOL,1:%ZTVOL),ZTDVOL(1)=1 Q
|
---|
| 43 | . S ZTDVOL=$S(ZTCVOL]"":ZTCVOL,1:%ZTVOL) Q
|
---|
| 44 | S ZTREC02=U_ZTDVOL_U_ZTNODE_U_ZTDVOL(1)
|
---|
| 45 | ;
|
---|
| 46 | V1 ;reject tasks with destination volume sets not in Volume Set file
|
---|
| 47 | S ZT1=$O(^%ZIS(14.5,"B",ZTDVOL,""))
|
---|
| 48 | I ZT1="" D REJCT("Task's volume set not listed in index.") Q
|
---|
| 49 | S ZTS=$G(^%ZIS(14.5,ZT1,0))
|
---|
| 50 | I ZTS="" D REJCT("Task's volume set not listed in file.") Q
|
---|
| 51 | ;
|
---|
| 52 | V2 ;lookup type of volume set, and reject tasks to F or O types
|
---|
| 53 | S ZTYPE=$P(ZTS,U,10)
|
---|
| 54 | I ZTYPE="F"!(ZTYPE="O") D REJCT("Task's volume set can't accept tasks.") Q
|
---|
| 55 | ;
|
---|
| 56 | V3 ;accept tasks with the current volume set as the destination
|
---|
| 57 | I ZTDVOL=%ZTVOL Q
|
---|
| 58 | ;
|
---|
| 59 | V4 ;reject tasks whose destination volume sets lack link access
|
---|
| 60 | I $P(ZTS,U,3)="N" D REJCT("Task's volume set has no link access.") Q
|
---|
| 61 | Q
|
---|
| 62 | VSTYP(VS) ;Get a VS's type
|
---|
| 63 | Q:VS="" VS N %
|
---|
| 64 | S %=$O(^%ZIS(14.5,"B",VS,0)),%=$G(^%ZIS(14.5,+%,0))
|
---|
| 65 | Q $P(%,U,10)
|
---|
| 66 | ;
|
---|
| 67 | UCI ;MAIN--determine destination UCI
|
---|
| 68 | S ZTUCI=$P($P(ZTREC,U,4),",")
|
---|
| 69 | S ZTUCI=$S(ZTUCI]"":ZTUCI,1:$P(ZTREC,U,11))
|
---|
| 70 | ;
|
---|
| 71 | ;reject tasks that lack a destination UCI
|
---|
| 72 | U1 ;
|
---|
| 73 | ;reject tasks with no UCI of origin or requested destination
|
---|
| 74 | I ZTUCI="" D REJCT("Task has no destination UCI listed.") Q
|
---|
| 75 | U2 ;
|
---|
| 76 | ;handle tasks whose destination volume set is the current one
|
---|
| 77 | ;if UCI is here, accept the task; if not, reject it
|
---|
| 78 | I ZTDVOL=%ZTVOL D Q
|
---|
| 79 | . S X=ZTUCI_","_ZTDVOL X ^%ZOSF("UCICHECK")
|
---|
| 80 | . I 0[Y D REJCT("Task's UCI does not exist here.") Q
|
---|
| 81 | . S ZTUCI=$P(Y,",")
|
---|
| 82 | . S $P(ZTREC02,U)=ZTUCI
|
---|
| 83 | . I $E($P(ZTREC,U,2))'="%" Q
|
---|
| 84 | . S X=$P(ZTREC,U,2) X ^%ZOSF("TEST")
|
---|
| 85 | . I $T Q
|
---|
| 86 | . D REJCT("Task's entry routine does not exist here.")
|
---|
| 87 | .Q
|
---|
| 88 | U3 ;
|
---|
| 89 | ;accept tasks whose dest. UCIs are listed under their dest. volume sets
|
---|
| 90 | I $O(^%ZIS(14.6,"AV",ZTDVOL,ZTUCI,"")) S $P(ZTREC02,U)=ZTUCI Q
|
---|
| 91 | U4 ;
|
---|
| 92 | ;otherwise, the destination UCI must be a valid one here...
|
---|
| 93 | S X=ZTUCI X ^%ZOSF("UCICHECK")
|
---|
| 94 | I 0[Y D REJCT("Task's destination UCI failed check.") Q
|
---|
| 95 | U5 ;
|
---|
| 96 | ;...and it must be changed to the associated UCI over there
|
---|
| 97 | S ZT1=$O(^%ZIS(14.6,"AT",ZTUCI,%ZTVOL,ZTDVOL,""))
|
---|
| 98 | I ZT1]"" S ZTUCI=ZT1
|
---|
| 99 | S $P(ZTREC02,U)=ZTUCI
|
---|
| 100 | Q
|
---|
| 101 | ;
|
---|
| 102 | STORE ;Store Validated Data In Task Log, Quit If Needn't Do WAIT
|
---|
| 103 | I %ZTREJCT S $P(ZTREC1,U,1,2)="B^"_$H ;Rejected
|
---|
| 104 | I $D(^%ZTSK(ZTSK,0))[0 D TSKSTAT("I") S %ZTREJCT=1 Q
|
---|
| 105 | S ^%ZTSK(ZTSK,0)=ZTREC
|
---|
| 106 | S ^%ZTSK(ZTSK,.02)=ZTREC02
|
---|
| 107 | S ^%ZTSK(ZTSK,.1)=$P(ZTREC1,U,1,9)_U_$P(^(.1),U,10,11)
|
---|
| 108 | S ^%ZTSK(ZTSK,.2)=ZTREC2,^(.21)=ZTREC21,^(.25)=ZTREC25
|
---|
| 109 | K %ZTF,IOCPU
|
---|
| 110 | I ZTIO="" Q
|
---|
| 111 | I %ZTREJCT Q
|
---|
| 112 | I ZTDVOL'=%ZTVOL Q
|
---|
| 113 | I IOT'="TRM",IOT'="RES" Q
|
---|
| 114 | I $D(^%ZTSCH("IO",IO))>9 D IOWAIT
|
---|
| 115 | K X,Y
|
---|
| 116 | Q
|
---|
| 117 | ;
|
---|
| 118 | IOWAIT ;If Device has a queue, Put Task On IO Queue.
|
---|
| 119 | S %ZTREJCT=1 D TSKSTAT("A","Put On The IO List")
|
---|
| 120 | S %ZTIO=IO,ZTIOS=ZTREC21,ZTIOT=IOT
|
---|
| 121 | D NQ^%ZTM4
|
---|
| 122 | Q
|
---|
| 123 | ;
|
---|
| 124 | REJCT(MSG) ;Save reject msg, set flag
|
---|
| 125 | S %ZTREJCT=1,$P(ZTREC1,U,3)=MSG
|
---|
| 126 | I $G(DUZ)>.9 D
|
---|
| 127 | . N XQA,XQAMSG,XQADATA,XQAROU,ZTUCI
|
---|
| 128 | . S XQA(DUZ)="",XQAMSG="Your task #"_ZTSK_" rejected because: "_MSG,XQADATA=ZTSK,XQAROU="XQA^XUTMUTL"
|
---|
| 129 | . S ZTUCI=$P($P(ZTREC,U,4),","),ZTUCI=$S(ZTUCI]"":ZTUCI,1:$P(ZTREC,U,11))
|
---|
| 130 | . N ZTSK,ZTIO,ZTDTH,ZTCPU,ZTREC
|
---|
| 131 | . S ZTRTN="ALERT^%ZTMS4",ZTDTH=$H,ZTIO="",ZTSAVE("XQA*")=""
|
---|
| 132 | . D ^%ZTLOAD Q
|
---|
| 133 | Q
|
---|
| 134 | ;
|
---|
| 135 | TSKSTAT(CODE,MSG) ; Update task's status
|
---|
| 136 | S $P(^%ZTSK(ZTSK,.1),"^",1,3)=$G(CODE)_U_$H_U_$G(MSG)
|
---|
| 137 | Q
|
---|
| 138 | ;
|
---|
| 139 | H3(%) ;Convert $H to seconds.
|
---|
| 140 | Q 86400*%+$P(%,",",2)
|
---|