cQCTK1	;Background Job Launcher ;cQCTK1;
	G START
	;
date	;date
	N %H,%J,%R S %H=1+$H,%J=%H\1461,%R=%H#1461,DJ=%J*4+1841+(%R\365),DD=%R#365,DM=1 I %R=1460 S DD=365,DJ=DJ-1
	F %J=31,(%R>1154)+28,31,30,31,30,31,31,30,31,30 Q:%J'<DD  S DM=DM+1,DD=DD-%J
	S:'DD DJ=DJ-1,DM=12,DD=31 S:DD<10 DD=0_DD S:DM<10 DM=0_DM S DT=DD_"."_DM_"."_$E(DJ,3,4)
datez	Q
time	;time
	N %J,%R S QT=$G(QT),%R=$P($H,",",2)\60,%J=%R\60
	S TD=$J(%J,2)_$P(" u ; h ; h ",";",$S(QT="F":2,QT="E":3,1:1))_(%R#60\10)_(%R#10)
timez	Q
doubleq(X)	;Double quotes in string
	N Y S Y=0 F  S Y=$F(X,"""",Y) Q:'Y  S X=$E(X,0,Y-1)_""""_$E(X,Y,$L(X)),Y=Y+1
doubleqz	K Y Q X
	;
T0	;Backgroundjob Manager ;
T1	; herstart wegens ;
T2	;Cannot start BG-Job ;
	;
T0F	;Backgroundjob Manager ;
T1F	; redemarré à cause d'une ;
T2F	;Cannot start BG-Job ;
	;
T0E	;Backgroundjob Manager ;
T1E	; restarted due to ;
T2E	;Cannot start BG-Job ;
	;
T0D	;Backgroundjob Manager ;
T1D	; restarted due to ;
T2D	;Cannot start BG-Job ;
	;
START	S $ZT="TRAP^"_$T(+0)
	S %logctk="^["""_$ZU(5)_"""]cLOG("""_$ZU(5)_""",""CTK0"",""JOB"","""_$ZCVT($ZU(110),"U")_""")"
	S %logl="^["""_$ZU(5)_"""]cLOGL("""_$ZU(5)_""",""CTK0"",""JOB"","""_$ZCVT($ZU(110),"U")_""")"
	L +@%logl:5 E  G YZ
	K @%logctk@(0,0) D JOB^cQZSTART
	D date,time S Q="DAM",Q1="",D="\",BG=$H
	S @%logctk@(0,0)=$J_"\"_DT_"\"_TD_"\"_BG_"\"_$system.License.GetUserId()
	S @%logctk@(+$H,$P($H,",",2))=$J_"\"_$ZD(+$H,2,,4)_"\"_$ZT($P($H,",",2),1)_"\"_BG_"\Started"
	D CLEAN^cQ13($NA(@%logctk,4),40)
	S ^cJOB($J,$ZCVT($ZU(110),"U"),"job","qu")="z"   ; flag this job as a system-job
	K R S R(0)=$ZV D M^cQ14("Caretaker started!",.R,1) K R
	D HIGH^%PRIO    ; put job in high priority
	D NSPC^cQ21(.SYS,1)
	S (K,NMSPT)="",prevh=+$H,vnr=0,sys=$ZCONVERT($TR($ZCVT($ZU(110),"U"),"-.,_"),"L")
	F  S K=$O(SYS(K)) Q:K=""  D
	. I $ZSTRIP(K,">N")'=$ZSTRIP($ZU(5),">N") K SYS(K)
	. I $ZSTRIP(K,">N")=$ZSTRIP($ZU(5),">N") S NMSPT=NMSPT_$P(K,$ZSTRIP($ZU(5),">N"),2)_" "
	S:$E(NMSPT,$L(NMSPT))=" " $E(NMSPT,$L(NMSPT))=""
	S DELTA=0,%H=15
	F  H $G(%H,60)-$G(DELTA) S %H=$G(^cLOG($ZU(5),"CTK0","WAIT"),60) Q:'%H  D
	. I %H<60 S %H=60,^cLOG($ZU(5),"CTK0","WAIT")=%H
	. S loopb=$ZU(188),BG=$H,I="" D date,time
	. ;Falls 'now' within a 'logon not allowed' period?
	. S NOL=0,K=$$SIG^cAFA1("PAR","LOGIN",BG#7+133) I $L(K) D
	.. S NOLA=$P(K,"-"),NOLB=$P(K,"-",2) I NOLB="00:00" S NOLB="24:00"
	.. S BGX=+$P(BG,",",2) I 'BGX S BGX=1
	.. S NOLAX=$P(NOLA,":")*3600+($P(NOLA,":",2)*60)
	.. S NOLBX=$P(NOLB,":")*3600+($P(NOLB,":",2)*60)
	.. I (BGX>NOLAX)&(BGX<NOLBX) S NOL=1
	. F  S I=$O(^cLOG($ZU(5),"CTK0","AUTO",I),1,L) Q:I=""  I $D(^(I))#10 D  L -^cLOGL($ZU(5),"CTK0","AUTO",I)
	.. L +^cLOGL($ZU(5),"CTK0","AUTO",I):0 E  Q
	.. ; if 'run now' has been set more than 5 minutes ago, reset it
	.. I $P(L,"\",17)=1,(BG-$P(L,"\",28)*86400+$P(BG,",",2)-$P($P(L,"\",28),",",2)>300) S $P(^cLOG($ZU(5),"CTK0","AUTO",I),"\",17)=""
	.. ;not during 'logon not allowed' period
	.. I NOL,'$P(L,"\",18) Q
	.. S P=$P(L,"\") Q:'$L(P)  Q:'$P(L,"\",5)  D PARSE Q:'$L(B)
	.. I $L($P(L,"\",13))," "_$P(L,"\",13)_" "'[(" "_$ZCVT($ZU(110),"U")_" ") Q
	.. S RF=$P(L,"\",2),RK=$P(L,"\",3),RH=$P(L,"\",4),RL="",X=0
	.. S WT=$P(L,"\",11),NMSPS=$P(L,"\",10),MAS=$P(L,"\",12),PRIO=+$P(L,"\",14),KUU=$P(L,"\",15) S:KUU="" KUU="EA"
	.. S NOTA=$P($P(L,"\",16),"-"),NOTB=$P($P(L,"\",16),"-",2)
	.. S X="" F  S X=$O(^cLOG($ZU(5),"CTK0","AUTO",I,$ZCVT($ZU(110),"U"),X),-1) Q:X'>+BG
	.. I X S Y="" F  S Y=$O(^cLOG($ZU(5),"CTK0","AUTO",I,$ZCVT($ZU(110),"U"),X,Y),-1) Q:X'=+BG  Q:Y'>$P(BG,",",2)
	.. I X,Y S RL=$P($G(^cLOG($ZU(5),"CTK0","AUTO",I,$ZCVT($ZU(110),"U"),X,Y)),"\",4)
	.. S NMSPC="" S:'$L(NMSPS) NMSPS=$ZU(5) S:NMSPS="*" NMSPS=NMSPT
	.. F i=1:1:$L(NMSPS," ") S NMSPX=$P(NMSPS," ",i),NMSPC=NMSPC_$S($L(NMSPC):" ",1:"")_$S(NMSPX?1.N:$TR($ZU(5),"0123457890"),1:"")_NMSPX
	.. I $S($L($G(^cLOG($ZU(5),"SYSTEM","MASTER"))):$G(^cLOG($ZU(5),"SYSTEM","MASTER")),1:$ZCVT($ZU(110),"U"))'=$S($L($G(^cLOG($ZU(5),"SYSTEM","SLAVE"))):$G(^cLOG($ZU(5),"SYSTEM","SLAVE")),1:$S($L($G(^cLOG($ZU(5),"SYSTEM","MASTER"))):$G(^cLOG($ZU(5),"SYSTEM","MASTER")),1:$ZCVT($ZU(110),"U"))) S NS=$$NS^cQ14 Q:$S($S($L($G(^cLOG($ZU(5),"SYSTEM","MASTER"))):$G(^cLOG($ZU(5),"SYSTEM","MASTER")),1:$ZCVT($ZU(110),"U"))=NS:$S(MAS="S":1,1:0),$S($L($G(^cLOG($ZU(5),"SYSTEM","SLAVE"))):$G(^cLOG($ZU(5),"SYSTEM","SLAVE")),1:$S($L($G(^cLOG($ZU(5),"SYSTEM","MASTER"))):$G(^cLOG($ZU(5),"SYSTEM","MASTER")),1:$ZCVT($ZU(110),"U")))=NS:$S(MAS="M":1,1:0),1:0)
	.. ;
	.. ;Start-switch set to zero (do no start routine)
	.. S X=0
	.. ;Run now ?
	.. I $P(L,"\",17)=1 S $P(^cLOG($ZU(5),"CTK0","AUTO",I),"\",17)="" S X=1
	.. ;
	.. ; ***** op een welbepaalde dag
	.. I 'X,RF>57600,RF=+$H  Q:$$TM(RH,%H)  S X=1
	.. ;
	.. ; ***** om de zoveel seconden (max 57600 = om de 16 uren)
	.. I 'X,RF>30,RF<57600 Q:$$LR(RL,RF)  D  Q:NOT  S X=1
	... S NOT=0 Q:'$L(NOTA)  Q:'$L(NOTB)
	... ; do not run if later than NOTA AND before NOTB
	... S BGX=$P(BG,",",2)-($P(BG,",",2)#60)  	;filter out seconds
	... S NOTAX=$P(NOTA,":")*3600+($P(NOTA,":",2)*60)
	... S NOTBX=$P(NOTB,":")*3600+($P(NOTB,":",2)*60)
	... I NOTAX<NOTBX S NOT=0 I (BGX>NOTAX)&(BGX<NOTBX) S NOT=1
	... I NOTAX>NOTBX S NOT=1 I (BGX>NOTBX)&(BGX<NOTAX) S NOT=0
	.. ;
	.. ; ***** elke dag, bepaald uur  
	.. I 'X,RF=1 Q:$$TM(RH,%H)  Q:$$LR(RL,%H)  S X=1
	.. ;
	.. ; ***** elke werkdag, bepaald uur  
	.. I 'X,RF=2 Q:BG#7=2  Q:BG#7=3  Q:$$TM(RH,%H)  Q:$$LR(RL,%H)  S X=1
	.. ;
	.. ; ***** elke week, bepaalde dag, bepaald uur
	.. I 'X,RF=7 Q:BG#7'=RK  Q:$$TM(RH,%H)  Q:$$LR(RL,%H)  S X=1
	.. ;
	.. ; ***** elke 14 dagen, bepaalde dag, bepaald uur
	.. I 'X,RF=14 Q:BG#7'=RK  Q:RL+10>BG  Q:$$TM(RH,%H)  Q:$$LR(RL,%H)  S X=1
	.. ;
	.. ; ***** elke maand, bepaalde dag, bepaald uur
	.. I 'X,RF=30 D  Q:RX'=RK  Q:$$TM(RH,%H)  Q:$$LR(RL,%H)  S X=1
	... S RX=+DD I RK=99 D
	.... I RX=28,+DM=2,'(DJ#4&'(DJ#100)!(DJ#400)&'(DJ#4000)) S RX=99 Q
	.... I RX=29,+DM=2 S RX=99 Q
	.... I RX=30,"\4\6\9\11\"[("\"_+DM_"\") S RX=99 Q
	.... I RX=31,"\1\3\5\7\8\10\12\"[("\"_+DM_"\") S RX=99 Q
	.. ;
	.. ;Run the background job
	.. I X D
	... ; Build routine
	... D P
	... ;Remove the Lock
	... L -^cLOGL($ZU(5),"CTK0","AUTO",I)
	... J @("^"_p_"::3") S T=$T,X=$ZC
	... I 'T D
	.... ; don't try again if sending e-mail failed
	.... I $P($P(L,"\"),"(")="SEND^cA350" X "zr  zs "_p Q
	.... S %=$P($T(@("T2"_$G(QT))),";",2)_I_" -> "_$P(L,"\") D ^cA400,AL(0)
	.... H 1 J @("^"_p_"::3") S T=$T,X=$ZC
	.... I 'T S %=$P($T(@("T2"_$G(QT))),";",2)_I_" -> "_$P(L,"\")_" second try" D ^cA400,AL(0) X "zr  zs "_p
	... L +@%logl:0
	... S $P(@%logctk,"\",1)=$S('T:"no",1:X),$P(@%logctk,"\",2)=DT
	... S $P(@%logctk,"\",3)=TD,$P(@%logctk,"\",4)=BG
	... D CLEAN^cQ13($NA(@%logctk,5),20)
	... L -@%logl
	. S loope=$ZU(188),BE=$H
	. S loopd=$J(loope-loopb*3600*24+($P(loope,",",2)-$P(loopb,",",2)),0,3)
	. I $G(^cLOG($ZCVT($ZU(110),"U"),"CTK0","FRACTHANG")) S DELTA=loopd   ;DELTA = x.yyy seconds
	. E  S DELTA=BE-BG*3600*24+($P(BE,",",2)-$P(BG,",",2))    ;DELTA = x seconds
	. I $G(^cLOG($ZU(5),"CTK0","LOOP",0,"LOG")) D
	.. S (loopi,loops)=+^("LOG")
	.. F  S loopi=$O(^cLOG($ZU(5),"CTK0","LOOP",$ZCVT($ZU(110),"U"),loopi)) Q:loopi=""  K ^(loopi)
	.. S loopi=$G(^cLOG($ZU(5),"CTK0","LOOP",$ZCVT($ZU(110),"U"),0),0)+1 I loopi>loops s loopi=1
	.. S ^cLOG($ZU(5),"CTK0","LOOP",$ZCVT($ZU(110),"U"),0)=loopi
	.. S ^cLOG($ZU(5),"CTK0","LOOP",$ZCVT($ZU(110),"U"),loopi)=$ZDATETIME(loopb,8,1,3)_"\"_loopb_"\"_loope_"\"_loopd
	;
	S %logctk="^cLOG("""_$ZU(5)_""",""CTK0"",""JOB"","""_$ZCVT($ZU(110),"U")_""")",$P(@%logctk@(0,0),"\")=0 D LOG
	;
YZ	Q
	;
P	; build program
	K p
	S curh=+$H,day=+$H,tim=+$P($H,",",2) i curh'=prevh s vnr=0,prevh=curh
	F  S vnr=vnr+1,vnrm="0000"_vnr,vnrf=$e(vnrm,$l(vnr),$l(vnrm)),p="p"_curh_sys_vnrf Q:'$D(^$R(p))
	S %logctk="^["""_$ZU(5)_"""]cLOG("""_$ZU(5)_""",""CTK0"",""AUTO"","_I_","""_$ZCVT($ZU(110),"U")_""","_day_","_tim_")"
	S q=0,p(q)=p_" ;"_p_"; "_$ZD(day,4)_" - "_$ZT(tim,1)
	S q=q+1,p(q)=" ;"
	S q=q+1,p(q)=" S $ZT=""ERR"" D "_$S(PRIO=-1:"LOW",PRIO=1:"HIGH",1:"NORMAL")_"^%PRIO"
	S q=q+1,p(q)=" L +^["""_$ZU(5)_"""]cLOGL("""_$ZU(5)_""",""CTK0"",""AUTO"","_I_"):1 E  G X"
	S q=q+1,p(q)=" ;"
	F i=1:1:$L(NMSPC," ") S NMSPX=$P(NMSPC," ",i) I $L(NMSPX),$ZU(90,10,NMSPX),$D(^$[NMSPX]ROUTINE(B)) D
	. S q=q+1,p(q)=" ZN """_NMSPX_""" S Q="""_KUU_""" D ^cA604 S QU=""SYS"",QL="""",%bg=1 D "_$P(L,"\")
	. I WT,$L(NMSPC," ")>1,i<$L(NMSPC," ") S q=q+1,p(q)=" H "_(WT*60)
	S q=q+1,p(q)=" ;"
	S q=q+1,p(q)=" D ^cA105,^cA106"
	S q=q+1,p(q)=" S $P("_%logctk_",""\"",6)=DT,$P(^("_tim_"),""\"",7)=TD,$P(^("_tim_"),""\"",8)=$H"
	S q=q+1,p(q)=" L -^["""_$ZU(5)_"""]cLOGL("""_$ZU(5)_""",""CTK0"",""AUTO"","_I_")"
	S q=q+1,p(q)=" ;"
	s q=q+1,p(q)="X ZN """_$ZU(5)_""" X ""zr  zs "_p_""""
	S q=q+1,p(q)=" ;"
	S q=q+1,p(q)="YZ Q"
	S q=q+1,p(q)=" ;"
	S q=q+1,p(q)="ERR ;Errortrap ;"
	S q=q+1,p(q)=" ZN """_$ZU(5)_""" S %E(0)=""Error: ""_$ZE,%E(1)=""Routine: "_$$doubleq($P(L,"\"))_""""
	S q=q+1,p(q)=" S %E(2)="""" F I=1:1 S %E(I+3)=$T(+I) Q:$E($T(+I),1,2)=""ZZ"""
	S q=q+1,p(q)=" D ^cA400,M^cQ14(""Error in BackGround Job "_I_" ""_%E(1),.%E)"
	S q=q+1,p(q)=" Q"
	S q=q+1,p(q)=" ;"
	S q=q+1,p(q)="ZZ ; "_$ZD(day,4)_" - "_$ZT(tim,1)
	X "s i="""" zr  x ""f  s i=$o(p(i)) q:i=""""""""  zi p(i)"" zs "_p
	Q
	;
R	; Program is removed and traps here
	I $ZE["<NOROUTINE>" Q
	D ^cA407 Q
	;
PARSE	N C Q:'$L(P)
	I P'["^" S P="^"_P,$P(L,"\")=P,$P(^cLOG($ZU(5),"CTK0","AUTO",I),"\")=P
	I P[":(" S C=$P($P($P(P,":(",2),")"),":"),NMSPC=$$SQ(C)
PARSE1	S B=$P($TR(P,"^|[(:","~~~~~"),"~",2),CPU=""
	Q
	;
SQ(K)	Q $TR(K,"""")
	;
TM(H,A)	N T
	S H=$G(H),A=$G(A,10)-1,H=H*3600+($P(H,":",2)*60),T=+$P(BG,",",2)
	Q $S(T<H!(T>(H+A)):1,1:0)
	;
LR(L,R)	Q ($P(BG,",",2)-$P(L,",",2)/86400+BG-L)<(R-1/86400)
	;
LOG	Q:'$L($G(%logctk))  S BG=$H D date,time H 5
	F  L +@%logl:5 Q:$T
	S $P(@%logctk@(0,0),"\",6)=DT,$P(@%logctk@(0,0),"\",7)=TD,$P(@%logctk@(0,0),"\",8)=BG
	D CLEAN^cQ13($NA(@%logctk,5),20)
	L -@%logl
	Q
	;
TRAP	S %=$ZE,M=$T(+0)_$P($T(T1),";",2)_%,$ZT="TRAP^"_$T(+0)
	S %logctk="^["""_$ZU(5)_"""]cLOG("""_$ZU(5)_""",""CTK0"",""JOB"","""_$ZCVT($ZU(110),"U")_""")"
	S @%logctk@(+$H,$P($H,",",2))=$J_"\"_$ZD(+$H,2,,4)_"\"_$ZT($P($H,",",2),1)_"\"_$H_"\"_% D CLEAN^cQ13($NA(@%logctk,5),40)
	I %[$T(+0),%["<INTERRUPT>" Q
	S %nspc=$ZU(5)					;remember current namespace
	ZN "%SYS" S SHUTDOWN=$$%swstat^SWSET(16,0)		;Shutdown in progress switch
	ZN %nspc						;switch back to where you came from
	I $S($L($G(^cLOG($ZU(5),"SYSTEM","MASTER"))):$G(^cLOG($ZU(5),"SYSTEM","MASTER")),1:$ZCVT($ZU(110),"U"))'=$S($L($G(^cLOG($ZU(5),"SYSTEM","SLAVE"))):$G(^cLOG($ZU(5),"SYSTEM","SLAVE")),1:$S($L($G(^cLOG($ZU(5),"SYSTEM","MASTER"))):$G(^cLOG($ZU(5),"SYSTEM","MASTER")),1:$ZCVT($ZU(110),"U"))),$ZCVT($ZU(110),"U")=$S($L($G(^cLOG($ZU(5),"SYSTEM","SLAVE"))):$G(^cLOG($ZU(5),"SYSTEM","SLAVE")),1:$S($L($G(^cLOG($ZU(5),"SYSTEM","MASTER"))):$G(^cLOG($ZU(5),"SYSTEM","MASTER")),1:$ZCVT($ZU(110),"U"))),SHUTDOWN Q  	;shutdown switch is set, do not log error on slave
	; auto-restart this program if edited
	I %[$T(+0),%["<CLOBR>"!(%["<EDITED>") D M^cQ14(M) L  J @("^"_$T(+0)) Q
	D ^cA400,AL(1)
	Q
	;
AL(%1)	; verzenden alert
	I %1 D D1004^cANEM0($T(+0),$P($T(@("T0"_$G(QT))),";",2)) Q
	D D1005^cANEM0($T(+0),$P($T(@("T0"_$G(QT))),";",2)) Q
	Q
	;
ZZ	; 17.01.2012 - 15:58 * Cache-r6.4.9