CIANBLOG ;MSC/IND/DKM - MSC RPC Broker Activity Log Support ;10-Jan-2011 13:06;PLS
;;1.1;CIA NETWORK COMPONENTS;**001007,001008**;Jan 3, 2008
;;Copyright 2000-2008, Medsphere Systems Corporation
;=================================================================
; Open a log entry. The return value is the IEN of the new entry.
; UID = Unique session id
; USER = User IEN
; WID = Workstation id
OPEN(UID,USER,WID) ;EP
N IEN,NOW,X
S NOW=$$NOW^XLFDT
S:$G(WID)="" WID="UNKNOWN"
L +^CIANB(19941.24,0):2
S X=1+$P(^CIANB(19941.24,0),U,3),IEN=$O(^($C(1)),-1)+1,$P(^(0),U,3,4)=X_U_IEN,^(IEN,0)=UID_U_USER_U_WID_U_NOW_U_U_DUZ(2)
L -^CIANB(19941.24,0)
S ^CIANB(19941.24,"B",UID,IEN)=""
S ^CIANB(19941.24,"BUSER",USER,IEN)=""
S ^CIANB(19941.24,"BWID",WID,IEN)=""
S ^CIANB(19941.24,"BLOGIN",NOW,IEN)=""
S ^CIANB(19941.24,"BDIV",DUZ(2),IEN)=""
Q IEN
; Close a log entry.
; IEN = IEN of the entry.
CLOSE(IEN) ;EP
N NOW
S NOW=$$NOW^XLFDT
S:$D(^CIANB(19941.24,+IEN,0)) $P(^(0),U,5)=NOW,^CIANB(19941.24,"BLOGOUT",NOW,IEN)=""
Q
; Log an activity
; IEN = IEN of log entry
; TYPE = Type of log entry (1=RPC, 2=Event)
; NAME = Text name associated with activity
; Returns subfile IEN
LOG(IEN,TYPE,NAME) ;EP
N SUB,NOW
Q:'$D(^CIANB(19941.24,IEN)) 0
S NOW=$$NOW^XLFDT
S SUB=$O(^CIANB(19941.24,IEN,10,$C(1)),-1)+1,^(0)="^19941.241D^"_SUB_U_SUB,^(SUB,0)=NOW_U_TYPE_U_NAME
Q SUB
; Add an entry to the specified activity
; IEN = IEN of log entry
; SUB = IEN of subfile entry
; ARY = Array or global root
; INC = Include variable name with output (optional)
ADD(IEN,SUB,ARY,INC) ;EP
N ROOT,WP,A,L,P,X,Y,Z
S ROOT=$NA(^CIANB(19941.24,IEN,10,SUB,10))
S WP=$O(@ROOT@($C(1)),-1),WP(0)=WP,INC=+$G(INC),(A,ARY)=$NA(@ARY),L=$QL(ARY)
F D:$D(@A)#2 S A=$Q(@A) Q:'$L(A) Q:$NA(@A,L)'=ARY
.S X=@A,P=$S(INC:A_" = ",1:"")
.F Q:'$L(X) D
..S Y=$F(X,$C(13))
..S:'Y!(Y>200) Y=200
..S Z=$TR($E(X,1,Y-1),$C(13,10)),X=$E(X,Y,999999)
..S WP=WP+1,@ROOT@(WP,0)=P_Z,P=$S(INC:">>> ",1:"")
S:WP'=WP(0) @ROOT@(0)="^^"_WP_U_WP_U_$$NOW^XLFDT
Q
; Delete a log entry
DELETE(DA) ;
Q:'$D(^CIANB(19941.24,DA))
N DIK
S DIK="^CIANB(19941.24,"
D ^DIK
Q
; Task purge in background
TASKPRG N ZTSK
S ZTSK=$$QUEUE^CIAUTSK("DOPURGE^CIANBLOG","Purge CIA ACTIVITY LOG")
I ZTSK>0 W !,"CIA ACTIVITY LOG purge submitted as task #",ZTSK,!!
E W !,"Error submitting CIA ACTIVITY LOG purge.",!!
Q
; Purge log entries according to retention criteria
DOPURGE N DAYS,LP,IEN
S DAYS=$$GET^XPAR("ALL","CIANB ACTIVITY RETENTION")
Q:'DAYS
S LP=$$FMADD^XLFDT(DT,-DAYS)
F S LP=$O(^CIANB(19941.24,"BLOGIN",LP),-1) Q:'LP D
.S IEN=0
.F S IEN=$O(^CIANB(19941.24,"BLOGIN",LP,IEN)) Q:'IEN D
..D DELETE(IEN)
Q
; Returns true if activity logging is active
; Creates a log entry if one does not already exist
ISACTIVE() ;
N RTN,DUZ2
Q:'$D(CIA("UID")) 0
Q:'CIA("UID") 0
S DUZ2=$$GETVAR^CIANBUTL("DUZ2")
S RTN=$$GETVAR^CIANBUTL("ALOG"_$S(DUZ2:":"_DUZ2,1:""))
I RTN="" D
.S RTN=+$$GET^XPAR("ALL","CIANB ACTIVITY LOGGING","`"_$$GETVAR^CIANBUTL("AID0"))
.S:RTN RTN=$$OPEN(CIA("UID"),DUZ,$$GETVAR^CIANBUTL("WID"))
.D SETVAR^CIANBUTL("ALOG"_$S(DUZ2:":"_DUZ2,1:""),RTN)
Q RTN
CIANBLOG ;MSC/IND/DKM - MSC RPC Broker Activity Log Support ;10-Jan-2011 13:06;PLS
+1 ;;1.1;CIA NETWORK COMPONENTS;**001007,001008**;Jan 3, 2008
+2 ;;Copyright 2000-2008, Medsphere Systems Corporation
+3 ;=================================================================
+4 ; Open a log entry. The return value is the IEN of the new entry.
+5 ; UID = Unique session id
+6 ; USER = User IEN
+7 ; WID = Workstation id
OPEN(UID,USER,WID) ;EP
+1 NEW IEN,NOW,X
+2 SET NOW=$$NOW^XLFDT
+3 IF $GET(WID)=""
SET WID="UNKNOWN"
+4 LOCK +^CIANB(19941.24,0):2
+5 SET X=1+$PIECE(^CIANB(19941.24,0),U,3)
SET IEN=$ORDER(^($CHAR(1)),-1)+1
SET $PIECE(^(0),U,3,4)=X_U_IEN
SET ^(IEN,0)=UID_U_USER_U_WID_U_NOW_U_U_DUZ(2)
+6 LOCK -^CIANB(19941.24,0)
+7 SET ^CIANB(19941.24,"B",UID,IEN)=""
+8 SET ^CIANB(19941.24,"BUSER",USER,IEN)=""
+9 SET ^CIANB(19941.24,"BWID",WID,IEN)=""
+10 SET ^CIANB(19941.24,"BLOGIN",NOW,IEN)=""
+11 SET ^CIANB(19941.24,"BDIV",DUZ(2),IEN)=""
+12 QUIT IEN
+13 ; Close a log entry.
+14 ; IEN = IEN of the entry.
CLOSE(IEN) ;EP
+1 NEW NOW
+2 SET NOW=$$NOW^XLFDT
+3 IF $DATA(^CIANB(19941.24,+IEN,0))
SET $PIECE(^(0),U,5)=NOW
SET ^CIANB(19941.24,"BLOGOUT",NOW,IEN)=""
+4 QUIT
+5 ; Log an activity
+6 ; IEN = IEN of log entry
+7 ; TYPE = Type of log entry (1=RPC, 2=Event)
+8 ; NAME = Text name associated with activity
+9 ; Returns subfile IEN
LOG(IEN,TYPE,NAME) ;EP
+1 NEW SUB,NOW
+2 IF '$DATA(^CIANB(19941.24,IEN))
QUIT 0
+3 SET NOW=$$NOW^XLFDT
+4 SET SUB=$ORDER(^CIANB(19941.24,IEN,10,$CHAR(1)),-1)+1
SET ^(0)="^19941.241D^"_SUB_U_SUB
SET ^(SUB,0)=NOW_U_TYPE_U_NAME
+5 QUIT SUB
+6 ; Add an entry to the specified activity
+7 ; IEN = IEN of log entry
+8 ; SUB = IEN of subfile entry
+9 ; ARY = Array or global root
+10 ; INC = Include variable name with output (optional)
ADD(IEN,SUB,ARY,INC) ;EP
+1 NEW ROOT,WP,A,L,P,X,Y,Z
+2 SET ROOT=$NAME(^CIANB(19941.24,IEN,10,SUB,10))
+3 SET WP=$ORDER(@ROOT@($CHAR(1)),-1)
SET WP(0)=WP
SET INC=+$GET(INC)
SET (A,ARY)=$NAME(@ARY)
SET L=$QLENGTH(ARY)
+4 FOR
IF $DATA(@A)#2
Begin DoDot:1
+5 SET X=@A
SET P=$SELECT(INC:A_" = ",1:"")
+6 FOR
IF '$LENGTH(X)
QUIT
Begin DoDot:2
+7 SET Y=$FIND(X,$CHAR(13))
+8 IF 'Y!(Y>200)
SET Y=200
+9 SET Z=$TRANSLATE($EXTRACT(X,1,Y-1),$CHAR(13,10))
SET X=$EXTRACT(X,Y,999999)
+10 SET WP=WP+1
SET @ROOT@(WP,0)=P_Z
SET P=$SELECT(INC:">>> ",1:"")
End DoDot:2
End DoDot:1
SET A=$QUERY(@A)
IF '$LENGTH(A)
QUIT
IF $NAME(@A,L)'=ARY
QUIT
+11 IF WP'=WP(0)
SET @ROOT@(0)="^^"_WP_U_WP_U_$$NOW^XLFDT
+12 QUIT
+13 ; Delete a log entry
DELETE(DA) ;
+1 IF '$DATA(^CIANB(19941.24,DA))
QUIT
+2 NEW DIK
+3 SET DIK="^CIANB(19941.24,"
+4 DO ^DIK
+5 QUIT
+6 ; Task purge in background
TASKPRG NEW ZTSK
+1 SET ZTSK=$$QUEUE^CIAUTSK("DOPURGE^CIANBLOG","Purge CIA ACTIVITY LOG")
+2 IF ZTSK>0
WRITE !,"CIA ACTIVITY LOG purge submitted as task #",ZTSK,!!
+3 IF '$TEST
WRITE !,"Error submitting CIA ACTIVITY LOG purge.",!!
+4 QUIT
+5 ; Purge log entries according to retention criteria
DOPURGE NEW DAYS,LP,IEN
+1 SET DAYS=$$GET^XPAR("ALL","CIANB ACTIVITY RETENTION")
+2 IF 'DAYS
QUIT
+3 SET LP=$$FMADD^XLFDT(DT,-DAYS)
+4 FOR
SET LP=$ORDER(^CIANB(19941.24,"BLOGIN",LP),-1)
IF 'LP
QUIT
Begin DoDot:1
+5 SET IEN=0
+6 FOR
SET IEN=$ORDER(^CIANB(19941.24,"BLOGIN",LP,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+7 DO DELETE(IEN)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ; Returns true if activity logging is active
+10 ; Creates a log entry if one does not already exist
ISACTIVE() ;
+1 NEW RTN,DUZ2
+2 IF '$DATA(CIA("UID"))
QUIT 0
+3 IF 'CIA("UID")
QUIT 0
+4 SET DUZ2=$$GETVAR^CIANBUTL("DUZ2")
+5 SET RTN=$$GETVAR^CIANBUTL("ALOG"_$SELECT(DUZ2:":"_DUZ2,1:""))
+6 IF RTN=""
Begin DoDot:1
+7 SET RTN=+$$GET^XPAR("ALL","CIANB ACTIVITY LOGGING","`"_$$GETVAR^CIANBUTL("AID0"))
+8 IF RTN
SET RTN=$$OPEN(CIA("UID"),DUZ,$$GETVAR^CIANBUTL("WID"))
+9 DO SETVAR^CIANBUTL("ALOG"_$SELECT(DUZ2:":"_DUZ2,1:""),RTN)
End DoDot:1
+10 QUIT RTN
