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

ZTMS2.m

Go to the documentation of this file. 
  1. %ZTMS2 ;SEA/RDS-TaskMan: Submanager, Part 4 (Unload, Get Device) ;2/19/08  13:38
  1.  ;;8.0;KERNEL;**2,18,23,36,67,118,127,163,167,175,199,275,446**;Jul 10, 1995;Build 35
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;^%ZTSK(ZTSK),^%ZTSCH("DEV",IO) is locked on entry or return from GETNEXT
  1. PROCESS ;SUBMGR--process task and all others waiting for same device
  1.  L +^%ZTSCH("TASK",ZTSK):1 I '$T Q  ;Only allow one copy of a task at one time
  1.  D LOOKUP I $D(ZTREJECT) Q
  1.  D DEVICE
  1.  I POP L  Q  ;Release all locks
  1.  I ZTSYNCFL]"",'$$SYNCFLG("A",ZTSYNCFL,%ZTIO) D  Q
  1.  . D SYNCQ(ZTSYNCFL,%ZTIO,ZTDTH,ZTSK),^%ZISC L  ;Release all locks
  1.  . Q
  1.  ;Go run task
  1.  D TASK^%ZTMS3 I ZTYPE="C"!$D(ZTNONEXT) Q
  1.  D GETNEXT^%ZTMS7 I $D(ZTNONEXT)!$D(ZTQUIT) Q
  1.  G PROCESS
  1.  ;
  1. LOOKUP ;PROCESS--unload task, switch ucis, and test entry routine
  1.  K (%ZTIME,%ZTIO,DT,IO,U,ZTCPU,ZTDEVN,ZTDTH,ZTNODE,ZTPAIR,ZTPFLG,ZTQUEUED,ZTSK,ZTUCI,ZTYPE,ZTLKTM) ;p446
  1.  D TSKSTAT(4,"")
  1.  S ZTREC=^%ZTSK(ZTSK,0),ZTREC02=^(.02)
  1.  S ZTREC2=^%ZTSK(ZTSK,.2),ZTREC21=^(.21),ZTREC25=^(.25)
  1.  S ZTSYNCFL=$P(ZTREC2,"^",7),DUZ=+$P(ZTREC,U,3),DUZ(0)="@"
  1.  S X=$P(ZTREC02,U)_","_$P(ZTREC02,U,2)
  1.  I $P(ZTREC02,U,4) S $P(X,",",2)=ZTCPU
  1.  ;should do a check to see if X is OK, Should check UCI mapping.
  1.  I X'=ZTUCI S ZTUCI=X D SWAP^%XUCI
  1.  S X=$P($P(ZTREC,U,2),"("),ZTRTN=$P(ZTREC,U,1,2)
  1.  I $E(X)'="%",$L(X) X ^%ZOSF("TEST") I X=""!'$T D REJECT S ZTREJECT=""
  1.  Q
  1.  ;
  1. REJECT ;LOOKUP--entry routine isn't here; reject task
  1.  N Y X ^%ZOSF("UCI")
  1.  D TSKSTAT("B","No routine at destination "_Y_".")
  1.  I $D(ZTDEVN) D DEVLK^%ZTMS1(-1,%ZTIO) K ZTDEVN
  1.  L  Q  ;Clear all locks
  1.  ;
  1. DEVICE ;PROCESS--prepare requested device; if can't, make task wait
  1.  ;First clean-up all IO variables that could influence the device
  1.  K %ZIS,IO,IOCPU,IOHG,IOPAR,IOUPAR,IOS
  1.  ;If don't need a device, Setup minimum.
  1.  S ZTIO=$P(ZTREC2,U),ZTIOT=$P(ZTREC2,U,3)
  1.  I ZTIO="" S (IO,IO(0),IOF,IOM,ION,IOS,IOSL,IOST,IOT)="",POP=0 Q
  1.  ;
  1.  ;setup call
  1.  S %ZIS="LRS0"_$S($P(ZTREC2,U,5)="DIRECT":"D",1:"")
  1.  S:ZTIOT="HFS" %ZIS("HFSIO")=$P(ZTREC2,U,6),%ZIS("IOPAR")=ZTREC25
  1.  S:ZTIOT="MT" %ZIS("IOPAR")=ZTREC25
  1.  S (IO,IO(0))=%ZTIO,IOP=ZTIO
  1.  S:'$D(^%ZTSCH("DEVTRY",$P(ZTIO,";"))) ^($P(ZTIO,";"))=%ZTIME ;Set problem device check
  1.  K ^XUTL("XQ",$J),IO("ERROR")
  1.  ;
  1.  S:$P(ZTREC2,U,4)["MINIOUT" %ZISLOCK="^%ZTSCH(""NETMAIL"",IO)" ;The hang is on the close
  1.  ;call
  1.  S %ZISTO=3 D ^%ZIS K %ZISTO,%ZISLOCK ;See that we use a timeout.
  1.  I %ZTIO]"" D DEVLK^%ZTMS1(-1,%ZTIO) K ZTDEVN
  1.  I 'POP K ^%ZTSCH("DEVTRY",IO),^($P(ZTIO,";")) ;Clear problem device check
  1.  ;Reset %ZTIO if IO doesn't match
  1.  I 'POP,%ZTIO]"",IO'=%ZTIO C %ZTIO K IO(1,%ZTIO),^%ZTSCH("DEVTRY",$P(%ZTIO,";")) S %ZTIO=IO
  1.  ;
  1.  ;results
  1.  I POP,(ZTYPE'="C"),(ZTIOT="TRM")!(ZTIOT="RES")!(ZTIOT="HG") D IONQ Q  ;only add to IO queue if not type C.
  1.  I POP D SCHNQ Q
  1.  I IOT'="RES",IOT'="HG" U IO
  1.  S IO(0)=IO
  1.  I $P(^%ZIS(1,+IOS,0),U,7)="y" D ^%ZTMSH
  1.  Q
  1.  ;
  1. IONQ ;DEVICE--put task on Device Waiting List
  1.  I $D(^%ZTSK(ZTSK,0))[0 D TSKSTAT("I",4) G IOQX
  1.  D TSKSTAT("A","")
  1.  N %ZTIO S %ZTIO=IO
  1.  S ZTIO(1)=$P(ZTREC2,U,5),ZTIOS=ZTREC21
  1.  D NQ^%ZTM4 ;Uses %ZTIO as the Device $I value
  1. IOQX L  Q  ;Clear all Locks
  1.  ;
  1. SCHNQ ;DEVICE--if HFS or SPL or TYPE'=C, reschedule task 10 min in future (try later)
  1.  S ZTH=$$NEWH($H,300)
  1.  D TSKSTAT(1,"rescheduled for busy device")
  1.  S $P(^%ZTSK(ZTSK,.2),U,8)=$P(^%ZTSK(ZTSK,.2),U,8)+1 ;ReQ count
  1.  D SCHTM(ZTH)
  1.  I $L($G(IO("ERROR"))) S $P(^%ZTSK(ZTSK,.12),U,2,9)=$H_U_IO("ERROR") ;May tell why couldn't get device
  1.  L  Q  ;Clear all locks
  1.  ;
  1. SCHTM(ZTDTH) ;Set a new schedule time, See that task is updated
  1.  S $P(^%ZTSK(ZTSK,0),U,6)=$$H0^%ZTM(ZTDTH),^%ZTSK(ZTSK,.04)=ZTDTH,^%ZTSCH(ZTDTH,ZTSK)=""
  1.  Q
  1. NEWH(%H,%Y) ;Build a new schedule time, Return $H3 time.
  1.  N %
  1.  I %H["," S %H=$$H3^%ZTM(%H)
  1.  Q (%H+%Y)
  1.  ;
  1. SYNCFLG(ACT,FLAG,ZIO,STAT) ;Allocate/deallocate sync flag
  1.  N X,DA,SYNC
  1.  L +^%ZISL(14.8):30 E  Q 0
  1.  S X=0,SYNC=FLAG_"~"_ZIO,DA=$O(^%ZISL(14.8,"B",SYNC,0))
  1.  I ACT["A" D
  1.  . I DA S X=0 Q
  1.  . ;I $D(^%ZTSCH("SYNC",ZIO,FLAG)) S X=0 Q
  1.  . S X=$P(^%ZISL(14.8,0),"^",3)+1 F  Q:'$D(^%ZISL(14.8,X))  S X=X+1
  1.  . S $P(^(0),"^",3,4)=X_"^"_($P(^%ZISL(14.8,0),"^",4)+1),^%ZISL(14.8,X,0)=SYNC,^%ZISL(14.8,"B",SYNC,X)=""
  1.  . S X=1 Q
  1.  I ACT["D" D  S X=1
  1.  . Q:DA'>0
  1.  . K ^%ZISL(14.8,DA),^%ZISL(14.8,"B",SYNC,DA)
  1.  . S $P(^(0),"^",3,4)=(DA-1)_"^"_($P(^%ZISL(14.8,0),"^",4)-1)
  1.  . Q
  1.  I ACT["S" D  S X=1
  1.  . Q:DA'>0
  1.  . S ^%ZISL(14.8,DA,1)=$G(STAT)
  1.  . Q
  1.  I ACT["?" S X=(DA)!($D(^%ZTSCH("SYNC",ZIO,FLAG)))
  1.  L -^%ZISL(14.8)
  1.  Q X
  1.  ;
  1. SYNCQ(FLAG,ZIO,ZTH,ZTSK) ;Put task on sync flag waiting list
  1.  L +^%ZTSCH("SYNC")
  1.  S ^%ZTSCH("SYNC",ZIO,FLAG,ZTSK)=ZTH
  1.  L -^%ZTSCH("SYNC")
  1.  Q
  1. SCHSYNC(FLAG,ZIO) ;put a waiting task in IO queue
  1.  L +^%ZTSCH("SYNC") I $D(^%ZTSCH("SYNC",ZIO,FLAG)) N ZTH,ZTSK D
  1.  . S ZTSK=$O(^(FLAG,0)),ZTH=$G(^(+ZTSK)) Q:ZTSK=""  S:$D(^%ZTSCH("IO",ZIO))[0 ^(ZIO)=IOT
  1.  . S ^%ZTSCH("IO",ZIO,ZTH,ZTSK)=""
  1.  . K ^%ZTSCH("SYNC",ZIO,FLAG,ZTSK)
  1.  . Q
  1.  L -^%ZTSCH("SYNC")
  1.  Q
  1. TSKSTAT(CODE,MSG) ;Record status
  1.  S $P(^%ZTSK(ZTSK,.1),U,1,3)=$G(CODE)_U_$H_U_$G(MSG)
  1.  Q
  1.  ;
  1. POST ;Post INIT cleanup for patch XU*8*167
  1.  N T S T=0
  1.  F  S T=$O(^%ZTSCH(T)) Q:T'>0  I $D(^%ZTSCH(T,0)) K ^%ZTSCH(T,0)
  1.  Q