cQZSTART ; User login routine ;%ZSTART;
;DATA-M; Do not remove this line!
Q
;
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'
16 I=16
. S K=$P($P($G(^cLOG($ZU(5),"CTK0","JOB",$ZCVT($ZU(110),"U"),0,0)),"\",5),"@",2)
. F I=I:1:16 S ID="127.0.0."_I_$S($L(K):"@"_K,1:"") I $system.License.ConnectionCount(ID)lics s lici=1
.. S ^cLOG($ZU(5),"CTK0","LICENSE",$ZCVT($ZU(110),"U"),0)=lici
.. S ^cLOG($ZU(5),"CTK0","LICENSE",$ZCVT($ZU(110),"U"),lici)=$ZDATETIME(licb,8,1,3)_"\"_$J_"\"_id_"\"_idc_"\"_jd_"\"_jdc
JOBZ Q
;
CALLIN ; Any code here is run when a process is started via CALLIN interface.
CALLINZ Q
;
YZ Q
;
LSE ZQ
;
Message(Msg) ;
n (QUIET,Msg)
s $ZT="MessageZ"
i QUIET=0 w !,$ztime($p($h,",",2))_" "_Msg
i $zu(9,"",Msg)
MessageZ q
;
PV(P) ;check if PDT or VRC
S P=+$G(P,$G(io))
I P,"\PDT\VRC\"[("\"_$P($G(^cQSYS(0,"DDB",P)),",",4)_"\") Q 1
PVZ Q 0
;
BJL ;Build joblist in variable JOB
N CN K JOB
I ($P($P($ZV,")",2),"(",1)[" 2008")!($P($P($ZV,")",2),"(",1)[" 2010") S CN=$ZU(5) ZN "%SYS" D BUILDold^SS ZN CN
E D BUILD^%SS
BJLZ Q
;
CM N I,IPS,J,JOB,maxpid,R,SW,SRT
S io=$G(io,$$IOS),IPS=$ZU(67,15,$J) Q:'$L(IPS)
D BJL S (I,SW)=""
F S I=$O(JOB(0,I)) Q:I="" S J=JOB(0,I) I J'=$J,IPS=$ZU(67,15,J) S SW=SW_$S($L(SW):",",1:"")_J
I $L(SW) D
. S R($O(R(""),-1)+1)=$P("Thurs\Fri\Satur\Son\Mon\Tues\Wednes","\",$H#7+1)_"day "_$ZD($P($H,",",1),4)_" "_$ZT($P($H,",",2),1)_" system "_$ZCVT($ZU(110),"U")_" namespace "_$ZU(5)
. S R($O(R(""),-1)+1)=""
. S R($O(R(""),-1)+1)="IP Address "_IPS_" = reference port "_io_" logged on as job "_$J_"."
. S R($O(R(""),-1)+1)=""
. F I=1:1:$L(SW,",") D
.. S R($O(R(""),-1)+1)="Job "_$P(SW,",",I)_" has the same IP address."
.. S J=$ZU(4,$P(SW,",",I)) ;Kill that job
.. S R($O(R(""),-1)+1)="Job "_$P(SW,",",I)_" has been killed."
. S SRT=$P($G(^cQSYS(0,"DDB",$G(io))),",",4) S:SRT="" SRT="PDT"
. I $D(^$R("cQ14")) D M^cQ14($G(SRT)_" with Ref. Port "_$G(io)_" logged on more than once.",.R)
CMZ Q
;Some modules called from cQ5
;
IO(I) N JOB S I=$G(I,$I) S:I="" I=$I S JOB=$$ZJOB(I)
I '$D(^cJOB($J,$ZCVT($ZU(110),"U"),"job","DATE_TIME")) D date,time S ^cJOB($J,$ZCVT($ZU(110),"U"),"job","DATE_TIME")=$G(DT)_"\"_$G(TD)
I '$D(^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","IO")) S ^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","IO")=$G(io,$$IOS(I))
IOZ Q $G(^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","IO"),I)
;
IOS(I) N CFG,J,JOB,K,L,OK,ORDER,P,SW,SWP,ZDEV S SWP=0
IOSA S $ZT="ER^"_$T(+0),CFG=$$CONFIG,K="?"
S I=$G(I,$I) S:I="" I=$I S JOB=$$ZJOB(I)
I '$D(^cJOB($J,$ZCVT($ZU(110),"U"),"job","DATE_TIME")) D date,time S ^cJOB($J,$ZCVT($ZU(110),"U"),"job","DATE_TIME")=$G(DT)_"\"_$G(TD)
K ^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","TYPE"),^("IP"),^("NBN"),^("MAC"),^("IO"),^("UN")
S SW=0,ZDEV=$I
I $$BGJOB(JOB) D Q 1
. S ^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","TYPE")="Background"
. F J="IP","NBN","MAC" S (@J,^cJOB(JOB,$ZCVT($ZU(110),"U"),"job",J))="?"
. S ^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","IO")=1
. S ^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","UN")="Background"
S ^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","TYPE")=$S(ZDEV["@":"LAT",ZDEV["~":"Telnet",1:"Direct")
F J="IP","NBN","MAC" S (@J,^cJOB(JOB,$ZCVT($ZU(110),"U"),"job",J))="??"
S (IP,^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","IP"))=$$IP(I)
I IP'="?",$D(^cQSYS(CFG,"FIXED","IP",IP)) S P=^(IP) I $$PV(P),$D(^cLOG($ZU(5),"CHARWIN","INIT",P)) S K=P G IOSY
S (NBN,^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","NBN"))=$$NBN(I)
S (MAC,^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","MAC"))=$$MAC(I)
S ORDER="NBN\IP",OK=0,J=$G(^cLOG($ZCVT($ZU(110),"U"),"IO","ORDER")) I $L(J) S ORDER=J
F J=1:1:$L(ORDER,"\") S L=$P(ORDER,"\",J) D I OK=1 Q
. I $L(@L),@L'="?",$D(^cQSYS(CFG,"FIXED",L,@L)) S K=^(@L),OK=1
I 'OK,I?1.N S K=I
IOSB ;check if Terminal Server
I IP?3(1.3N1".")1.3N,$D(^cLOG($ZCVT($ZU(110),"U"),"TS",IP)) S OK=0 D
. F ii=1:1:1 D Q:OK
.. S CLN=$$CLN(1),IPCLN=0 I CLN'="" S IPCLN=$P($ZU(54,13,CLN),",")
.. I 'OK,IPCLN?3(1.3N1".")1.3N,$D(^cQSYS(CFG,"FIXED","IP",IPCLN)) S K=^(IPCLN),OK=1
IOSY S:K="" K=0 S ^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","IO")=K
I 'SWP,K="?" D S SWP=1 G IOSA
. S NBN=$$NBN,P=$S($ZU(5)="DATAM1":9000,1:1000)
. I NBN'="?",'$D(^cQSYS(0,"FIXED","NBN",NBN)) D
.. S O=P,SWN=1
.. F S O=$O(^cQSYS(0,"DDB",O)) Q:O=""!(O-P>1) S P=O I $P(^cQSYS(0,"DDB",O),",",3)=NBN S SWN=0
.. I SWN D
... F P=1001:1:8999 I '$D(^cQSYS(0,"DDB",P)) Q
... S ^cQSYS(0,"DDB",P)="TELN,,"_NBN_","
.. S ^cQSYS(0,"FIXED","NBN",NBN)=P
. I NBN="?" D
.. S IP=$$IP I IP'="?",'$D(^cQSYS(0,"FIXED","IP",IP)) D
... S O=P,SWN=1
... F S O=$O(^cQSYS(0,"DDB",O)) Q:O=""!(O-P>1) S P=O I $P(^cQSYS(0,"DDB",O),",",2)=IP S SWN=0
... I SWN D
.... F P=1001:1:8999 I '$D(^cQSYS(0,"DDB",P)) Q
.... S ^cQSYS(0,"DDB",P)="TELN,"_IP_",,"
... S ^cQSYS(0,"FIXED","IP",IP)=P
IOSZ Q K
;
IP(I) N DDB,JOB,K,R,%v
S I=$G(I,$I) S:I="" I=$I S JOB=$$ZJOB(I)
I JOB,$D(^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","IP")),^("IP")'="??" Q ^("IP")
S K=$ZU(67,15,$J) I $L(K),K?3(1.3N1".")1.3N Q K
S K=$P($P($I,":"),"|",3) I $L(K),K?3(1.3N1".")1.3N Q K
IPZ Q "?"
;
NBN(I) N DDB,JOB,K,R,%v
S I=$G(I,$I) S:I="" I=$I S JOB=$$ZJOB(I)
I JOB,$D(^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","NBN")),^("NBN")'="??" Q ^("NBN")
Q ##class(TECH.Context.RuntimeContext).Instance().GeefComputerNaam()
S K=$ZU(67,12,$J) S:K["/" K=$P(K,"/") I $L(K),K?.ANP Set K = $ZCVT($Piece(K,".",1),"U") Q K
S K=$$CLN() S:'$L(K) K=$$CNN() I $L(K) Q K
S K=$P($P(I,":"),"|",3) S:K["~" K=$P(K,"~",2) I $L(K),K'?3(1.3N1".")1.3N Q $ZSTRIP($ZCONVERT($P(K,"."),"U"),"*C")
NBNZ Q "?"
;
MAC(I) N NBN,IP,JOB,K,R,%v
S I=$G(I,$I) S:I="" I=$I S JOB=$$ZJOB(I)
I JOB,$D(^cJOB(JOB,$ZCVT($ZU(110),"U"),"job","MAC")),^("MAC")'="??" Q ^("MAC")
MACZ Q "?"
;
QT S QT=$G(QT,""),QTU=$S($L(QT):$F("FDE",QT),1:1)
QTZ Q
;
ZC() ;Get device-code
N K S K=""
I $D(^cLOG($ZCVT($ZU(110),"U"),"LOGON")),$L(^("LOGON")) S K=^("LOGON")
I $D(^cLOG($ZU(5),"LOGON")),$L(^("LOGON")) S K=^("LOGON")
I '$L(K) S K="ZC"
ZCZ Q K
;
ER S %=$ZE,%ZTRAP="ER^"_$T(+0)
I $D(^$R("cA400")) D ^cA400
ZQ 1 I $ZT'="" G @$ZT
ERZ Q
;
;Some modules from cQ6
;
QQM N QL,QU,K,L,%logctk
I $D(^cLOG($ZCVT($ZU(110),"U"),"Q",$ZU(5))) D
. S Q=$P(^($ZU(5)),"\"),QM=0,QT=$P($G(@("^"_Q_"BA(39)")),"\",2)
. S:QT="N" QT="" S QTU=$S($L(QT):$F("FDE",QT),1:1)
I $D(^$R("cA604")) D ^cA604
QQMZ Q
;
;Some modules from cQ9
;
CONFIG() ;
CONFIGZ Q 0
;
;Some modules from cQ14
;
ZJOB(I) N J
I $G(I)["|",$P(I,"|",2)="TNT",$P(I,"|",$L(I,"|"))?.N S J=$P(I,"|",$L(I,"|"))
E S J=$J
ZJOBZ Q J
;
BGJOB(J) ;Background job ??
new TmpResult Set TmpResult = ""
if ($P($P($ZV,")",2),"(",1)[" 4.") {
set TmpResult = $ZU(67,10,$G(J,$J))
} elseif ($P($P($ZV,")",2),"(",1)[" 5.") {
new Process set Process = ##class(%SYSTEM.Process).%OpenId($G(J,$J))
if $isObject(Process) set TmpResult = Process.JobTypeGet()
} else {
new Process set Process = ##class(%SYS.ProcessQuery).%OpenId($G(J,$J),0)
if $IsObject(Process) set TmpResult = Process.JobTypeGet()
}
BGJOBZ quit (TmpResult=2)
;
CNN(X) N K
I '+$G(X),$G(^["%SYS"]cLOG(0,"NETBIOSNAME"),1) Q "" ; Modified 12.02.2006
I $$PV($G(io)) Q "" ;scanners
I $I'["|TNT|" Q ""
;U 0:(:/ECHO=0)
;W $C(27),"P2000;0{Sub main",$C(13),"SendKeys Environ$(""computername"")",$C(13)
;W "SendKeys ""{ENTER}""",$C(13),"End Sub",$C(13),$C(27),"\"
;R K:3
;U 0:(:/ECHO=1)
Set K=##class(APPS.CHUI.NativeCommandoService).%New().ReflectionComputerName()
S K=$TR($ZSTRIP(K,"*C"),"&é""'(§è!çà)_","1234567890°-") ;Capslock conversion
S K=$ZCONVERT(K,"U") ;Uppercase conversion
CNNZ Q K
;
CLN(X) N K
I '+$G(X),$G(^["%SYS"]cLOG(0,"NETBIOSNAME"),1) Q "" ; Modified 12.02.2006
I $$PV($G(io)) Q "" ;scanners
I $I'["|TNT|" Q ""
;U 0:(:/ECHO=0)
;W $C(27),"P2000;0{Sub main",$C(13),"SendKeys Environ$(""clientname"")",$C(13)
;W "SendKeys ""{ENTER}""",$C(13),"End Sub",$C(13),$C(27),"\"
;R K:3
;U 0:(:/ECHO=1)
Set K=##class(APPS.CHUI.NativeCommandoService).%New().ReflectionRDPClientName()
S K=$TR($ZSTRIP(K,"*C"),"&é""'(§è!çà)_","1234567890°-") ;Capslock conversion
S K=$ZCONVERT(K,"U") ;Uppercase conversion
CLNZ Q K
;
;Some modules from cQ13
;
SWNS N J,NSPC
S NSPC=$G(^["%SYS"]cLOG(0,"NAMESPACE",0))
I $L(NSPC) D
. I '$ZU(90,10,NSPC) D H 5
.. W !,"Namespace ",NSPC," in ^[""%SYS""]cLOG(0,""NAMESPACE"",0) does not exist ",!
.. D NSC("^[""%SYS""]cLOG(0,""NAMESPACE"",0)")
. ZN NSPC
K ^cJOB($J) S io=$$IOS
F J=io,0 S NSPC=$G(^cLOG($ZCVT($ZU(110),"U"),"NAMESPACE",J)) Q:$L(NSPC)
I $L(NSPC) D
. I '$ZU(90,10,NSPC) D H 5
.. W !,"Namespace ",NSPC," in ^cLOG(""",$ZCVT($ZU(110),"U"),""",""NAMESPACE"",",J,") does not exist ",!
.. D NSC("^cLOG("""_$ZCVT($ZU(110),"U")_""",""NAMESPACE"","_J_")")
. ZN NSPC K ^cJOB($J) S io=$$IOS
SWNSZ Q
;
NSC(X) ;Correct namespace
N EX,I,K S X=$G(X) I '$L(X) Q
S EX="\%SYS\%CACHELIB\DOCBOOK\SAMPLES\USER\",K=""
F I=1:1:$ZU(90,0) S K=$ZU(90,2,0,I) I EX'[("\"_K_"\") Q
I $L(K) D
. S @X=K,NSPC=K
. S ^["%SYS"]login("TELNET")="AAAAAA|"_NSPC_"|^IINT|0,0"
. S ^["%SYS"]login("TRM:")="AAAAAA|"_NSPC_"|^IINT|0,0"
NSCZ Q
;
CLEAN(LOG,X) ;Clean-up entry in LOG
N I,DAG,UUR S (DAG,UUR)="",X=$G(X,45)
F I=2:1 S DAG=$O(@LOG@(DAG),-1) Q:DAG="" D
. F I=I-1:1 S UUR=$O(@LOG@(DAG,UUR),-1) Q:UUR="" I I>X K ^(UUR)
CLEANZ Q
;
IN(UCI) zn UCI Q
;
ALLN(S) ; get all namespaces for same roepnaam into S
K S N I,K,L,SYS I '$D(^$R("cQ21")) Q ""
D NSPC^cQ21(.SYS,1) S (K,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 L=L_$P(K,$ZSTRIP($ZU(5),">N"),2)_" "
S:$E(L,$L(L))=" " $E(L,$L(L))=""
F I=1:1:$L(L," ") S S($ZSTRIP($ZU(5),">N")_$P(L," ",I))=""
ALLNZ Q L
;
LOGALL ;Log logon
N H,I,K,M,ns,pid
S H=$ZD(+$H,8),M=$ZT(+$P($H,",",2),1),pid=$j,ns=$ZU(5) ZN "%SYS"
I $D(^[ns]logon(H,M,pid)) S pid=pid_"'"
F I=0,4:1:7,10:1:13,15 S ^[ns]logon(H,M,pid,I)=$ZU(67,I,pid)
S K=^[ns]logon(H,M,pid,0)
S ^[ns]logon(H,M,pid,0)=K_"\"_$S(K=2:"active",K=1:"dead but pid still in pidtable",K=0:"pid is in pidtable",1:"Unknown State")
S ^(4)=^[ns]logon(H,M,pid,4)_"\"_$S(($P($P($ZV,")",2),"(",1)[" 2008")!($P($P($ZV,")",2),"(",1)[" 2010"):##class(SYS.Process).%OpenId(pid).StateGet(),1:##class(%SYSTEM.Process).%OpenId(pid).StateGet())
S ^(10)=^[ns]logon(H,M,pid,10)_"\"_$S(($P($P($ZV,")",2),"(",1)[" 2008")!($P($P($ZV,")",2),"(",1)[" 2010"):##class(SYS.Process).%OpenId(pid).JobTypeGet(),1:##class(%SYSTEM.Process).%OpenId(pid).JobTypeGet())
ZN ns
LOGALLZ Q
;
ZZ ; 17.01.2012 - 15:58 * Cache-r6.4.9