Routine: BSTSAPIL

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

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")))

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)

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)

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")

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

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

BSTSAPIL.m