Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BSTS2PST

BSTS2PST.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EN ;Post Install Front End
  1.  ;
  1.  NEW TRIEN,EXEC,ERR,WIEN,WSIEN,PATCH,SIEN,STS,TR,CDST
  1.  NEW SSLNAME,SSLFND,SYSXREF,SYSGL
  1.  ;
  1.  ;Load the classes
  1.  ;
  1.  ;For each build, set this to the 9002318.5 entry to load
  1.  S TRIEN=1
  1.  ;
  1.  ;Delete existing BSTS Classes
  1.  S EXEC="DO $SYSTEM.OBJ.DeletePackage(""BSTS"")" X EXEC
  1.  ;
  1.  ; Import BSTS classes
  1.  ;
  1.  K ERR
  1.  I $G(TRIEN)'="" D IMPORT^BSTSCLAS(TRIEN,.ERR)
  1.  ;
  1.  ;Make sure a SSL entry is defined
  1.  ;
  1.  ;Look for an SSL server
  1.  S SYSXREF="^[""%SYS""]SYS",SYSGL=$NA(@SYSXREF)
  1.  S (SSLFND,SSLNAME)="" F  S SSLNAME=$O(@SYSGL@("Security","SSLConfigsD",SSLNAME)) Q:SSLNAME=""  D  Q:SSLFND]""
  1.  . NEW UPNAME
  1.  . S UPNAME=$$UP^XLFSTR(SSLNAME)
  1.  . I UPNAME["SNOMED" S SSLFND=SSLNAME
  1.  ;
  1.  ;Modify existing entry
  1.  I SSLFND]"" D
  1.  . NEW EXEC,SOBJ,STS,ONAMESPC
  1.  . S EXEC="S ONAMESPC=$"_"ZNSPACE" X EXEC
  1.  . S EXEC="ZN ""%SYS""" X EXEC
  1.  . S SSLNAME=""
  1.  . S EXEC="S SOBJ=##CLASS(Security.SSLConfigs).%OpenId("""_SSLFND_""")" X EXEC
  1.  . S EXEC="S SOBJ.CipherList=""TLSv1:!ADH:!LOW:!EXP:@STRENGTH""" X EXEC
  1.  . S EXEC="S SOBJ.PrivateKeyType=2" X EXEC
  1.  . S EXEC="S SOBJ.Protocols=4" X EXEC
  1.  . S EXEC="S SOBJ.Type=0" X EXEC
  1.  . S EXEC="S SOBJ.VerifyDepth=9" X EXEC
  1.  . S EXEC="S SOBJ.VerifyPeer=0" X EXEC
  1.  . S EXEC="S SOBJ.Enabled=1" X EXEC
  1.  . S EXEC="S SSLNAME=SOBJ.Name" X EXEC
  1.  . S EXEC="S STS=SOBJ.%Save()" X EXEC
  1.  . S EXEC="ZN ONAMESPC" X EXEC
  1.  ;
  1.  ;If no entry, create one
  1.  I SSLFND="" D
  1.  . NEW EXEC,SOBJ,STS,ONAMESPC
  1.  . S EXEC="S ONAMESPC=$"_"ZNSPACE" X EXEC
  1.  . S EXEC="ZN ""%SYS""" X EXEC
  1.  . S EXEC="S SOBJ=##CLASS(Security.SSLConfigs).%New()" X EXEC
  1.  . S EXEC="S SOBJ.Description=""SNOMED Terminology Server""" X EXEC
  1.  . S EXEC="S SOBJ.Name=""SNOMEDServer""" X EXEC
  1.  . S EXEC="S SOBJ.CipherList=""TLSv1:!ADH:!LOW:!EXP:@STRENGTH""" X EXEC
  1.  . S EXEC="S SOBJ.PrivateKeyType=2" X EXEC
  1.  . S EXEC="S SOBJ.Protocols=4" X EXEC
  1.  . S EXEC="S SOBJ.Type=0" X EXEC
  1.  . S EXEC="S SOBJ.VerifyDepth=9" X EXEC
  1.  . S EXEC="S SOBJ.VerifyPeer=0" X EXEC
  1.  . S EXEC="S SOBJ.Enabled=1" X EXEC
  1.  . S EXEC="S STS=SOBJ.%Save()" X EXEC
  1.  . S SSLNAME="SNOMEDServer"
  1.  . S EXEC="ZN ONAMESPC" X EXEC
  1.  ;
  1.  ;Set up BSTS WEB SERVICE ENDPOINT entry
  1.  ;
  1.  ;Make sure an entry is defined
  1.  I '$O(^BSTS(9002318.2,0)) D
  1.  . ;
  1.  . NEW DIC,DLAYGO,X,Y
  1.  . ;
  1.  . S DIC(0)="LNZ",DIC="^BSTS(9002318.2,",DLAYGO=9002318.2,X="PRODUCTION"
  1.  . D ^DIC
  1.  ;
  1.  ;Loop through entries and update
  1.  S WSIEN="",WIEN=0 F  S WIEN=$O(^BSTS(9002318.2,WIEN)) Q:'WIEN  D
  1.  . ;
  1.  . NEW PORT,NAME,NWPORT,BSTSWEB,URL,SSL,SSLCT
  1.  . ;
  1.  . S NAME=$$GET1^DIQ(9002318.2,WIEN_",",.01,"E")
  1.  . S (URL,NWPORT)=""
  1.  . ;
  1.  . ;Production
  1.  . S (SSLCT,NWPORT)="",PORT=$$GET1^DIQ(9002318.2,WIEN_",",.03,"E")
  1.  . I ((PORT="")&(NAME="PRODUCTION"))!(PORT=443)!(PORT=444)!(PORT=445)!(PORT=42102)!(PORT=44200) D
  1.  .. S NWPORT=44200
  1.  .. S URL="https://dtsservices.ihs.gov"
  1.  .. S WSIEN=WIEN,SSLCT=1
  1.  . ;
  1.  . ;Test Production
  1.  . I (PORT=42100)!(PORT=44299) D
  1.  .. S NWPORT=44299
  1.  .. S URL="https://dtsservices.ihs.gov"
  1.  .. S SSLCT=1
  1.  . ;
  1.  . ;DITDTS1
  1.  . I (PORT=8080)!(PORT=8081)!(PORT=8082)!(PORT=8083) D
  1.  .. S NWPORT=8083
  1.  .. S URL="http://ditdts1"
  1.  . ;
  1.  . ;GDIT DTS 4.4 Server
  1.  . I (PORT=8445)!(PORT=8446) D
  1.  .. S NWPORT=8446
  1.  .. S URL="https://vdenmihsdevd01"
  1.  .. S SSLCT=1
  1.  . ;
  1.  . ;Port
  1.  . I NWPORT]"" S BSTSWEB(9002318.2,WIEN_",",.03)=NWPORT
  1.  . ;
  1.  . ;URL
  1.  . I URL]"" S BSTSWEB(9002318.2,WIEN_",",.02)=URL
  1.  . ;
  1.  . ;Update the service patch
  1.  . S BSTSWEB(9002318.2,WIEN_",",.11)="/soap"
  1.  . ;
  1.  . ;SSL/TLS Configuration
  1.  . S SSL=$$GET1^DIQ(9002318.2,WIEN_",",2.01,"E")
  1.  . I SSL="" S BSTSWEB(9002318.2,WIEN_",",2.01)=$S(SSLCT:SSLNAME,1:"@")
  1.  . ;
  1.  . ;Username
  1.  . S BSTSWEB(9002318.2,WIEN_",",.07)="DTSUser"
  1.  . ;
  1.  . ;Password
  1.  . S BSTSWEB(9002318.2,WIEN_",",.08)="DTSPW!"
  1.  . ;
  1.  . ;Type
  1.  . S BSTSWEB(9002318.2,WIEN_",",.04)="D"
  1.  . ;
  1.  . ;Update the entry
  1.  . D FILE^DIE("","BSTSWEB","ERR")
  1.  ;
  1.  ;Set up BSTS SITE PARAMETERS entry
  1.  ;
  1.  I '$O(^BSTS(9002318,0)) D
  1.  . ;
  1.  . NEW DIC,DLAYGO,X,Y
  1.  . ;
  1.  . ;Set up the site parameter entry if necessary
  1.  . S DIC(0)="LNZ",DIC="^BSTS(9002318,",DLAYGO=9002318,X=$P($G(^AUTTSITE(1,0)),U,1)
  1.  . I X="" S X=$O(^BGPSITE(0))
  1.  . I X'="" S X=$P(^DIC(4,X,0),U,1)
  1.  . D ^DIC
  1.  S SIEN=$O(^BSTS(9002318,0))
  1.  ;
  1.  ;Set up the Web Service entry if not found
  1.  I SIEN]"" D
  1.  . NEW DIC,DLAYGO,X,Y,DA
  1.  . I $O(^BSTS(9002318,SIEN,1,0)) Q
  1.  . I WSIEN="" Q
  1.  . S DA(1)=SIEN,DIC(0)="XLNZ",DIC="^BSTS(9002318,"_SIEN_",1,",DLAYGO="9002318.01"
  1.  . S X=WSIEN
  1.  . K DO,DD D FILE^DICN
  1.  ;
  1.  ;Update the Web Service entry
  1.  I SIEN]"" D
  1.  . NEW WIEN,DA,IENS,BSTSSITE,ERROR
  1.  . S WIEN=$O(^BSTS(9002318,SIEN,1,0)) Q:'+WIEN
  1.  . S DA(1)=SIEN,DA=WIEN,IENS=$$IENS^DILF(.DA)
  1.  . S BSTSSITE(9002318.01,IENS,.02)=1  ;Priority
  1.  . D FILE^DIE("","BSTSSITE","ERROR")
  1.  ;
  1.  ;Display status to screen
  1.  D BMES^XPDUTL("Verifying connection to DTS server is working. This may take several minutes to complete ")
  1.  ;
  1.  ;Verify that the server connects, if not quit
  1.  S STS="" F TR=1:1:20 D  I +STS=2 Q
  1.  . NEW VAR
  1.  . D RESET^BSTSWSV1  ;Reset DTS to on
  1.  . S STS=$$CODESETS^BSTSAPI("VAR") ;Try quick call
  1.  . I +STS'=2 H 1
  1.  ;
  1.  ;Quit on failure
  1.  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
  1.  . ;
  1.  . ;Unlock installation entry
  1.  . L -^TMP("BSTSINSTALL")
  1.  . ;
  1.  . ;Allow logins again
  1.  . NEW LIEN,LOG,ERR
  1.  . S LIEN=$O(^%ZIS(14.5,0)) Q:'+LIEN
  1.  . S LOG(14.5,LIEN_",",1)="N"
  1.  . D FILE^DIE("","LOG","ERR")
  1.  ;
  1.  ;Pull the codeset versions
  1.  F CDST=36,1552,32771,32772,32773,32774,32775,32777,32778,32779,32780 D
  1.  . F TR=1:1:60 D  I +STS=2 Q
  1.  .. NEW VAR
  1.  .. D RESET^BSTSWSV1  ;Reset DTS to on
  1.  .. S STS=$$VERSIONS^BSTSAPI("VAR",CDST)
  1.  ;
  1.  ;Unlock installation entry
  1.  L -^TMP("BSTSINSTALL")
  1.  ;
  1.  ;Kick off SNOMED update
  1.  D QUEUE^BSTSVOFL(36)
  1.  ;
  1.  ;Kick off RxNorm update
  1.  D QUEUE^BSTSVOFL("S1552")
  1.  ;
  1.  ;Kick off update to pull down SNOMED information
  1.  D QUEUE^BSTSVOFL(32777) ;Put it on the queue
  1.  ;
  1.  ;Queue custom codesets
  1.  D QUEUE^BSTSVOFL(32771)
  1.  D QUEUE^BSTSVOFL(32772)
  1.  D QUEUE^BSTSVOFL(32773)
  1.  D QUEUE^BSTSVOFL(32774)
  1.  D QUEUE^BSTSVOFL(32775)
  1.  ;
  1.  D JOBNOW^BSTSVOFL  ;Kick off now
  1.  ;
  1. XEN Q