Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ZTM1

ZTM1.m

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