BSTS2PST ;GDIT/HS/BEE-Version 2.0 Post-Install ; 19 Nov 2012 9:41 AM
;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
;
EN ;Post Install Front End
;
NEW TRIEN,EXEC,ERR,WIEN,WSIEN,PATCH,SIEN,STS,TR,CDST
NEW SSLNAME,SSLFND,SYSXREF,SYSGL
;
;Load the classes
;
;For each build, set this to the 9002318.5 entry to load
S TRIEN=1
;
;Delete existing BSTS Classes
S EXEC="DO $SYSTEM.OBJ.DeletePackage(""BSTS"")" X EXEC
;
; Import BSTS classes
;
K ERR
I $G(TRIEN)'="" D IMPORT^BSTSCLAS(TRIEN,.ERR)
;
;Make sure a SSL entry is defined
;
;Look for an SSL server
S SYSXREF="^[""%SYS""]SYS",SYSGL=$NA(@SYSXREF)
S (SSLFND,SSLNAME)="" F S SSLNAME=$O(@SYSGL@("Security","SSLConfigsD",SSLNAME)) Q:SSLNAME="" D Q:SSLFND]""
. NEW UPNAME
. S UPNAME=$$UP^XLFSTR(SSLNAME)
. I UPNAME["SNOMED" S SSLFND=SSLNAME
;
;Modify existing entry
I SSLFND]"" D
. NEW EXEC,SOBJ,STS,ONAMESPC
. S EXEC="S ONAMESPC=$"_"ZNSPACE" X EXEC
. S EXEC="ZN ""%SYS""" X EXEC
. S SSLNAME=""
. S EXEC="S SOBJ=##CLASS(Security.SSLConfigs).%OpenId("""_SSLFND_""")" X EXEC
. S EXEC="S SOBJ.CipherList=""TLSv1:!ADH:!LOW:!EXP:@STRENGTH""" X EXEC
. S EXEC="S SOBJ.PrivateKeyType=2" X EXEC
. S EXEC="S SOBJ.Protocols=4" X EXEC
. S EXEC="S SOBJ.Type=0" X EXEC
. S EXEC="S SOBJ.VerifyDepth=9" X EXEC
. S EXEC="S SOBJ.VerifyPeer=0" X EXEC
. S EXEC="S SOBJ.Enabled=1" X EXEC
. S EXEC="S SSLNAME=SOBJ.Name" X EXEC
. S EXEC="S STS=SOBJ.%Save()" X EXEC
. S EXEC="ZN ONAMESPC" X EXEC
;
;If no entry, create one
I SSLFND="" D
. NEW EXEC,SOBJ,STS,ONAMESPC
. S EXEC="S ONAMESPC=$"_"ZNSPACE" X EXEC
. S EXEC="ZN ""%SYS""" X EXEC
. S EXEC="S SOBJ=##CLASS(Security.SSLConfigs).%New()" X EXEC
. S EXEC="S SOBJ.Description=""SNOMED Terminology Server""" X EXEC
. S EXEC="S SOBJ.Name=""SNOMEDServer""" X EXEC
. S EXEC="S SOBJ.CipherList=""TLSv1:!ADH:!LOW:!EXP:@STRENGTH""" X EXEC
. S EXEC="S SOBJ.PrivateKeyType=2" X EXEC
. S EXEC="S SOBJ.Protocols=4" X EXEC
. S EXEC="S SOBJ.Type=0" X EXEC
. S EXEC="S SOBJ.VerifyDepth=9" X EXEC
. S EXEC="S SOBJ.VerifyPeer=0" X EXEC
. S EXEC="S SOBJ.Enabled=1" X EXEC
. S EXEC="S STS=SOBJ.%Save()" X EXEC
. S SSLNAME="SNOMEDServer"
. S EXEC="ZN ONAMESPC" X EXEC
;
;Set up BSTS WEB SERVICE ENDPOINT entry
;
;Make sure an entry is defined
I '$O(^BSTS(9002318.2,0)) D
. ;
. NEW DIC,DLAYGO,X,Y
. ;
. S DIC(0)="LNZ",DIC="^BSTS(9002318.2,",DLAYGO=9002318.2,X="PRODUCTION"
. D ^DIC
;
;Loop through entries and update
S WSIEN="",WIEN=0 F S WIEN=$O(^BSTS(9002318.2,WIEN)) Q:'WIEN D
. ;
. NEW PORT,NAME,NWPORT,BSTSWEB,URL,SSL,SSLCT
. ;
. S NAME=$$GET1^DIQ(9002318.2,WIEN_",",.01,"E")
. S (URL,NWPORT)=""
. ;
. ;Production
. S (SSLCT,NWPORT)="",PORT=$$GET1^DIQ(9002318.2,WIEN_",",.03,"E")
. I ((PORT="")&(NAME="PRODUCTION"))!(PORT=443)!(PORT=444)!(PORT=445)!(PORT=42102)!(PORT=44200) D
.. S NWPORT=44200
.. S URL="https://dtsservices.ihs.gov"
.. S WSIEN=WIEN,SSLCT=1
. ;
. ;Test Production
. I (PORT=42100)!(PORT=44299) D
.. S NWPORT=44299
.. S URL="https://dtsservices.ihs.gov"
.. S SSLCT=1
. ;
. ;DITDTS1
. I (PORT=8080)!(PORT=8081)!(PORT=8082)!(PORT=8083) D
.. S NWPORT=8083
.. S URL="http://ditdts1"
. ;
. ;GDIT DTS 4.4 Server
. I (PORT=8445)!(PORT=8446) D
.. S NWPORT=8446
.. S URL="https://vdenmihsdevd01"
.. S SSLCT=1
. ;
. ;Port
. I NWPORT]"" S BSTSWEB(9002318.2,WIEN_",",.03)=NWPORT
. ;
. ;URL
. I URL]"" S BSTSWEB(9002318.2,WIEN_",",.02)=URL
. ;
. ;Update the service patch
. S BSTSWEB(9002318.2,WIEN_",",.11)="/soap"
. ;
. ;SSL/TLS Configuration
. S SSL=$$GET1^DIQ(9002318.2,WIEN_",",2.01,"E")
. I SSL="" S BSTSWEB(9002318.2,WIEN_",",2.01)=$S(SSLCT:SSLNAME,1:"@")
. ;
. ;Username
. S BSTSWEB(9002318.2,WIEN_",",.07)="DTSUser"
. ;
. ;Password
. S BSTSWEB(9002318.2,WIEN_",",.08)="DTSPW!"
. ;
. ;Type
. S BSTSWEB(9002318.2,WIEN_",",.04)="D"
. ;
. ;Update the entry
. D FILE^DIE("","BSTSWEB","ERR")
;
;Set up BSTS SITE PARAMETERS entry
;
I '$O(^BSTS(9002318,0)) D
. ;
. NEW DIC,DLAYGO,X,Y
. ;
. ;Set up the site parameter entry if necessary
. S DIC(0)="LNZ",DIC="^BSTS(9002318,",DLAYGO=9002318,X=$P($G(^AUTTSITE(1,0)),U,1)
. I X="" S X=$O(^BGPSITE(0))
. I X'="" S X=$P(^DIC(4,X,0),U,1)
. D ^DIC
S SIEN=$O(^BSTS(9002318,0))
;
;Set up the Web Service entry if not found
I SIEN]"" D
. NEW DIC,DLAYGO,X,Y,DA
. I $O(^BSTS(9002318,SIEN,1,0)) Q
. I WSIEN="" Q
. S DA(1)=SIEN,DIC(0)="XLNZ",DIC="^BSTS(9002318,"_SIEN_",1,",DLAYGO="9002318.01"
. S X=WSIEN
. K DO,DD D FILE^DICN
;
;Update the Web Service entry
I SIEN]"" D
. NEW WIEN,DA,IENS,BSTSSITE,ERROR
. S WIEN=$O(^BSTS(9002318,SIEN,1,0)) Q:'+WIEN
. S DA(1)=SIEN,DA=WIEN,IENS=$$IENS^DILF(.DA)
. S BSTSSITE(9002318.01,IENS,.02)=1 ;Priority
. D FILE^DIE("","BSTSSITE","ERROR")
;
;Display status to screen
D BMES^XPDUTL("Verifying connection to DTS server is working. This may take several minutes to complete ")
;
;Verify that the server connects, if not quit
S STS="" F TR=1:1:20 D I +STS=2 Q
. NEW VAR
. D RESET^BSTSWSV1 ;Reset DTS to on
. S STS=$$CODESETS^BSTSAPI("VAR") ;Try quick call
. I +STS'=2 H 1
;
;Quit on failure
I (+STS'=2) D D BMES^XPDUTL("DTS is not working properly. Please get the BSTS connection working and then re-install the build") H 10 S XPDABORT=1 G XEN
. ;
. ;Unlock installation entry
. L -^TMP("BSTSINSTALL")
. ;
. ;Allow logins again
. NEW LIEN,LOG,ERR
. S LIEN=$O(^%ZIS(14.5,0)) Q:'+LIEN
. S LOG(14.5,LIEN_",",1)="N"
. D FILE^DIE("","LOG","ERR")
;
;Pull the codeset versions
F CDST=36,1552,32771,32772,32773,32774,32775,32777,32778,32779,32780 D
. F TR=1:1:60 D I +STS=2 Q
.. NEW VAR
.. D RESET^BSTSWSV1 ;Reset DTS to on
.. S STS=$$VERSIONS^BSTSAPI("VAR",CDST)
;
;Unlock installation entry
L -^TMP("BSTSINSTALL")
;
;Kick off SNOMED update
D QUEUE^BSTSVOFL(36)
;
;Kick off RxNorm update
D QUEUE^BSTSVOFL("S1552")
;
;Kick off update to pull down SNOMED information
D QUEUE^BSTSVOFL(32777) ;Put it on the queue
;
;Queue custom codesets
D QUEUE^BSTSVOFL(32771)
D QUEUE^BSTSVOFL(32772)
D QUEUE^BSTSVOFL(32773)
D QUEUE^BSTSVOFL(32774)
D QUEUE^BSTSVOFL(32775)
;
D JOBNOW^BSTSVOFL ;Kick off now
;
XEN Q
BSTS2PST ;GDIT/HS/BEE-Version 2.0 Post-Install ; 19 Nov 2012 9:41 AM
+1 ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
+2 ;
EN ;Post Install Front End
+1 ;
+2 NEW TRIEN,EXEC,ERR,WIEN,WSIEN,PATCH,SIEN,STS,TR,CDST
+3 NEW SSLNAME,SSLFND,SYSXREF,SYSGL
+4 ;
+5 ;Load the classes
+6 ;
+7 ;For each build, set this to the 9002318.5 entry to load
+8 SET TRIEN=1
+9 ;
+10 ;Delete existing BSTS Classes
+11 SET EXEC="DO $SYSTEM.OBJ.DeletePackage(""BSTS"")"
XECUTE EXEC
+12 ;
+13 ; Import BSTS classes
+14 ;
+15 KILL ERR
+16 IF $GET(TRIEN)'=""
DO IMPORT^BSTSCLAS(TRIEN,.ERR)
+17 ;
+18 ;Make sure a SSL entry is defined
+19 ;
+20 ;Look for an SSL server
+21 SET SYSXREF="^[""%SYS""]SYS"
SET SYSGL=$NAME(@SYSXREF)
+22 SET (SSLFND,SSLNAME)=""
FOR
SET SSLNAME=$ORDER(@SYSGL@("Security","SSLConfigsD",SSLNAME))
IF SSLNAME=""
QUIT
Begin DoDot:1
+23 NEW UPNAME
+24 SET UPNAME=$$UP^XLFSTR(SSLNAME)
+25 IF UPNAME["SNOMED"
SET SSLFND=SSLNAME
End DoDot:1
IF SSLFND]""
QUIT
+26 ;
+27 ;Modify existing entry
+28 IF SSLFND]""
Begin DoDot:1
+29 NEW EXEC,SOBJ,STS,ONAMESPC
+30 SET EXEC="S ONAMESPC=$"_"ZNSPACE"
XECUTE EXEC
+31 SET EXEC="ZN ""%SYS"""
XECUTE EXEC
+32 SET SSLNAME=""
+33 SET EXEC="S SOBJ=##CLASS(Security.SSLConfigs).%OpenId("""_SSLFND_""")"
XECUTE EXEC
+34 SET EXEC="S SOBJ.CipherList=""TLSv1:!ADH:!LOW:!EXP:@STRENGTH"""
XECUTE EXEC
+35 SET EXEC="S SOBJ.PrivateKeyType=2"
XECUTE EXEC
+36 SET EXEC="S SOBJ.Protocols=4"
XECUTE EXEC
+37 SET EXEC="S SOBJ.Type=0"
XECUTE EXEC
+38 SET EXEC="S SOBJ.VerifyDepth=9"
XECUTE EXEC
+39 SET EXEC="S SOBJ.VerifyPeer=0"
XECUTE EXEC
+40 SET EXEC="S SOBJ.Enabled=1"
XECUTE EXEC
+41 SET EXEC="S SSLNAME=SOBJ.Name"
XECUTE EXEC
+42 SET EXEC="S STS=SOBJ.%Save()"
XECUTE EXEC
+43 SET EXEC="ZN ONAMESPC"
XECUTE EXEC
End DoDot:1
+44 ;
+45 ;If no entry, create one
+46 IF SSLFND=""
Begin DoDot:1
+47 NEW EXEC,SOBJ,STS,ONAMESPC
+48 SET EXEC="S ONAMESPC=$"_"ZNSPACE"
XECUTE EXEC
+49 SET EXEC="ZN ""%SYS"""
XECUTE EXEC
+50 SET EXEC="S SOBJ=##CLASS(Security.SSLConfigs).%New()"
XECUTE EXEC
+51 SET EXEC="S SOBJ.Description=""SNOMED Terminology Server"""
XECUTE EXEC
+52 SET EXEC="S SOBJ.Name=""SNOMEDServer"""
XECUTE EXEC
+53 SET EXEC="S SOBJ.CipherList=""TLSv1:!ADH:!LOW:!EXP:@STRENGTH"""
XECUTE EXEC
+54 SET EXEC="S SOBJ.PrivateKeyType=2"
XECUTE EXEC
+55 SET EXEC="S SOBJ.Protocols=4"
XECUTE EXEC
+56 SET EXEC="S SOBJ.Type=0"
XECUTE EXEC
+57 SET EXEC="S SOBJ.VerifyDepth=9"
XECUTE EXEC
+58 SET EXEC="S SOBJ.VerifyPeer=0"
XECUTE EXEC
+59 SET EXEC="S SOBJ.Enabled=1"
XECUTE EXEC
+60 SET EXEC="S STS=SOBJ.%Save()"
XECUTE EXEC
+61 SET SSLNAME="SNOMEDServer"
+62 SET EXEC="ZN ONAMESPC"
XECUTE EXEC
End DoDot:1
+63 ;
+64 ;Set up BSTS WEB SERVICE ENDPOINT entry
+65 ;
+66 ;Make sure an entry is defined
+67 IF '$ORDER(^BSTS(9002318.2,0))
Begin DoDot:1
+68 ;
+69 NEW DIC,DLAYGO,X,Y
+70 ;
+71 SET DIC(0)="LNZ"
SET DIC="^BSTS(9002318.2,"
SET DLAYGO=9002318.2
SET X="PRODUCTION"
+72 DO ^DIC
End DoDot:1
+73 ;
+74 ;Loop through entries and update
+75 SET WSIEN=""
SET WIEN=0
FOR
SET WIEN=$ORDER(^BSTS(9002318.2,WIEN))
IF 'WIEN
QUIT
Begin DoDot:1
+76 ;
+77 NEW PORT,NAME,NWPORT,BSTSWEB,URL,SSL,SSLCT
+78 ;
+79 SET NAME=$$GET1^DIQ(9002318.2,WIEN_",",.01,"E")
+80 SET (URL,NWPORT)=""
+81 ;
+82 ;Production
+83 SET (SSLCT,NWPORT)=""
SET PORT=$$GET1^DIQ(9002318.2,WIEN_",",.03,"E")
+84 IF ((PORT="")&(NAME="PRODUCTION"))!(PORT=443)!(PORT=444)!(PORT=445)!(PORT=42102)!(PORT=44200)
Begin DoDot:2
+85 SET NWPORT=44200
+86 SET URL="https://dtsservices.ihs.gov"
+87 SET WSIEN=WIEN
SET SSLCT=1
End DoDot:2
+88 ;
+89 ;Test Production
+90 IF (PORT=42100)!(PORT=44299)
Begin DoDot:2
+91 SET NWPORT=44299
+92 SET URL="https://dtsservices.ihs.gov"
+93 SET SSLCT=1
End DoDot:2
+94 ;
+95 ;DITDTS1
+96 IF (PORT=8080)!(PORT=8081)!(PORT=8082)!(PORT=8083)
Begin DoDot:2
+97 SET NWPORT=8083
+98 SET URL="http://ditdts1"
End DoDot:2
+99 ;
+100 ;GDIT DTS 4.4 Server
+101 IF (PORT=8445)!(PORT=8446)
Begin DoDot:2
+102 SET NWPORT=8446
+103 SET URL="https://vdenmihsdevd01"
+104 SET SSLCT=1
End DoDot:2
+105 ;
+106 ;Port
+107 IF NWPORT]""
SET BSTSWEB(9002318.2,WIEN_",",.03)=NWPORT
+108 ;
+109 ;URL
+110 IF URL]""
SET BSTSWEB(9002318.2,WIEN_",",.02)=URL
+111 ;
+112 ;Update the service patch
+113 SET BSTSWEB(9002318.2,WIEN_",",.11)="/soap"
+114 ;
+115 ;SSL/TLS Configuration
+116 SET SSL=$$GET1^DIQ(9002318.2,WIEN_",",2.01,"E")
+117 IF SSL=""
SET BSTSWEB(9002318.2,WIEN_",",2.01)=$SELECT(SSLCT:SSLNAME,1:"@")
+118 ;
+119 ;Username
+120 SET BSTSWEB(9002318.2,WIEN_",",.07)="DTSUser"
+121 ;
+122 ;Password
+123 SET BSTSWEB(9002318.2,WIEN_",",.08)="DTSPW!"
+124 ;
+125 ;Type
+126 SET BSTSWEB(9002318.2,WIEN_",",.04)="D"
+127 ;
+128 ;Update the entry
+129 DO FILE^DIE("","BSTSWEB","ERR")
End DoDot:1
+130 ;
+131 ;Set up BSTS SITE PARAMETERS entry
+132 ;
+133 IF '$ORDER(^BSTS(9002318,0))
Begin DoDot:1
+134 ;
+135 NEW DIC,DLAYGO,X,Y
+136 ;
+137 ;Set up the site parameter entry if necessary
+138 SET DIC(0)="LNZ"
SET DIC="^BSTS(9002318,"
SET DLAYGO=9002318
SET X=$PIECE($GET(^AUTTSITE(1,0)),U,1)
+139 IF X=""
SET X=$ORDER(^BGPSITE(0))
+140 IF X'=""
SET X=$PIECE(^DIC(4,X,0),U,1)
+141 DO ^DIC
End DoDot:1
+142 SET SIEN=$ORDER(^BSTS(9002318,0))
+143 ;
+144 ;Set up the Web Service entry if not found
+145 IF SIEN]""
Begin DoDot:1
+146 NEW DIC,DLAYGO,X,Y,DA
+147 IF $ORDER(^BSTS(9002318,SIEN,1,0))
QUIT
+148 IF WSIEN=""
QUIT
+149 SET DA(1)=SIEN
SET DIC(0)="XLNZ"
SET DIC="^BSTS(9002318,"_SIEN_",1,"
SET DLAYGO="9002318.01"
+150 SET X=WSIEN
+151 KILL DO,DD
DO FILE^DICN
End DoDot:1
+152 ;
+153 ;Update the Web Service entry
+154 IF SIEN]""
Begin DoDot:1
+155 NEW WIEN,DA,IENS,BSTSSITE,ERROR
+156 SET WIEN=$ORDER(^BSTS(9002318,SIEN,1,0))
IF '+WIEN
QUIT
+157 SET DA(1)=SIEN
SET DA=WIEN
SET IENS=$$IENS^DILF(.DA)
+158 ;Priority
SET BSTSSITE(9002318.01,IENS,.02)=1
+159 DO FILE^DIE("","BSTSSITE","ERROR")
End DoDot:1
+160 ;
+161 ;Display status to screen
+162 DO BMES^XPDUTL("Verifying connection to DTS server is working. This may take several minutes to complete ")
+163 ;
+164 ;Verify that the server connects, if not quit
+165 SET STS=""
FOR TR=1:1:20
Begin DoDot:1
+166 NEW VAR
+167 ;Reset DTS to on
DO RESET^BSTSWSV1
+168 ;Try quick call
SET STS=$$CODESETS^BSTSAPI("VAR")
+169 IF +STS'=2
HANG 1
End DoDot:1
IF +STS=2
QUIT
+170 ;
+171 ;Quit on failure
+172 IF (+STS'=2)
Begin DoDot:1
+173 ;
+174 ;Unlock installation entry
+175 LOCK -^TMP("BSTSINSTALL")
+176 ;
+177 ;Allow logins again
+178 NEW LIEN,LOG,ERR
+179 SET LIEN=$ORDER(^%ZIS(14.5,0))
IF '+LIEN
QUIT
+180 SET LOG(14.5,LIEN_",",1)="N"
+181 DO FILE^DIE("","LOG","ERR")
End DoDot:1
DO BMES^XPDUTL("DTS is not working properly. Please get the BSTS connection working and then re-install the build")
HANG 10
SET XPDABORT=1
GOTO XEN
+182 ;
+183 ;Pull the codeset versions
+184 FOR CDST=36,1552,32771,32772,32773,32774,32775,32777,32778,32779,32780
Begin DoDot:1
+185 FOR TR=1:1:60
Begin DoDot:2
+186 NEW VAR
+187 ;Reset DTS to on
DO RESET^BSTSWSV1
+188 SET STS=$$VERSIONS^BSTSAPI("VAR",CDST)
End DoDot:2
IF +STS=2
QUIT
End DoDot:1
+189 ;
+190 ;Unlock installation entry
+191 LOCK -^TMP("BSTSINSTALL")
+192 ;
+193 ;Kick off SNOMED update
+194 DO QUEUE^BSTSVOFL(36)
+195 ;
+196 ;Kick off RxNorm update
+197 DO QUEUE^BSTSVOFL("S1552")
+198 ;
+199 ;Kick off update to pull down SNOMED information
+200 ;Put it on the queue
DO QUEUE^BSTSVOFL(32777)
+201 ;
+202 ;Queue custom codesets
+203 DO QUEUE^BSTSVOFL(32771)
+204 DO QUEUE^BSTSVOFL(32772)
+205 DO QUEUE^BSTSVOFL(32773)
+206 DO QUEUE^BSTSVOFL(32774)
+207 DO QUEUE^BSTSVOFL(32775)
+208 ;
+209 ;Kick off now
DO JOBNOW^BSTSVOFL
+210 ;
XEN QUIT