cQZSTART ; User login routine ;%ZSTART; [ 06/27/01  10:50 AM ]
 G YZ
 ;
T1 ;Terminal ; Job ;
T2 ;At this moment, nobody is allowed to work.;
T3 ;Your session will be disconnected now!;
 ;
SYSTEM ; Any code here is run just once when Cache starts.
 S QUIET=1 D Message("Data-M defined Startup Started")
 S $ZT="SYSTEME^"_$T(+0)
 S %nspc=$zu(5)  ; remember current namespace
 D SWNS,STUSSD("STU"),MASTER,START^cQSTART
 K ^cPRINT,^cIPRINT,^cJOB,^HULP(boot),^HULP("FAX"),^HULP("SORT"),^DAMBA("%1"),^EABA("%1")
 N I S I="" F  S I=$O(^TEMP(I)) Q:I=""  K ^(I)
 N I S I="" F  S I=$O(^cLOG(0,"MEMO",I)) Q:I=""  K ^(I)
 I $D(^cLOG(boot,"STU"))#10,+$P(^cLOG(boot,"STU"),"\"),$L($P(^cLOG(boot,"STU"),"\",2)) S $ZT="STUR^"_$T(+0) X $P(^("STU"),"\",2) S $ZT=""
STUR I $D(^$R("cQCTK1")) J ^cQCTK1
 D LOGIN^cQ6("Y")
 ZN %nspc  ; switch back to where you came from
 S QUIET=1 D Message("Data-M defined Startup Ended")
SYSTEMZ Q
 ;
SYSTEME S QUIET=1 D Message("Data-M defined Startup Error"_$ZE)
 Q
 ;
LOGIN ; Any code here is run when a user logs onto Cache.
 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 SHUTDOWN Q  ;shutdown switch is set
 D SWNS S NBN=$$NBN,P=$S(cs="DATAM1":9000,1:1000),O=P
 I NBN'="?",'$D(^cQSYS(0,"FIXED","NBN",NBN)) D
 . S O=P F  S O=$O(^cQSYS(0,"DDB",O)) Q:O=""!(O-P>1)  S P=O
 . S P=P+1,^cQSYS(0,"DDB",P)="TELN,,"_NBN_",",^cQSYS(0,"FIXED","NBN",NBN)=P
 I NBN="?" D
 . S IP=$$IP I IP'="?",'$D(^cQSYS(0,"FIXED","IP",IP)) D
 .. S O=P F  S O=$O(^cQSYS(0,"DDB",O)) Q:O=""!(O-P>1)  S P=O
 .. S P=P+1,^cQSYS(0,"DDB",P)="TELN,"_IP_",,",^cQSYS(0,"FIXED","IP",IP)=P
 D MASTER,QQM I $D(^cLOG(boot,"LOGIN","QT")) S QT=$TR(^("QT"),"N")
 D QT S io=$$IO
 I '$D(^cLOG(boot,"DEV",io))#10 S ^cLOG(boot,"DEV",io)="ZC"
 I $D(^cLOG(boot,"LOGIN",io))#10 H:'^(io)  G LS
CY I $D(^$R("cQQ")) B 0 U 0 R "",*K:2 U 0 I K=25 W "." R K:9 W !!!!!!!!!!!!!!!!!!!!!!!! D DATE G CY:DD_DM_DJ#$H'=K K  D ^cQQ,MASTER,QQM,QT S io=$$IO
 ;
LS D ALLN(.N) S N="" F  S N=$O(N(N)) Q:N=""  K ^|N|TEMPS(boot,$J)
 S io=$G(io,$$IO)
 I $D(^cLOG(boot,"LOGIN",io))#10 D  I $L(K) S K="G "_K X K
 . S A=^cLOG(boot,"LOGIN",io),K=$P(A,"\",2) Q:'$L(K)
 . S B=$P(A,"\",3) I $L(B),$ZU(90,10,B) ZN B
 . I '$D(^$R($P(K,"^",2))) S K="" Q
LOGINZ Q
 ;
JOB ; Any code here is run when a process is started via JOB command.
JOBZ Q
 ;
CALLIN ; Any code here is run when a process is started via CALLIN interface.
CALLINZ Q
 ;
YZ Q
 ;
Message(Msg)    ;
 n (QUIET,Msg)
 s $ZT="MessageE"
 i QUIET=0 w !,$ztime($p($h,",",2))_" "_Msg
 i $zu(9,"",Msg)
MessageE q
 ;
DATE 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)
 Q
 ;
TIME S %R=$P($H,",",2)\60,%J=%R\60,TD=$J(%J,2)_" h "_(%R#60\10)_(%R#10)
 Q
 ;
 ;Some modules from cQ5
 ;
MASTER S (boot,bootrvg)=$ZU(110),cs=$ZU(5)
 S master=$G(^cLOG(0,"SYSTEM","MASTER"),$ZU(110))
 S slave=$G(^cLOG(0,"SYSTEM","SLAVE"),master)
 S workst=$D(^cLOG(0,"WORKSTATION",boot))
 S client=$D(^cLOG(cs,"CLIENT",boot))
 Q
 ;
IO(I) N JOB S I=$G(I,$I) S:I="" I=$I S JOB=$$ZJOB(I) D MASTER
 I '$D(^cJOB(JOB,boot,"job","IO")) S ^cJOB(JOB,boot,"job","IO")=$$IOS(I)
 Q $G(^cJOB(JOB,boot,"job","IO"),I)
 ;
IOS(I) N CFG,JOB,K,L,SW,SWP,ZDEV S SWP=0
IOSA S $ZT="ER^"_$T(+0) D MASTER S CFG=$$CONFIG,K="?"
 S I=$G(I,$I) S:I="" I=$I S JOB=$$ZJOB(I)
 K ^cJOB(JOB,boot,"job","TYPE"),^("IP"),^("NBN"),^("MAC"),^("IO"),^("UN")
 S SW=0,ZDEV=$I
 I $$BGJOB(JOB) D  Q 1
 . S ^cJOB(JOB,boot,"job","TYPE")="Backgr."
 . S ^cJOB(JOB,boot,"job","IP")="?"
 . S ^cJOB(JOB,boot,"job","NBN")="?"
 . S ^cJOB(JOB,boot,"job","MAC")="?"
 . S ^cJOB(JOB,boot,"job","IO")=1
 . S ^cJOB(JOB,boot,"job","UN")="Backgr."
 S ^cJOB(JOB,boot,"job","TYPE")=$S(ZDEV["@":"LAT",ZDEV["~":"Telnet",1:"Direct")
 S (NBN,^cJOB(JOB,boot,"job","NBN"))="??"
 S (MAC,^cJOB(JOB,boot,"job","MAC"))="??"
 S (IP,^cJOB(JOB,boot,"job","IP"))=$$IP(I)
 I $L(IP),IP'="?",$D(^cQSYS(CFG,"FIXED","IP",IP)) S K=^(IP),(NBN,^cJOB(JOB,boot,"job","NBN"),MAC,^cJOB(JOB,boot,"job","MAC"))="?" G IOSY
 S (NBN,^cJOB(JOB,boot,"job","NBN"))=$$NBN(I)
 I $L(NBN),NBN'="?",$D(^cQSYS(CFG,"FIXED","NBN",NBN)) S K=^(NBN),(MAC,^cJOB(JOB,boot,"job","MAC"))="?" G IOSY
 S (MAC,^cJOB(JOB,boot,"job","MAC"))=$$MAC(I)
 I $L(MAC),MAC'="?",$D(^cQSYS(CFG,"FIXED","MAC",MAC)) S K=^(MAC) G IOSY
 I I=1 S K=1 G IOSY
 I I?1.N S K=I G IOSY
IOSY S:K="" K=0 S ^cJOB(JOB,boot,"job","IO")=K
 I 'SWP,K="?" D  S SWP=1 G IOSA
 . S NBN=$$NBN,P=$S(cs="DATAM1":9000,1:1000)
 . I NBN'="?",'$D(^cQSYS(0,"FIXED","NBN",NBN)) D
 .. S O=P F  S O=$O(^cQSYS(0,"DDB",O)) Q:O=""!(O-P>1)  S P=O
 .. S P=P+1,^cQSYS(0,"DDB",P)="TELN,,"_NBN_",",^cQSYS(0,"FIXED","NBN",NBN)=P
 . I NBN="?" D
 .. S IP=$$IP I IP'="?",'$D(^cQSYS(0,"FIXED","IP",IP)) D
 ... S O=P F  S O=$O(^cQSYS(0,"DDB",O)) Q:O=""!(O-P>1)  S P=O
 ... S P=P+1,^cQSYS(0,"DDB",P)="TELN,"_IP_",,",^cQSYS(0,"FIXED","IP",IP)=P
IOSZ Q K
 ;
IP(I) N DDB,JOB,K,R,%v D MASTER
 S I=$G(I,$I) S:I="" I=$I S JOB=$$ZJOB(I)
 I JOB,$D(^cJOB(JOB,boot,"job","IP")),^("IP")'="??" Q ^("IP")
 S K=$P($P($I,":"),"|",3) I $L(K),K?3(1.3N1".")1.3N Q K
 Q "?"
 ;
NBN(I) N DDB,JOB,K,R,%v D MASTER
 S I=$G(I,$I) S:I="" I=$I S JOB=$$ZJOB(I)
 I JOB,$D(^cJOB(JOB,boot,"job","NBN")),^("NBN")'="??" Q ^("NBN")
 S K=$P($P(I,":"),"|",3) S:K["~" K=$P(K,"~",2) I $L(K),K'?3(1.3N1".")1.3N Q $$TOUPPER^cQ9($P(K,"."))
 Q "?"
 ;
MAC(I) N NBN,IP,JOB,K,R,%v D MASTER
 S I=$G(I,$I) S:I="" I=$I S JOB=$$ZJOB(I)
 I JOB,$D(^cJOB(JOB,boot,"job","MAC")),^("MAC")'="??" Q ^("MAC")
 Q "?"
 ;
QT S QT=$G(QT,""),QTU=$S($L(QT):$F("FDE",QT),1:1) D MASTER
 Q
 ;
ER S %=$ZE I $ZV'["MSM" S %ZTRAP="ER^"_$T(+0)
 I $D(^$R("cA400")) D ^cA400
 I $ZV["MSM" ZQ
 I $ZV'["MSM" ZQ 1 I $ZT'="" G @$ZT
 Q
 ;
 ;Some modules from cQ6
 ;
QQM D MASTER N QL,QU,K,L,%logctk
 I $D(^cLOG(boot,"Q",cs)) D
 . S Q=$P(^(cs),"\"),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
 Q
 ;
 ;Some modules from cQ9
 ;
CONFIG() ;
 Q 0
 ;
TOUPPER(X)         ;Convert string to uppercase
 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 ;
 ;Some modules from cQ14
 ;
ZJOB(I) N J S J=$J
ZJOBZ Q J
 ;
BGJOB(J) ;Background job ??
 Q 0
 ;
 ;Some modules from cQ13
 ;
SWNS N I,NSPC
 ZN "%SYS" S NSPC=$G(^cLOG(0,"NAMESPACE",0)) I $ZU(90,10,NSPC) ZN NSPC
 D MASTER S io=$G(io,$$IOS)
 F I=io,0 S NSPC=$G(^cLOG(boot,"NAMESPACE",I)) Q:$L(NSPC)
 I $L(NSPC),$ZU(90,10,NSPC) ZN NSPC D MASTER S io=$G(io,$$IOS)
SWNSZ Q
 ;
STUSSD(X) ;Add entry to ^cLOG(boot,"STUSSD")
 N LOG S X=$G(X,"???"),LOG="^cLOG(boot,""STUSSD"")"
 D DATE,TIME,MASTER,CLEAN(LOG,45)
 S @LOG@($P($H,","),$P($H,",",2))=X_"\"_DD_"."_DM_"."_DJ_"\"_TD_"\"_$H
 I X="STU",$D(^$R("cANEM0")) S $ZT="STUSSDZ^"_$T(+0) D  S $ZT=""
 . N I,J,L S (I,J)="",L=0
 . F  S I=$O(@LOG@(I),-1) Q:I=""!(L>2)  D
 .. F  S J=$O(@LOG@(I,J),-1) Q:J=""!(L>2)  D
 ... S L=L+1 I L=2,$P(^(J),"\")=X D D1001^cANEM0($T(+0),"STUSSD")
STUSSDZ 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)
 Q
 ;
IN(UCI) zn UCI Q
 ;
ALLN(S) ; get all namespaces for same roepnaam into S
 K S N I,K,L,SYS
 D MASTER^cQ5,NSPC^cQ21(.SYS,1) S (K,L)=""
 F  S K=$O(SYS(K)) Q:K=""  D
 . I $TR(K,"0123456789")'=$TR(cs,"0123456789") K SYS(K)
 . I $TR(K,"0123456789")=$TR(cs,"0123456789") S L=L_$P(K,$TR(cs,"0123456789"),2)_" "
 S:$E(L,$L(L))=" " $E(L,$L(L))=""
 F I=1:1:$L(L," ") S S($TR(cs,"0123456789")_$P(L," ",I))=""
 Q L
 ;
ZZ ; 24.08.01 -  9 u 19 * Cache-r3.1.8