CIANBUTL ;MSC/IND/DKM/PLS - MSC RPC Broker Utilities ;15-Oct-2015 08:51;PLS
;;1.1;CIA NETWORK COMPONENTS;**001007,001011,001012**;Sep 18, 2007
;;Copyright 2000-2015, Medsphere Systems Corporation
;=================================================================
; Cleanup stray global nodes
CLEANUP ;EP
N UID
F Q:'$$NXTUID(.UID,0) K ^XTMP("CIA",UID)
Q
; Force RPC context tables to be rebuilt for all active sessions
REBLDCTX ;EP
N UID,CTX
F Q:'$$NXTUID(.UID) D
.F CTX=0:0 S CTX=$O(^XTMP("CIA",UID,"C",CTX)) Q:'CTX S ^(CTX)=0
Q
; Get globally unique instance ID
UID() N UID,FLG
L +^XTMP("CIA",0):5
E Q "-3^Cannot initialize environment"
S FLG=0
F UID=$P($G(^XTMP("CIA",0)),U,3)+1:1 D Q:(UID<1)!(FLG=2)
.I (UID<1)!(UID>999999) D Q:UID<1
..S UID=$S('FLG:1,1:"-4^Lock table is full"),FLG=1
.S:'$$ISACTIVE(UID,1) FLG=2
S:UID>0 ^XTMP("CIA",0)=(DT+10000)_U_DT_U_UID
L -^XTMP("CIA",0)
Q UID
; Verifies that a session is truly active
; UID = Unique id of session
; LCK = If nonzero, leave lock active (defaults to 0)
; TMO = Optional lock timeout (defaults to 0)
ISACTIVE(UID,LCK,TMO) ;EP
Q:'$G(UID) 0
Q:UID=$G(CIA("UID")) 1
L +^XTMP("CIA",UID,0):+$G(TMO)
E Q 1
L:'$G(LCK) -^XTMP("CIA",UID,0)
Q 0
; Gets the session ID associated with this process
; If not in session context, attempt answerback from client
GETUID() ;EP
I '$D(CIA("UID")) D
.S CIA("UID")=""
.Q:$D(ZTQUEUED)
.N X,UID,I
.S I=$I,UID=""
.U $S($D(IO(0)):IO(0),1:$P) ; Use home device
.X ^%ZOSF("EOFF") ; Suppress echo
.F R X#1:0 Q:'$T ; Flush keyboard buffer
.W $C(5) ; Send answerback request
.F R X:4 Q:'$T&'$L(X) S UID=UID_X ; Listen for response
.S UID=$P(UID,"CIA#",2)
.X ^%ZOSF("EON") ; Restore echo
.U I ; Restore previous device
.I $$ISACTIVE(UID),$$GETVAR("DUZ",,,UID)=DUZ S CIA("UID")=UID
.E S CIA("UID")=""
Q:$Q CIA("UID")
Q
; Retrieve next session ID from list
; UID passed as last ID processed, returned as next ID or null
; FLT = <0=all; 0=inactive only; >0=active only (default)
; AID = Application ID (optional)
; Return value is true if ID found
NXTUID(UID,FLT,AID) ;EP
N PFX,FND,ALL,ACT
S FLT=+$G(FLT,1),FND=0,ALL=FLT<0,ACT=FLT>0,AID=$$OPTLKP(.AID),UID=+$G(UID)
I $L(AID) F S UID=$O(^XTMP("CIA",UID)) Q:'UID D Q:FND
.I AID,$$GETVAR("AID0",,,UID)'=AID Q
.I 'ALL,$$ISACTIVE(UID)'=ACT Q
.S FND=1
S:'FND UID=""
Q:$Q FND
Q
; Retrieve a package parameter value
PARAM(PAR,MIN,MAX) ;EP
S VAL=+$$GET^XPAR("ALL",PAR)
S:VAL<MIN VAL=MIN
S:VAL>MAX VAL=MAX
Q VAL
; Return free resource device
RESDEV() ;EP
N RD,MX,SL,UID,X,C
S MX=$$PARAM("CIANB RESOURCE DEVICE COUNT",1,40)
S SL=$$PARAM("CIANB RESOURCE DEVICE SLOTS",1,40)
F Q:'$$NXTUID(.UID) D
.S RD=$$GETVAR("RDEV",,,UID)
.S:RD RD(RD)=$G(RD(RD))+1
S RD=1,C=999999
F X=1:1:MX S:+$G(RD(X))<C RD=X,C=+$G(RD(X))
S X=$$RES^XUDHSET("CIANB THREAD RESOURCE #"_RD,,SL,"CIA Broker Asynchronous Callbacks")
Q RD
; Set maximum slots for resource devices
SETSLOTS(CNT) ;EP
N RES,IEN,FDA,X,Y
Q:CNT<2!(CNT>40)
D FIND^DIC(3.5,,"@","UP","CIANB THREAD RESOURCE #",,"B")
F RES=0:0 S RES=$O(^TMP("DILIST",$J,RES)) Q:'RES S IEN=+$G(^(RES,0)) D:IEN
.S FDA(3.5,IEN_",",35)=CNT
D FILE^DIE("K","FDA")
K ^TMP("DILIST",$J),^TMP("DIERR",$J)
Q
; Return info for session
SESSION(UID,VAR) ;EP
N X,Y,Z
S (X,Y)=""
S:'$L($G(VAR)) VAR="UID^WID^AID^DUZ^USER^LDT^JOB"
F Z=1:1:$L(VAR,U) S X=X_Y_$$GETVAR($P(VAR,U,Z),,,.UID),Y=U
Q X
; Show active sessions
; AID = optional application id
; FLT = <0=all; 0=inactive only; >0=active only (default)
SHOWSESS(AID,FLT) ;EP
N C,X,Z
F C=0:1 Q:'$$NXTUID(.X,.FLT,.AID) D
.W "#",X,?10,$$HTE^XLFDT($$GETVAR("LDT",,,X)),?40,$$GETVAR("WID",,,X),?60,$$GETVAR("USER",,,X),!
W !,$S('C:"No sessions are",C=1:"One session is",1:C_" sessions are")," ",$S(FLT>0:"active",FLT<0:"present",1:"inactive"),".",!
Q:$Q C
Q
; Fetch an environment variable
; NAME = Variable name
; DFLT = Optional default value
; NMSP = Optional namespace (defaults to global)
; UID = Optional session id (default to current)
GETVAR(NAME,DFLT,NMSP,UID) ;EP
D FMTVAR(.UID,.NMSP,.NAME)
Q $S('UID:"",1:$G(^XTMP("CIA",UID,"V",NMSP,NAME),$G(DFLT)))
; Save an environment variable
; NAME = Variable name
; VALUE = Value to be assigned (if not specified, entry is deleted)
; NMSP = Optional namespace (defaults to global)
SETVAR(NAME,VALUE,NMSP,UID) ;EP
N $ET
S $ET="S $EC="""" G ERRVAR^CIANBUTL"
D FMTVAR(.UID,.NMSP,.NAME)
I 'UID Q:$Q 0 Q
L +^XTMP("CIA",UID,"V",NMSP,NAME):1
;E Q:$Q 0 Q
I $D(VALUE) S:NMSP=-1 @NAME=VALUE S ^XTMP("CIA",UID,"V",NMSP,NAME)=VALUE
E K:NMSP=-1 @NAME K ^XTMP("CIA",UID,"V",NMSP,NAME)
L -^XTMP("CIA",UID,"V",NMSP,NAME)
Q:$Q 1
Q
; Clear all variables in a namespace
CLRVAR(NMSP,UID) ;EP
N NAME,RES
D FMTVAR(.UID,.NMSP)
L +^XTMP("CIA",UID,"V",NMSP):1
;E Q:$Q 0 Q
S NAME="",RES=1
F S NAME=$O(^XTMP("CIA",UID,"V",NMSP,NAME)) Q:'$L(NAME) S RES=RES&$$SETVAR(NAME,,NMSP,UID)
L -^XTMP("CIA",UID,"V",NMSP)
Q:$Q RES
Q
; Restore variables from local variable namespace
RESVAR N NAME,UID
D FMTVAR(.UID)
S NAME=""
F S NAME=$O(^XTMP("CIA",UID,"V",-1,NAME)) Q:'$L(NAME) S @NAME=^(NAME)
Q
; Error handler for var calls
ERRVAR L -^XTMP("CIA",UID,"V",NMSP,NAME)
Q:$Q 0
Q
; Format arguments for var calls
FMTVAR(UID,NMSP,NAME) ;
S UID=$G(UID,$G(CIA("UID")))
S NMSP=$$UP^XLFSTR($G(NMSP,0))
S NAME=$$UP^XLFSTR($G(NAME))
S:NMSP=-1&$L(NAME) NAME=$NA(@NAME)
Q
; Retrieve dialog text
; NUM = Dialog number (relative or absolute)
; .DLG = Array to receive text
; Pn = Optional parameters (up to 3)
GETDLG(NUM,DLG,P1,P2,P3) ;
N PAR
K DLG
S:NUM<10000 NUM=NUM+199412000
S PAR(1)=$G(P1,$G(CIA("RPC"))),PAR(2)=$G(P2),PAR(3)=$G(P3)
D BLD^DIALOG(NUM,.PAR,,"DLG")
Q:$Q $G(DLG(1))
Q
; Lookup option, returning IEN
OPTLKP(OPT) ;EP
Q $S('$L($G(OPT)):0,OPT=+OPT:OPT,1:$O(^DIC(19,"B",OPT,0)))
; Get/set out-of-order message for option
; MSG = New message (if passed, a set is performed, otherwise a get)
; Returns current message text
OPTMSG(OPT,MSG) ;EP
S OPT=+$$OPTLKP(.OPT)
I OPT,$D(^DIC(19,OPT,0)) D ; Sets naked ref
.I $D(MSG) S $P(^(0),U,3)=MSG
.E S MSG=$P(^(0),U,3)
E S MSG=""
Q:$Q MSG
Q
; Check option for valid access
; OPT=Option IEN or name
; TYP=Optional option type to check
; Returns 0 if OK, <err code>^<err param> otherwise
OPTCHK(OPT,TYP) ;EP
N XQY,X,Y,Z
S XQY=$S(OPT=+OPT:OPT,1:$$OPTLKP(OPT))
Q:XQY'>0 "2^"_OPT
S X=$G(^DIC(19,XQY,0)),Y=$P($G(^(3)),U),Z=$P(X,U,3)
Q:$L(Z) "19^"_Z
I $L($G(TYP)),$P(X,U,4)'=TYP Q "20^"_OPT_U_TYP
I $P(X,U,16),$L(Y),$$KCHK^XUSRB(Y) Q "21^"_OPT_U_Y
S Y=$P(X,U,6)
I $L(Y),'$$KCHK^XUSRB(Y) Q "22^"_OPT_U_Y
S X=$$NOW^XLFDT
D ENTRY^XQ92
Q:'X "23^"_OPT
Q 0
; Nightly task to perform various cleanup procedures.
NIGHTLY ;EP
D CLEANUP
D DOPURGE^CIANBEVT(1)
D DOPURGE^CIANBLOG
Q
CIANBUTL ;MSC/IND/DKM/PLS - MSC RPC Broker Utilities ;15-Oct-2015 08:51;PLS
+1 ;;1.1;CIA NETWORK COMPONENTS;**001007,001011,001012**;Sep 18, 2007
+2 ;;Copyright 2000-2015, Medsphere Systems Corporation
+3 ;=================================================================
+4 ; Cleanup stray global nodes
CLEANUP ;EP
+1 NEW UID
+2 FOR
IF '$$NXTUID(.UID,0)
QUIT
KILL ^XTMP("CIA",UID)
+3 QUIT
+4 ; Force RPC context tables to be rebuilt for all active sessions
REBLDCTX ;EP
+1 NEW UID,CTX
+2 FOR
IF '$$NXTUID(.UID)
QUIT
Begin DoDot:1
+3 FOR CTX=0:0
SET CTX=$ORDER(^XTMP("CIA",UID,"C",CTX))
IF 'CTX
QUIT
SET ^(CTX)=0
End DoDot:1
+4 QUIT
+5 ; Get globally unique instance ID
UID() NEW UID,FLG
+1 LOCK +^XTMP("CIA",0):5
+2 IF '$TEST
QUIT "-3^Cannot initialize environment"
+3 SET FLG=0
+4 FOR UID=$PIECE($GET(^XTMP("CIA",0)),U,3)+1:1
Begin DoDot:1
+5 IF (UID<1)!(UID>999999)
Begin DoDot:2
+6 SET UID=$SELECT('FLG:1,1:"-4^Lock table is full")
SET FLG=1
End DoDot:2
IF UID<1
QUIT
+7 IF '$$ISACTIVE(UID,1)
SET FLG=2
End DoDot:1
IF (UID<1)!(FLG=2)
QUIT
+8 IF UID>0
SET ^XTMP("CIA",0)=(DT+10000)_U_DT_U_UID
+9 LOCK -^XTMP("CIA",0)
+10 QUIT UID
+11 ; Verifies that a session is truly active
+12 ; UID = Unique id of session
+13 ; LCK = If nonzero, leave lock active (defaults to 0)
+14 ; TMO = Optional lock timeout (defaults to 0)
ISACTIVE(UID,LCK,TMO) ;EP
+1 IF '$GET(UID)
QUIT 0
+2 IF UID=$GET(CIA("UID"))
QUIT 1
+3 LOCK +^XTMP("CIA",UID,0):+$GET(TMO)
+4 IF '$TEST
QUIT 1
+5 IF '$GET(LCK)
LOCK -^XTMP("CIA",UID,0)
+6 QUIT 0
+7 ; Gets the session ID associated with this process
+8 ; If not in session context, attempt answerback from client
GETUID() ;EP
+1 IF '$DATA(CIA("UID"))
Begin DoDot:1
+2 SET CIA("UID")=""
+3 IF $DATA(ZTQUEUED)
QUIT
+4 NEW X,UID,I
+5 SET I=$IO
SET UID=""
+6 ; Use home device
USE $SELECT($DATA(IO(0)):IO(0),1:$PRINCIPAL)
+7 ; Suppress echo
XECUTE ^%ZOSF("EOFF")
+8 ; Flush keyboard buffer
FOR
READ X#1:0
IF '$TEST
QUIT
+9 ; Send answerback request
WRITE $CHAR(5)
+10 ; Listen for response
FOR
READ X:4
IF '$TEST&'$LENGTH(X)
QUIT
SET UID=UID_X
+11 SET UID=$PIECE(UID,"CIA#",2)
+12 ; Restore echo
XECUTE ^%ZOSF("EON")
+13 ; Restore previous device
USE I
+14 IF $$ISACTIVE(UID)
IF $$GETVAR("DUZ",,,UID)=DUZ
SET CIA("UID")=UID
+15 IF '$TEST
SET CIA("UID")=""
End DoDot:1
+16 IF $QUIT
QUIT CIA("UID")
+17 QUIT
+18 ; Retrieve next session ID from list
+19 ; UID passed as last ID processed, returned as next ID or null
+20 ; FLT = <0=all; 0=inactive only; >0=active only (default)
+21 ; AID = Application ID (optional)
+22 ; Return value is true if ID found
NXTUID(UID,FLT,AID) ;EP
+1 NEW PFX,FND,ALL,ACT
+2 SET FLT=+$GET(FLT,1)
SET FND=0
SET ALL=FLT<0
SET ACT=FLT>0
SET AID=$$OPTLKP(.AID)
SET UID=+$GET(UID)
+3 IF $LENGTH(AID)
FOR
SET UID=$ORDER(^XTMP("CIA",UID))
IF 'UID
QUIT
Begin DoDot:1
+4 IF AID
IF $$GETVAR("AID0",,,UID)'=AID
QUIT
+5 IF 'ALL
IF $$ISACTIVE(UID)'=ACT
QUIT
+6 SET FND=1
End DoDot:1
IF FND
QUIT
+7 IF 'FND
SET UID=""
+8 IF $QUIT
QUIT FND
+9 QUIT
+10 ; Retrieve a package parameter value
PARAM(PAR,MIN,MAX) ;EP
+1 SET VAL=+$$GET^XPAR("ALL",PAR)
+2 IF VAL<MIN
SET VAL=MIN
+3 IF VAL>MAX
SET VAL=MAX
+4 QUIT VAL
+5 ; Return free resource device
RESDEV() ;EP
+1 NEW RD,MX,SL,UID,X,C
+2 SET MX=$$PARAM("CIANB RESOURCE DEVICE COUNT",1,40)
+3 SET SL=$$PARAM("CIANB RESOURCE DEVICE SLOTS",1,40)
+4 FOR
IF '$$NXTUID(.UID)
QUIT
Begin DoDot:1
+5 SET RD=$$GETVAR("RDEV",,,UID)
+6 IF RD
SET RD(RD)=$GET(RD(RD))+1
End DoDot:1
+7 SET RD=1
SET C=999999
+8 FOR X=1:1:MX
IF +$GET(RD(X))<C
SET RD=X
SET C=+$GET(RD(X))
+9 SET X=$$RES^XUDHSET("CIANB THREAD RESOURCE #"_RD,,SL,"CIA Broker Asynchronous Callbacks")
+10 QUIT RD
+11 ; Set maximum slots for resource devices
SETSLOTS(CNT) ;EP
+1 NEW RES,IEN,FDA,X,Y
+2 IF CNT<2!(CNT>40)
QUIT
+3 DO FIND^DIC(3.5,,"@","UP","CIANB THREAD RESOURCE #",,"B")
+4 FOR RES=0:0
SET RES=$ORDER(^TMP("DILIST",$JOB,RES))
IF 'RES
QUIT
SET IEN=+$GET(^(RES,0))
IF IEN
Begin DoDot:1
+5 SET FDA(3.5,IEN_",",35)=CNT
End DoDot:1
+6 DO FILE^DIE("K","FDA")
+7 KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB)
+8 QUIT
+9 ; Return info for session
SESSION(UID,VAR) ;EP
+1 NEW X,Y,Z
+2 SET (X,Y)=""
+3 IF '$LENGTH($GET(VAR))
SET VAR="UID^WID^AID^DUZ^USER^LDT^JOB"
+4 FOR Z=1:1:$LENGTH(VAR,U)
SET X=X_Y_$$GETVAR($PIECE(VAR,U,Z),,,.UID)
SET Y=U
+5 QUIT X
+6 ; Show active sessions
+7 ; AID = optional application id
+8 ; FLT = <0=all; 0=inactive only; >0=active only (default)
SHOWSESS(AID,FLT) ;EP
+1 NEW C,X,Z
+2 FOR C=0:1
IF '$$NXTUID(.X,.FLT,.AID)
QUIT
Begin DoDot:1
+3 WRITE "#",X,?10,$$HTE^XLFDT($$GETVAR("LDT",,,X)),?40,$$GETVAR("WID",,,X),?60,$$GETVAR("USER",,,X),!
End DoDot:1
+4 WRITE !,$SELECT('C:"No sessions are",C=1:"One session is",1:C_" sessions are")," ",$SELECT(FLT>0:"active",FLT<0:"present",1:"inactive"),".",!
+5 IF $QUIT
QUIT C
+6 QUIT
+7 ; Fetch an environment variable
+8 ; NAME = Variable name
+9 ; DFLT = Optional default value
+10 ; NMSP = Optional namespace (defaults to global)
+11 ; UID = Optional session id (default to current)
GETVAR(NAME,DFLT,NMSP,UID) ;EP
+1 DO FMTVAR(.UID,.NMSP,.NAME)
+2 QUIT $SELECT('UID:"",1:$GET(^XTMP("CIA",UID,"V",NMSP,NAME),$GET(DFLT)))
+3 ; Save an environment variable
+4 ; NAME = Variable name
+5 ; VALUE = Value to be assigned (if not specified, entry is deleted)
+6 ; NMSP = Optional namespace (defaults to global)
SETVAR(NAME,VALUE,NMSP,UID) ;EP
+1 NEW $ETRAP
+2 SET $ETRAP="S $EC="""" G ERRVAR^CIANBUTL"
+3 DO FMTVAR(.UID,.NMSP,.NAME)
+4 IF 'UID
IF $QUIT
QUIT 0
QUIT
+5 LOCK +^XTMP("CIA",UID,"V",NMSP,NAME):1
+6 ;E Q:$Q 0 Q
+7 IF $DATA(VALUE)
IF NMSP=-1
SET @NAME=VALUE
SET ^XTMP("CIA",UID,"V",NMSP,NAME)=VALUE
+8 IF '$TEST
IF NMSP=-1
KILL @NAME
KILL ^XTMP("CIA",UID,"V",NMSP,NAME)
+9 LOCK -^XTMP("CIA",UID,"V",NMSP,NAME)
+10 IF $QUIT
QUIT 1
+11 QUIT
+12 ; Clear all variables in a namespace
CLRVAR(NMSP,UID) ;EP
+1 NEW NAME,RES
+2 DO FMTVAR(.UID,.NMSP)
+3 LOCK +^XTMP("CIA",UID,"V",NMSP):1
+4 ;E Q:$Q 0 Q
+5 SET NAME=""
SET RES=1
+6 FOR
SET NAME=$ORDER(^XTMP("CIA",UID,"V",NMSP,NAME))
IF '$LENGTH(NAME)
QUIT
SET RES=RES&$$SETVAR(NAME,,NMSP,UID)
+7 LOCK -^XTMP("CIA",UID,"V",NMSP)
+8 IF $QUIT
QUIT RES
+9 QUIT
+10 ; Restore variables from local variable namespace
RESVAR NEW NAME,UID
+1 DO FMTVAR(.UID)
+2 SET NAME=""
+3 FOR
SET NAME=$ORDER(^XTMP("CIA",UID,"V",-1,NAME))
IF '$LENGTH(NAME)
QUIT
SET @NAME=^(NAME)
+4 QUIT
+5 ; Error handler for var calls
ERRVAR LOCK -^XTMP("CIA",UID,"V",NMSP,NAME)
+1 IF $QUIT
QUIT 0
+2 QUIT
+3 ; Format arguments for var calls
FMTVAR(UID,NMSP,NAME) ;
+1 SET UID=$GET(UID,$GET(CIA("UID")))
+2 SET NMSP=$$UP^XLFSTR($GET(NMSP,0))
+3 SET NAME=$$UP^XLFSTR($GET(NAME))
+4 IF NMSP=-1&$LENGTH(NAME)
SET NAME=$NAME(@NAME)
+5 QUIT
+6 ; Retrieve dialog text
+7 ; NUM = Dialog number (relative or absolute)
+8 ; .DLG = Array to receive text
+9 ; Pn = Optional parameters (up to 3)
GETDLG(NUM,DLG,P1,P2,P3) ;
+1 NEW PAR
+2 KILL DLG
+3 IF NUM<10000
SET NUM=NUM+199412000
+4 SET PAR(1)=$GET(P1,$GET(CIA("RPC")))
SET PAR(2)=$GET(P2)
SET PAR(3)=$GET(P3)
+5 DO BLD^DIALOG(NUM,.PAR,,"DLG")
+6 IF $QUIT
QUIT $GET(DLG(1))
+7 QUIT
+8 ; Lookup option, returning IEN
OPTLKP(OPT) ;EP
+1 QUIT $SELECT('$LENGTH($GET(OPT)):0,OPT=+OPT:OPT,1:$ORDER(^DIC(19,"B",OPT,0)))
+2 ; Get/set out-of-order message for option
+3 ; MSG = New message (if passed, a set is performed, otherwise a get)
+4 ; Returns current message text
OPTMSG(OPT,MSG) ;EP
+1 SET OPT=+$$OPTLKP(.OPT)
+2 ; Sets naked ref
IF OPT
IF $DATA(^DIC(19,OPT,0))
Begin DoDot:1
+3 IF $DATA(MSG)
SET $PIECE(^(0),U,3)=MSG
+4 IF '$TEST
SET MSG=$PIECE(^(0),U,3)
End DoDot:1
+5 IF '$TEST
SET MSG=""
+6 IF $QUIT
QUIT MSG
+7 QUIT
+8 ; Check option for valid access
+9 ; OPT=Option IEN or name
+10 ; TYP=Optional option type to check
+11 ; Returns 0 if OK, <err code>^<err param> otherwise
OPTCHK(OPT,TYP) ;EP
+1 NEW XQY,X,Y,Z
+2 SET XQY=$SELECT(OPT=+OPT:OPT,1:$$OPTLKP(OPT))
+3 IF XQY'>0
QUIT "2^"_OPT
+4 SET X=$GET(^DIC(19,XQY,0))
SET Y=$PIECE($GET(^(3)),U)
SET Z=$PIECE(X,U,3)
+5 IF $LENGTH(Z)
QUIT "19^"_Z
+6 IF $LENGTH($GET(TYP))
IF $PIECE(X,U,4)'=TYP
QUIT "20^"_OPT_U_TYP
+7 IF $PIECE(X,U,16)
IF $LENGTH(Y)
IF $$KCHK^XUSRB(Y)
QUIT "21^"_OPT_U_Y
+8 SET Y=$PIECE(X,U,6)
+9 IF $LENGTH(Y)
IF '$$KCHK^XUSRB(Y)
QUIT "22^"_OPT_U_Y
+10 SET X=$$NOW^XLFDT
+11 DO ENTRY^XQ92
+12 IF 'X
QUIT "23^"_OPT
+13 QUIT 0
+14 ; Nightly task to perform various cleanup procedures.
NIGHTLY ;EP
+1 DO CLEANUP
+2 DO DOPURGE^CIANBEVT(1)
+3 DO DOPURGE^CIANBLOG
+4 QUIT
