BSTSAPIL ;GDIT/HS/BEE-Standard Terminology Activity Logging ; 5 Nov 2012 9:53 AM
;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
;
Q
;
SEARCH(BSTSWS) ;Log search strings
;
;If search logging is enabled, this tag puts the search on a queue
;to send to DTS
;
;Quit if search logging disabled
Q:'$$LENABLE()
;
NEW %
;
D NOW^%DTC
;
;Log the entry
D LOG("SRCH",$G(BSTSWS("NAMESPACEID")),"SEARCH",$G(BSTSWS("SEARCH")))
;
Q
;
STATUS() ;Log daily status message
;
NEW CDSET,%,DOW
;
;Get day of week - Send on Monday
D NOW^%DTC
S DOW=$$DOW^XLFDT(%,1)
I DOW'=1 Q
;
F CDSET=36,1552,5180,32771,32772,32773,32774,32777,32779,32780 D
. ;
. NEW CDIEN,VRSN
. ;
. S CDIEN=$O(^BSTS(9002318.1,"B",CDSET,"")) Q:'CDIEN
. ;
. ;Record version
. S VRSN=$$GET1^DIQ(9002318.1,CDIEN_",",.04,"E") D LOG("VRSN",CDSET,"VERSION",VRSN)
;
Q
;
LENABLE() ;Return TRUE if ENABLE SEARCH LOGGING is on
;
NEW PRI,PIEN,WIEN
;
;Get first priority entry
S PRI=$O(^BSTS(9002318,"C","")) Q:'PRI 0
S PIEN=$O(^BSTS(9002318,"C",PRI,1,""))
;
;Determine whether search logging is on
S WIEN=$P($G(^BSTS(9002318,1,1,PIEN,0)),U) Q:'WIEN 0
Q $$GET1^DIQ(9002318.2,WIEN_",",.16,"I")
;
PLOG() ;Proces log entries
;
NEW LIEN
;
;Process each log entry
S LIEN="" F S LIEN=$O(^XTMP("BSTSPROCQ","L",LIEN)) Q:LIEN="" D
. ;
. NEW ENODE,ETYPE,ENAME,EVALUE,ENSPACE,EDTTM,BSTSWS,SRV,SERVERS,SITE,SIEN,RNAME,EXEC,SNUM
. NEW RES,STS,ESERV
. ;
. ;Event Type
. S ENODE=$G(^XTMP("BSTSPROCQ","L",LIEN))
. S ETYPE=$P(ENODE,U) Q:ETYPE=""
. ;
. ;Event Date/Time
. S EDTTM=$P(ENODE,U,2) Q:EDTTM=""
. S EDTTM=$P($$FMTE^BSTSUTIL(EDTTM),":",1,2) Q:EDTTM=""
. ;
. ;Namespace
. S ENSPACE=$P(ENODE,U,3) S:ENSPACE="" ENSPACE="null"
. ;
. ;Event Name
. S ENAME=$P(ENODE,U,4) S:ENAME="" ENAME="null"
. ;
. ;Event Value
. S EVALUE=$P(ENODE,U,5) S:EVALUE="" EVALUE="null"
. ;
. ;Get the server information
. S ESERV=$$WSERVER^BSTSWSV(.SERVERS,"") Q:'ESERV
. S SRV=$O(SERVERS(0)) Q:'SRV
. M BSTSWS=SERVERS(SRV)
. ;
. ;Get the site
. S SIEN=$O(^AUTTSITE(0)) Q:'+SIEN
. S SITE=$$GET1^DIQ(9999999.39,SIEN_",",.01,"E") Q:SIEN=""
. S SNUM=$$GET1^DIQ(9999999.39,SIEN_",",.01,"I") Q:SNUM=""
. ;
. ;Log the DTS event
. S BSTSWS("ETYPE")=ETYPE
. S BSTSWS("EDTTM")=EDTTM
. S BSTSWS("ENSPACE")=ENSPACE
. S BSTSWS("ENAME")=ENAME
. S BSTSWS("EVALUE")=EVALUE
. S BSTSWS("ESITE")=SITE_"|"_SNUM
. S BSTSWS("EPROD")=$$PROD^XUPROD()
. S RNAME="",EXEC="S RNAME=$"_"ZNSPACE" X EXEC
. S BSTSWS("RNAME")=RNAME
. ;
. ;Log the event
. S STS=$$ELOG^BSTSCMCL(.BSTSWS,.RES)
. ;
. ;If success, remove entry
. I +STS=1 K ^XTMP("BSTSPROCQ","L",LIEN)
;
Q
;
LOG(ETYPE,ENSPACE,ENAME,EVALUE) ;Put entry on the log queue
;
;Must have log event type
I $G(ETYPE)="" Q
;
NEW %
;
;Get the current date/time
D NOW^%DTC
;
;Log the entry
L +^XTMP("BSTSPROCQ","L"):2 E Q
S ^XTMP("BSTSPROCQ","L")=$G(^XTMP("BSTSPROCQ","L"))+1
S ^XTMP("BSTSPROCQ","L",^XTMP("BSTSPROCQ","L"))=ETYPE_U_%_U_$G(ENSPACE)_U_$G(ENAME)_U_$G(EVALUE)
L -^XTMP("BSTSPROCQ","L")
Q
;
LGHST ;Return list of DTS log history
;
NEW FRDT,TODT,ESERV,SRV,SIEN,SNUM,RNAME,EXEC,ENSPACE,BSTSWS,SERVERS
NEW SPACE,STS,POP,CT,BSTSRPT,ICNT,SRMAX,SCNT,DIRUT,DTOUT
;
S $P(SPACE," ",80)=" "
;
W !!,"DISPLAY BSTS DTS LOG HISTORY"
;
;Get From Date
S FRDT=$$DATE^BSTSDSP("From Date","T-7") Q:'FRDT
;
;Get To Date
S TODT=$$DATE^BSTSDSP("To Date","T",FRDT) Q:'TODT
;
;Get maximum search results to display
S SRMAX=$$SMAX^BSTSSTA() Q:'SRMAX
;
S ENSPACE=36
;
;Get the server information
S ESERV=$$WSERVER^BSTSWSV(.SERVERS,"") Q:'ESERV
S SRV=$O(SERVERS(0)) Q:'SRV
M BSTSWS=SERVERS(SRV)
;
;Get the site
S SIEN=$O(^AUTTSITE(0)) Q:'+SIEN
S SNUM=$$GET1^DIQ(9999999.39,SIEN_",",.01,"I") Q:SNUM=""
;
;Get search results
S BSTSWS("FRDT")=$P($$FMTE^BSTSUTIL(FRDT),":",1,2)_" 00:00"
S BSTSWS("TODT")=$P($$FMTE^BSTSUTIL(TODT),":",1,2)_" 23:59"
S BSTSWS("ENSPACE")=ENSPACE
S BSTSWS("ESITE")=SNUM
S BSTSWS("EPROD")=$$PROD^XUPROD()
S RNAME="",EXEC="S RNAME=$"_"ZNSPACE" X EXEC
S BSTSWS("RNAME")=RNAME
;
;Pull the search list
S STS=$$LHIST^BSTSCMCL(.BSTSWS,.RES)
;
;Get device
W !
S POP="" D ^%ZIS I POP Q
U IO
;
;Display results
S (SCNT,CT)=0,CT=CT+1,BSTSRPT(CT)="BSTS DTS LOG HISTORY: "_$$FMTE^XLFDT(FRDT,"2ZD")_" TO "_$$FMTE^XLFDT(TODT,"2ZD")_" - LATEST "_SRMAX_" EVENTS LOGGED"
S CT=CT+1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)=$E("ID"_SPACE,1,10)_$E("EVENT DATE"_SPACE,1,17)_$E("EVENT TYPE"_SPACE,1,15)_$E("CODESET"_SPACE,1,10)_$E("EVENT NAME"_SPACE,1,12)_$E("VALUE"_SPACE,1,15)
S CT=CT+1,BSTSRPT(CT)=" "
S ICNT="" F S ICNT=$O(^TMP("BSTSCMCL",$J,ICNT)) Q:ICNT="" D I (SCNT+1)>SRMAX Q
. ;
. NEW NODE
. ;
. S NODE=$G(^TMP("BSTSCMCL",$J,ICNT))
. S CT=CT+1,BSTSRPT(CT)=$E($P(NODE,U)_SPACE,1,10)_$E($$FMTE^XLFDT($$DTS2FMDT^BSTSUTIL($P(NODE,U,3)),"5")_SPACE,1,17)_$E($P(NODE,U,4)_SPACE,1,15)_$E($P(NODE,U,2)_SPACE,1,10)_$E($P(NODE,U,5)_SPACE,1,12)_$E($P(NODE,U,6)_SPACE,1,15)
. S SCNT=SCNT+1
;
I SCNT D
. S CT=CT+1,BSTSRPT(CT)=" "
. S CT=CT+1,BSTSRPT(CT)="EVENT TYPE LEGEND"
. S CT=CT+1,BSTSRPT(CT)=" "
. S CT=CT+1,BSTSRPT(CT)="EVENT TYPE DESCRIPTION"
. S CT=CT+1,BSTSRPT(CT)="INST BSTS patch installed"
. S CT=CT+1,BSTSRPT(CT)="UPDS Update process started"
. S CT=CT+1,BSTSRPT(CT)="UPDE Update process finished"
. S CT=CT+1,BSTSRPT(CT)="VRSN Current DTS version"
;
;Check for no results
I SCNT=0 D
. S CT=CT+1,BSTSRPT(CT)="No results found. This could be because the link to the DTS server"
. S CT=CT+1,BSTSRPT(CT)="is currently down."
;
S CT=CT+1,BSTSRPT(CT)=" "
S CT=CT+1,BSTSRPT(CT)="<END OF REPORT>"
;
;Display the report
D EN^DDIOL(.BSTSRPT)
;
;Close the device
D ^%ZISC
;
I $D(IOST),IOST["C-",'$D(DIRUT),'$D(DTOUT) D
. NEW DIR,X,Y
. W ! S DIR(0)="E",DIR("A")="Press 'Return to continue'" D ^DIR
;
Q
BSTSAPIL ;GDIT/HS/BEE-Standard Terminology Activity Logging ; 5 Nov 2012 9:53 AM
+1 ;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
+2 ;
+3 QUIT
+4 ;
SEARCH(BSTSWS) ;Log search strings
+1 ;
+2 ;If search logging is enabled, this tag puts the search on a queue
+3 ;to send to DTS
+4 ;
+5 ;Quit if search logging disabled
+6 IF '$$LENABLE()
QUIT
+7 ;
+8 NEW %
+9 ;
+10 DO NOW^%DTC
+11 ;
+12 ;Log the entry
+13 DO LOG("SRCH",$GET(BSTSWS("NAMESPACEID")),"SEARCH",$GET(BSTSWS("SEARCH")))
+14 ;
+15 QUIT
+16 ;
STATUS() ;Log daily status message
+1 ;
+2 NEW CDSET,%,DOW
+3 ;
+4 ;Get day of week - Send on Monday
+5 DO NOW^%DTC
+6 SET DOW=$$DOW^XLFDT(%,1)
+7 IF DOW'=1
QUIT
+8 ;
+9 FOR CDSET=36,1552,5180,32771,32772,32773,32774,32777,32779,32780
Begin DoDot:1
+10 ;
+11 NEW CDIEN,VRSN
+12 ;
+13 SET CDIEN=$ORDER(^BSTS(9002318.1,"B",CDSET,""))
IF 'CDIEN
QUIT
+14 ;
+15 ;Record version
+16 SET VRSN=$$GET1^DIQ(9002318.1,CDIEN_",",.04,"E")
DO LOG("VRSN",CDSET,"VERSION",VRSN)
End DoDot:1
+17 ;
+18 QUIT
+19 ;
LENABLE() ;Return TRUE if ENABLE SEARCH LOGGING is on
+1 ;
+2 NEW PRI,PIEN,WIEN
+3 ;
+4 ;Get first priority entry
+5 SET PRI=$ORDER(^BSTS(9002318,"C",""))
IF 'PRI
QUIT 0
+6 SET PIEN=$ORDER(^BSTS(9002318,"C",PRI,1,""))
+7 ;
+8 ;Determine whether search logging is on
+9 SET WIEN=$PIECE($GET(^BSTS(9002318,1,1,PIEN,0)),U)
IF 'WIEN
QUIT 0
+10 QUIT $$GET1^DIQ(9002318.2,WIEN_",",.16,"I")
+11 ;
PLOG() ;Proces log entries
+1 ;
+2 NEW LIEN
+3 ;
+4 ;Process each log entry
+5 SET LIEN=""
FOR
SET LIEN=$ORDER(^XTMP("BSTSPROCQ","L",LIEN))
IF LIEN=""
QUIT
Begin DoDot:1
+6 ;
+7 NEW ENODE,ETYPE,ENAME,EVALUE,ENSPACE,EDTTM,BSTSWS,SRV,SERVERS,SITE,SIEN,RNAME,EXEC,SNUM
+8 NEW RES,STS,ESERV
+9 ;
+10 ;Event Type
+11 SET ENODE=$GET(^XTMP("BSTSPROCQ","L",LIEN))
+12 SET ETYPE=$PIECE(ENODE,U)
IF ETYPE=""
QUIT
+13 ;
+14 ;Event Date/Time
+15 SET EDTTM=$PIECE(ENODE,U,2)
IF EDTTM=""
QUIT
+16 SET EDTTM=$PIECE($$FMTE^BSTSUTIL(EDTTM),":",1,2)
IF EDTTM=""
QUIT
+17 ;
+18 ;Namespace
+19 SET ENSPACE=$PIECE(ENODE,U,3)
IF ENSPACE=""
SET ENSPACE="null"
+20 ;
+21 ;Event Name
+22 SET ENAME=$PIECE(ENODE,U,4)
IF ENAME=""
SET ENAME="null"
+23 ;
+24 ;Event Value
+25 SET EVALUE=$PIECE(ENODE,U,5)
IF EVALUE=""
SET EVALUE="null"
+26 ;
+27 ;Get the server information
+28 SET ESERV=$$WSERVER^BSTSWSV(.SERVERS,"")
IF 'ESERV
QUIT
+29 SET SRV=$ORDER(SERVERS(0))
IF 'SRV
QUIT
+30 MERGE BSTSWS=SERVERS(SRV)
+31 ;
+32 ;Get the site
+33 SET SIEN=$ORDER(^AUTTSITE(0))
IF '+SIEN
QUIT
+34 SET SITE=$$GET1^DIQ(9999999.39,SIEN_",",.01,"E")
IF SIEN=""
QUIT
+35 SET SNUM=$$GET1^DIQ(9999999.39,SIEN_",",.01,"I")
IF SNUM=""
QUIT
+36 ;
+37 ;Log the DTS event
+38 SET BSTSWS("ETYPE")=ETYPE
+39 SET BSTSWS("EDTTM")=EDTTM
+40 SET BSTSWS("ENSPACE")=ENSPACE
+41 SET BSTSWS("ENAME")=ENAME
+42 SET BSTSWS("EVALUE")=EVALUE
+43 SET BSTSWS("ESITE")=SITE_"|"_SNUM
+44 SET BSTSWS("EPROD")=$$PROD^XUPROD()
+45 SET RNAME=""
SET EXEC="S RNAME=$"_"ZNSPACE"
XECUTE EXEC
+46 SET BSTSWS("RNAME")=RNAME
+47 ;
+48 ;Log the event
+49 SET STS=$$ELOG^BSTSCMCL(.BSTSWS,.RES)
+50 ;
+51 ;If success, remove entry
+52 IF +STS=1
KILL ^XTMP("BSTSPROCQ","L",LIEN)
End DoDot:1
+53 ;
+54 QUIT
+55 ;
LOG(ETYPE,ENSPACE,ENAME,EVALUE) ;Put entry on the log queue
+1 ;
+2 ;Must have log event type
+3 IF $GET(ETYPE)=""
QUIT
+4 ;
+5 NEW %
+6 ;
+7 ;Get the current date/time
+8 DO NOW^%DTC
+9 ;
+10 ;Log the entry
+11 LOCK +^XTMP("BSTSPROCQ","L"):2
IF '$TEST
QUIT
+12 SET ^XTMP("BSTSPROCQ","L")=$GET(^XTMP("BSTSPROCQ","L"))+1
+13 SET ^XTMP("BSTSPROCQ","L",^XTMP("BSTSPROCQ","L"))=ETYPE_U_%_U_$GET(ENSPACE)_U_$GET(ENAME)_U_$GET(EVALUE)
+14 LOCK -^XTMP("BSTSPROCQ","L")
+15 QUIT
+16 ;
LGHST ;Return list of DTS log history
+1 ;
+2 NEW FRDT,TODT,ESERV,SRV,SIEN,SNUM,RNAME,EXEC,ENSPACE,BSTSWS,SERVERS
+3 NEW SPACE,STS,POP,CT,BSTSRPT,ICNT,SRMAX,SCNT,DIRUT,DTOUT
+4 ;
+5 SET $PIECE(SPACE," ",80)=" "
+6 ;
+7 WRITE !!,"DISPLAY BSTS DTS LOG HISTORY"
+8 ;
+9 ;Get From Date
+10 SET FRDT=$$DATE^BSTSDSP("From Date","T-7")
IF 'FRDT
QUIT
+11 ;
+12 ;Get To Date
+13 SET TODT=$$DATE^BSTSDSP("To Date","T",FRDT)
IF 'TODT
QUIT
+14 ;
+15 ;Get maximum search results to display
+16 SET SRMAX=$$SMAX^BSTSSTA()
IF 'SRMAX
QUIT
+17 ;
+18 SET ENSPACE=36
+19 ;
+20 ;Get the server information
+21 SET ESERV=$$WSERVER^BSTSWSV(.SERVERS,"")
IF 'ESERV
QUIT
+22 SET SRV=$ORDER(SERVERS(0))
IF 'SRV
QUIT
+23 MERGE BSTSWS=SERVERS(SRV)
+24 ;
+25 ;Get the site
+26 SET SIEN=$ORDER(^AUTTSITE(0))
IF '+SIEN
QUIT
+27 SET SNUM=$$GET1^DIQ(9999999.39,SIEN_",",.01,"I")
IF SNUM=""
QUIT
+28 ;
+29 ;Get search results
+30 SET BSTSWS("FRDT")=$PIECE($$FMTE^BSTSUTIL(FRDT),":",1,2)_" 00:00"
+31 SET BSTSWS("TODT")=$PIECE($$FMTE^BSTSUTIL(TODT),":",1,2)_" 23:59"
+32 SET BSTSWS("ENSPACE")=ENSPACE
+33 SET BSTSWS("ESITE")=SNUM
+34 SET BSTSWS("EPROD")=$$PROD^XUPROD()
+35 SET RNAME=""
SET EXEC="S RNAME=$"_"ZNSPACE"
XECUTE EXEC
+36 SET BSTSWS("RNAME")=RNAME
+37 ;
+38 ;Pull the search list
+39 SET STS=$$LHIST^BSTSCMCL(.BSTSWS,.RES)
+40 ;
+41 ;Get device
+42 WRITE !
+43 SET POP=""
DO ^%ZIS
IF POP
QUIT
+44 USE IO
+45 ;
+46 ;Display results
+47 SET (SCNT,CT)=0
SET CT=CT+1
SET BSTSRPT(CT)="BSTS DTS LOG HISTORY: "_$$FMTE^XLFDT(FRDT,"2ZD")_" TO "_$$FMTE^XLFDT(TODT,"2ZD")_" - LATEST "_SRMAX_" EVENTS LOGGED"
+48 SET CT=CT+1
SET BSTSRPT(CT)=" "
+49 SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT("ID"_SPACE,1,10)_$EXTRACT("EVENT DATE"_SPACE,1,17)_$EXTRACT("EVENT TYPE"_SPACE,1,15)_$EXTRACT("CODESET"_SPACE,1,10)_$EXTRACT("EVENT NAME"_SPACE,1,12)_$EXTRACT("VALUE"_SPACE,1,15)
+50 SET CT=CT+1
SET BSTSRPT(CT)=" "
+51 SET ICNT=""
FOR
SET ICNT=$ORDER(^TMP("BSTSCMCL",$JOB,ICNT))
IF ICNT=""
QUIT
Begin DoDot:1
+52 ;
+53 NEW NODE
+54 ;
+55 SET NODE=$GET(^TMP("BSTSCMCL",$JOB,ICNT))
+56 SET CT=CT+1
SET BSTSRPT(CT)=$EXTRACT($PIECE(NODE,U)_SPACE,1,10)_$EXTRACT($$FMTE^XLFDT($$DTS2FMDT^BSTSUTIL($PIECE(NODE,U,3)),"5")_SPACE,1,17)_$EXTRACT($PIECE(NODE,U,4)_SPACE,1,15)_...
... $EXTRACT($PIECE(NODE,U,2)_SPACE,1,10)_$EXTRACT($PIECE(NODE,U,5)_SPACE,1,12)_$EXTRACT($PIECE(NODE,U,6)_SPACE,1,15)
+57 SET SCNT=SCNT+1
End DoDot:1
IF (SCNT+1)>SRMAX
QUIT
+58 ;
+59 IF SCNT
Begin DoDot:1
+60 SET CT=CT+1
SET BSTSRPT(CT)=" "
+61 SET CT=CT+1
SET BSTSRPT(CT)="EVENT TYPE LEGEND"
+62 SET CT=CT+1
SET BSTSRPT(CT)=" "
+63 SET CT=CT+1
SET BSTSRPT(CT)="EVENT TYPE DESCRIPTION"
+64 SET CT=CT+1
SET BSTSRPT(CT)="INST BSTS patch installed"
+65 SET CT=CT+1
SET BSTSRPT(CT)="UPDS Update process started"
+66 SET CT=CT+1
SET BSTSRPT(CT)="UPDE Update process finished"
+67 SET CT=CT+1
SET BSTSRPT(CT)="VRSN Current DTS version"
End DoDot:1
+68 ;
+69 ;Check for no results
+70 IF SCNT=0
Begin DoDot:1
+71 SET CT=CT+1
SET BSTSRPT(CT)="No results found. This could be because the link to the DTS server"
+72 SET CT=CT+1
SET BSTSRPT(CT)="is currently down."
End DoDot:1
+73 ;
+74 SET CT=CT+1
SET BSTSRPT(CT)=" "
+75 SET CT=CT+1
SET BSTSRPT(CT)="<END OF REPORT>"
+76 ;
+77 ;Display the report
+78 DO EN^DDIOL(.BSTSRPT)
+79 ;
+80 ;Close the device
+81 DO ^%ZISC
+82 ;
+83 IF $DATA(IOST)
IF IOST["C-"
IF '$DATA(DIRUT)
IF '$DATA(DTOUT)
Begin DoDot:1
+84 NEW DIR,X,Y
+85 WRITE !
SET DIR(0)="E"
SET DIR("A")="Press 'Return to continue'"
DO ^DIR
End DoDot:1
+86 ;
+87 QUIT
