BSTS10P1 ;GDIT/HS/BEE-Version 1.0 Patch 1 Post (and Pre) Install ; 19 Nov 2012 9:41 AM
;;1.0;IHS STANDARD TERMINOLOGY;**1**;Sep 10, 2014;Build 7
;
ENV ;EP - Environmental Checking Routine
;
;Check for Version 1.0
I $$VERSION^XPDUTL("BSTS")<1 D BMES^XPDUTL("Version 1.0 of BSTS is required!") S XPDQUIT=2 Q
;
;Make sure a refresh is not running already
L +^BSTS(9002318.1,0):0 E D BMES^XPDUTL("A Local BSTS Cache Refresh is Already Running. Please Try Later") S XPDQUIT=2 Q
L -^BSTS(9002318.1,0)
;
;Make sure an ICD9 to SNOMED compile isn't running
L +^TMP("BSTSICD2SMD"):0 E D BMES^XPDUTL("An ICD9 to SNOMED Background Compile is Running. Please Try later") S XPDQUIT=2 Q
L -^TMP("BSTSICD2SMD")
;
;Make sure another install isn't running
L +^TMP("BSTSINSTALL"):3 E D BMES^XPDUTL("A BSTS Install is Already Running") S XPDQUIT=2 Q
L -^TMP("BSTSINSTALL")
;
Q
;
EN ;EP - Patch 1 post installation process front end
;
;Adapted from Lori's APCDPLFH routine which will run on 10/1/15 and convert ICD9
;entries to ICD10 entries in the problem and family history files. Due to incorrect
;mappings delivered with BSTS v1.0, problem and family history entries may have
;incorrect ICD9 values. This conversion will look at each file entry, pull the correct
;ICD9 value from BSTS and use that instead.
;
NEW APCDX
;
;Do not perform conversion if after 9/30/2015
I DT>3150930 G EN1
;
S APCDX=0
F S APCDX=$O(^AUPNPROB(APCDX)) Q:APCDX'=+APCDX D
. NEW APCDCI,APCDICDS,APCDO01,APCDOA,X,Y,APCDN01,APCDNA,APCDLOGE
. NEW APCDZ,APCDFNUM,APCDNODE,APCDY
. Q:'$D(^AUPNPROB(APCDX,0))
. S APCDCI=$P($G(^AUPNPROB(APCDX,800)),U) ;only snomed coded problems
. Q:APCDCI=""
. Q:$P(^AUPNPROB(APCDX,0),U,12)="D" ;SKIP DELETED PROBLEMS
. S APCDICDS=$P($$CONC^BSTSAPI(APCDCI_"^^^1"),U,5) ;ALL ICD CODES
. S APCDO01=$P(^AUPNPROB(APCDX,0),U,1) ;old .01
. S APCDOA="" ;old additional, ":" delimited
. S X=0 F S X=$O(^AUPNPROB(APCDX,12,X)) Q:X'=+X D
.. S Y=$P($G(^AUPNPROB(APCDX,12,X,0)),U)
.. Q:'Y
.. S Y=$P($$ICDDX^ICDCODE(Y),U,2)
.. S APCDOA=APCDOA_Y_":"
. ;update PROBLEM entry
. S APCDN01=$P(APCDICDS,";")
. I APCDN01="" S APCDN01=".9999" ;Default to .9999 if no map
. S APCDN01=+$$CODEN^ICDCODE(APCDN01,80)
. I 'APCDN01 Q
. I APCDN01=-1 Q ;Can't change it if it isn't in file 80
. S APCDNA=$P(APCDICDS,";",2,999) ;new additional codes
. ;now set AUPNPROB
. K DIE,DA,DR S DA=APCDX,DR=".01////"_APCDN01,DIE="^AUPNPROB(" D ^DIE K DIE,DA,DR
. ;ADDITIONAL MULTIPLE
. ;DELETE OUT OLD ADDITIONAL MULTIPLE
. S APCDZ=0 F S APCDZ=$O(^AUPNPROB(APCDX,12,APCDZ)) Q:APCDZ'=+APCDZ D
.. NEW DIE,DA,DR
.. S DIE="^AUPNPROB("_APCDX_",12,",DA=APCDZ,DA(1)=APCDX,DR=".01///@" D ^DIE
. ;SET 12 NODES
. S APCDFNUM=9000011.12
. S APCDNODE=12
. F APCDZ=1:1 S APCDY=$P(APCDNA,";",APCDZ) Q:APCDY="" D
.. NEW APCDP,APCDFDA,ERR
.. S APCDP=+$$CODEN^ICDCODE(APCDY,80)
..Q:'APCDP
..Q:APCDP=-1
..S APCDFDA(APCDFNUM,"+2,"_APCDX_",",.01)=APCDP
..D UPDATE^DIE("","APCDFDA","","ERR")
;
FH ;
S APCDX=0
F S APCDX=$O(^AUPNFH(APCDX)) Q:APCDX'=+APCDX D
. NEW APCDCI,APCDICDS,APCDO01,APCDOA,X,Y,APCDN01,APCDNA,APCDLOGE
. NEW APCDZ,APCDFNUM,APCDY
. Q:'$D(^AUPNFH(APCDX,0))
. S APCDCI=$P($G(^AUPNFH(APCDX,0)),U,13) ;only snomed coded fh ENTRIES
. Q:APCDCI=""
. S APCDICDS=$P($$CONC^BSTSAPI(APCDCI_"^^^1"),U,5) ;ALL ICD CODES
. S APCDO01=$P(^AUPNFH(APCDX,0),U,1)
. S APCDOA=""
. S X=0 F S X=$O(^AUPNFH(APCDX,11,X)) Q:X'=+X D
.. S Y=$P($G(^AUPNFH(APCDX,11,X,0)),U)
.. Q:'Y
.. S Y=$P($$ICDDX^ICDCODE(Y),U,2)
.. S APCDOA=APCDOA_Y_":"
. ;update fh entry
. S APCDN01=$P(APCDICDS,";")
. I APCDN01="" S APCDN01=".9999" ;Default to .9999 if no map
. S APCDN01=+$$CODEN^ICDCODE(APCDN01,80)
. I 'APCDN01 Q
. I APCDN01=-1 Q
. S APCDNA=$P(APCDICDS,";",2,999)
. ;now set AUPNFH
. K DIE,DA,DR S DA=APCDX,DR=".01////"_APCDN01,DIE="^AUPNFH(" D ^DIE K DIE,DA,DR
. S APCDZ=0 F S APCDZ=$O(^AUPNFH(APCDX,11,APCDZ)) Q:APCDZ'=+APCDZ D
.. S DIE="^AUPNFH("_APCDX_",11,",DA=APCDZ,DA(1)=APCDX,DR=".01///@" D ^DIE K DIE,DA,DR
. ;SET 11 NODES
. S APCDFNUM=9000014.11
. F APCDZ=1:1 S APCDY=$P(APCDNA,";",APCDZ) Q:APCDY="" D
.. NEW APCDP,APCDFDA,ERR
.. S APCDP=+$$CODEN^ICDCODE(APCDY,80)
.. Q:'APCDP
.. Q:APCDP=-1
.. S APCDFDA(APCDFNUM,"+2,"_APCDX_",",.01)=APCDP
.. D UPDATE^DIE("","APCDFDA","","ERR")
;
;Unlock installation entry
EN1 L -^TMP("BSTSINSTALL")
;
;Clear out the ICD9 to SNOMED JOB flag and kick off process
D
. NEW BSTSUPD,ERR,NMIEN
. ;
. ;Make sure we have a codeset (namespace)
. S NMIEN=$O(^BSTS(9002318.1,"B",36,"")) Q:NMIEN=""
. S BSTSUPD(9002318.1,NMIEN_",",.09)="@"
. D FILE^DIE("","BSTSUPD","ERR")
. Q:$D(ERR)
. ;
. ;Kick off the background process
. D PLOAD^BSTSUTIL(NMIEN)
;
Q
;
PRE ;Pre-Install Front End
;
NEW DIU,WSIEN
;
;Perform Lock so only one install can run and DTS calls will be switched to local
L +^TMP("BSTSINSTALL"):3 E W !!,"A BSTS Install is Already Running - Aborting Installation" H 10 S XPDABORT=1 Q
;
;Check Web Service entries - convert old ports to new ports
NEW WSIEN,APCDX,STS
;
S WSIEN=0 F S WSIEN=$O(^BSTS(9002318.2,WSIEN)) Q:'WSIEN D
. NEW URL,PORT,NWPORT
. ;
. ;Get the port - Quit it old DITDTS1 or Production port not found
. S PORT=$$GET1^DIQ(9002318.2,WSIEN_",",.03,"E") Q:PORT=""
. I PORT'=443,PORT'=8080 Q
. S NWPORT=PORT
. ;
. ;Get URL - If Production or DITDTS1 change the port
. S URL=$$GET1^DIQ(9002318.2,WSIEN_",",.02,"E")
. I $$LOW^XLFSTR(URL)="https://dtsservices.ihs.gov" S NWPORT=444
. I $$LOW^XLFSTR(URL)="http://ditdts1" S NWPORT=8081
. ;
. ;Update the port
. I NWPORT'=PORT D
.. NEW BSTSUPD,ERR
.. S BSTSUPD(9002318.2,WSIEN_",",.03)=NWPORT
.. D FILE^DIE("","BSTSUPD","ERR")
;
;Perform version check - to see if DTS works with the possible new ports
S STS=$$VERSIONS^BSTSAPI("VAR",36)
I +STS'=2 D W !!,"DTS is not working properly. Please contact the BSTS Support Group - Aborting Installation" H 10 S XPDABORT=1 L -^TMP("BSTSINSTALL") Q
. ;
. ;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")
;
;Clear out existing entries
S DIU="^BSTS(9002318.1,",DIU(0)="DST" D EN^DIU2
S DIU="^BSTS(9002318.3,",DIU(0)="DST" D EN^DIU2
S DIU="^BSTS(9002318.4,",DIU(0)="DST" D EN^DIU2
Q
BSTS10P1 ;GDIT/HS/BEE-Version 1.0 Patch 1 Post (and Pre) Install ; 19 Nov 2012 9:41 AM
+1 ;;1.0;IHS STANDARD TERMINOLOGY;**1**;Sep 10, 2014;Build 7
+2 ;
ENV ;EP - Environmental Checking Routine
+1 ;
+2 ;Check for Version 1.0
+3 IF $$VERSION^XPDUTL("BSTS")<1
DO BMES^XPDUTL("Version 1.0 of BSTS is required!")
SET XPDQUIT=2
QUIT
+4 ;
+5 ;Make sure a refresh is not running already
+6 LOCK +^BSTS(9002318.1,0):0
IF '$TEST
DO BMES^XPDUTL("A Local BSTS Cache Refresh is Already Running. Please Try Later")
SET XPDQUIT=2
QUIT
+7 LOCK -^BSTS(9002318.1,0)
+8 ;
+9 ;Make sure an ICD9 to SNOMED compile isn't running
+10 LOCK +^TMP("BSTSICD2SMD"):0
IF '$TEST
DO BMES^XPDUTL("An ICD9 to SNOMED Background Compile is Running. Please Try later")
SET XPDQUIT=2
QUIT
+11 LOCK -^TMP("BSTSICD2SMD")
+12 ;
+13 ;Make sure another install isn't running
+14 LOCK +^TMP("BSTSINSTALL"):3
IF '$TEST
DO BMES^XPDUTL("A BSTS Install is Already Running")
SET XPDQUIT=2
QUIT
+15 LOCK -^TMP("BSTSINSTALL")
+16 ;
+17 QUIT
+18 ;
EN ;EP - Patch 1 post installation process front end
+1 ;
+2 ;Adapted from Lori's APCDPLFH routine which will run on 10/1/15 and convert ICD9
+3 ;entries to ICD10 entries in the problem and family history files. Due to incorrect
+4 ;mappings delivered with BSTS v1.0, problem and family history entries may have
+5 ;incorrect ICD9 values. This conversion will look at each file entry, pull the correct
+6 ;ICD9 value from BSTS and use that instead.
+7 ;
+8 NEW APCDX
+9 ;
+10 ;Do not perform conversion if after 9/30/2015
+11 IF DT>3150930
GOTO EN1
+12 ;
+13 SET APCDX=0
+14 FOR
SET APCDX=$ORDER(^AUPNPROB(APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:1
+15 NEW APCDCI,APCDICDS,APCDO01,APCDOA,X,Y,APCDN01,APCDNA,APCDLOGE
+16 NEW APCDZ,APCDFNUM,APCDNODE,APCDY
+17 IF '$DATA(^AUPNPROB(APCDX,0))
QUIT
+18 ;only snomed coded problems
SET APCDCI=$PIECE($GET(^AUPNPROB(APCDX,800)),U)
+19 IF APCDCI=""
QUIT
+20 ;SKIP DELETED PROBLEMS
IF $PIECE(^AUPNPROB(APCDX,0),U,12)="D"
QUIT
+21 ;ALL ICD CODES
SET APCDICDS=$PIECE($$CONC^BSTSAPI(APCDCI_"^^^1"),U,5)
+22 ;old .01
SET APCDO01=$PIECE(^AUPNPROB(APCDX,0),U,1)
+23 ;old additional, ":" delimited
SET APCDOA=""
+24 SET X=0
FOR
SET X=$ORDER(^AUPNPROB(APCDX,12,X))
IF X'=+X
QUIT
Begin DoDot:2
+25 SET Y=$PIECE($GET(^AUPNPROB(APCDX,12,X,0)),U)
+26 IF 'Y
QUIT
+27 SET Y=$PIECE($$ICDDX^ICDCODE(Y),U,2)
+28 SET APCDOA=APCDOA_Y_":"
End DoDot:2
+29 ;update PROBLEM entry
+30 SET APCDN01=$PIECE(APCDICDS,";")
+31 ;Default to .9999 if no map
IF APCDN01=""
SET APCDN01=".9999"
+32 SET APCDN01=+$$CODEN^ICDCODE(APCDN01,80)
+33 IF 'APCDN01
QUIT
+34 ;Can't change it if it isn't in file 80
IF APCDN01=-1
QUIT
+35 ;new additional codes
SET APCDNA=$PIECE(APCDICDS,";",2,999)
+36 ;now set AUPNPROB
+37 KILL DIE,DA,DR
SET DA=APCDX
SET DR=".01////"_APCDN01
SET DIE="^AUPNPROB("
DO ^DIE
KILL DIE,DA,DR
+38 ;ADDITIONAL MULTIPLE
+39 ;DELETE OUT OLD ADDITIONAL MULTIPLE
+40 SET APCDZ=0
FOR
SET APCDZ=$ORDER(^AUPNPROB(APCDX,12,APCDZ))
IF APCDZ'=+APCDZ
QUIT
Begin DoDot:2
+41 NEW DIE,DA,DR
+42 SET DIE="^AUPNPROB("_APCDX_",12,"
SET DA=APCDZ
SET DA(1)=APCDX
SET DR=".01///@"
DO ^DIE
End DoDot:2
+43 ;SET 12 NODES
+44 SET APCDFNUM=9000011.12
+45 SET APCDNODE=12
+46 FOR APCDZ=1:1
SET APCDY=$PIECE(APCDNA,";",APCDZ)
IF APCDY=""
QUIT
Begin DoDot:2
+47 NEW APCDP,APCDFDA,ERR
+48 SET APCDP=+$$CODEN^ICDCODE(APCDY,80)
+49 IF 'APCDP
QUIT
+50 IF APCDP=-1
QUIT
+51 SET APCDFDA(APCDFNUM,"+2,"_APCDX_",",.01)=APCDP
+52 DO UPDATE^DIE("","APCDFDA","","ERR")
End DoDot:2
End DoDot:1
+53 ;
FH ;
+1 SET APCDX=0
+2 FOR
SET APCDX=$ORDER(^AUPNFH(APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:1
+3 NEW APCDCI,APCDICDS,APCDO01,APCDOA,X,Y,APCDN01,APCDNA,APCDLOGE
+4 NEW APCDZ,APCDFNUM,APCDY
+5 IF '$DATA(^AUPNFH(APCDX,0))
QUIT
+6 ;only snomed coded fh ENTRIES
SET APCDCI=$PIECE($GET(^AUPNFH(APCDX,0)),U,13)
+7 IF APCDCI=""
QUIT
+8 ;ALL ICD CODES
SET APCDICDS=$PIECE($$CONC^BSTSAPI(APCDCI_"^^^1"),U,5)
+9 SET APCDO01=$PIECE(^AUPNFH(APCDX,0),U,1)
+10 SET APCDOA=""
+11 SET X=0
FOR
SET X=$ORDER(^AUPNFH(APCDX,11,X))
IF X'=+X
QUIT
Begin DoDot:2
+12 SET Y=$PIECE($GET(^AUPNFH(APCDX,11,X,0)),U)
+13 IF 'Y
QUIT
+14 SET Y=$PIECE($$ICDDX^ICDCODE(Y),U,2)
+15 SET APCDOA=APCDOA_Y_":"
End DoDot:2
+16 ;update fh entry
+17 SET APCDN01=$PIECE(APCDICDS,";")
+18 ;Default to .9999 if no map
IF APCDN01=""
SET APCDN01=".9999"
+19 SET APCDN01=+$$CODEN^ICDCODE(APCDN01,80)
+20 IF 'APCDN01
QUIT
+21 IF APCDN01=-1
QUIT
+22 SET APCDNA=$PIECE(APCDICDS,";",2,999)
+23 ;now set AUPNFH
+24 KILL DIE,DA,DR
SET DA=APCDX
SET DR=".01////"_APCDN01
SET DIE="^AUPNFH("
DO ^DIE
KILL DIE,DA,DR
+25 SET APCDZ=0
FOR
SET APCDZ=$ORDER(^AUPNFH(APCDX,11,APCDZ))
IF APCDZ'=+APCDZ
QUIT
Begin DoDot:2
+26 SET DIE="^AUPNFH("_APCDX_",11,"
SET DA=APCDZ
SET DA(1)=APCDX
SET DR=".01///@"
DO ^DIE
KILL DIE,DA,DR
End DoDot:2
+27 ;SET 11 NODES
+28 SET APCDFNUM=9000014.11
+29 FOR APCDZ=1:1
SET APCDY=$PIECE(APCDNA,";",APCDZ)
IF APCDY=""
QUIT
Begin DoDot:2
+30 NEW APCDP,APCDFDA,ERR
+31 SET APCDP=+$$CODEN^ICDCODE(APCDY,80)
+32 IF 'APCDP
QUIT
+33 IF APCDP=-1
QUIT
+34 SET APCDFDA(APCDFNUM,"+2,"_APCDX_",",.01)=APCDP
+35 DO UPDATE^DIE("","APCDFDA","","ERR")
End DoDot:2
End DoDot:1
+36 ;
+37 ;Unlock installation entry
EN1 LOCK -^TMP("BSTSINSTALL")
+1 ;
+2 ;Clear out the ICD9 to SNOMED JOB flag and kick off process
+3 Begin DoDot:1
+4 NEW BSTSUPD,ERR,NMIEN
+5 ;
+6 ;Make sure we have a codeset (namespace)
+7 SET NMIEN=$ORDER(^BSTS(9002318.1,"B",36,""))
IF NMIEN=""
QUIT
+8 SET BSTSUPD(9002318.1,NMIEN_",",.09)="@"
+9 DO FILE^DIE("","BSTSUPD","ERR")
+10 IF $DATA(ERR)
QUIT
+11 ;
+12 ;Kick off the background process
+13 DO PLOAD^BSTSUTIL(NMIEN)
End DoDot:1
+14 ;
+15 QUIT
+16 ;
PRE ;Pre-Install Front End
+1 ;
+2 NEW DIU,WSIEN
+3 ;
+4 ;Perform Lock so only one install can run and DTS calls will be switched to local
+5 LOCK +^TMP("BSTSINSTALL"):3
IF '$TEST
WRITE !!,"A BSTS Install is Already Running - Aborting Installation"
HANG 10
SET XPDABORT=1
QUIT
+6 ;
+7 ;Check Web Service entries - convert old ports to new ports
+8 NEW WSIEN,APCDX,STS
+9 ;
+10 SET WSIEN=0
FOR
SET WSIEN=$ORDER(^BSTS(9002318.2,WSIEN))
IF 'WSIEN
QUIT
Begin DoDot:1
+11 NEW URL,PORT,NWPORT
+12 ;
+13 ;Get the port - Quit it old DITDTS1 or Production port not found
+14 SET PORT=$$GET1^DIQ(9002318.2,WSIEN_",",.03,"E")
IF PORT=""
QUIT
+15 IF PORT'=443
IF PORT'=8080
QUIT
+16 SET NWPORT=PORT
+17 ;
+18 ;Get URL - If Production or DITDTS1 change the port
+19 SET URL=$$GET1^DIQ(9002318.2,WSIEN_",",.02,"E")
+20 IF $$LOW^XLFSTR(URL)="https://dtsservices.ihs.gov"
SET NWPORT=444
+21 IF $$LOW^XLFSTR(URL)="http://ditdts1"
SET NWPORT=8081
+22 ;
+23 ;Update the port
+24 IF NWPORT'=PORT
Begin DoDot:2
+25 NEW BSTSUPD,ERR
+26 SET BSTSUPD(9002318.2,WSIEN_",",.03)=NWPORT
+27 DO FILE^DIE("","BSTSUPD","ERR")
End DoDot:2
End DoDot:1
+28 ;
+29 ;Perform version check - to see if DTS works with the possible new ports
+30 SET STS=$$VERSIONS^BSTSAPI("VAR",36)
+31 IF +STS'=2
Begin DoDot:1
+32 ;
+33 ;Allow logins again
+34 NEW LIEN,LOG,ERR
+35 SET LIEN=$ORDER(^%ZIS(14.5,0))
IF '+LIEN
QUIT
+36 SET LOG(14.5,LIEN_",",1)="N"
+37 DO FILE^DIE("","LOG","ERR")
End DoDot:1
WRITE !!,"DTS is not working properly. Please contact the BSTS Support Group - Aborting Installation"
HANG 10
SET XPDABORT=1
LOCK -^TMP("BSTSINSTALL")
QUIT
+38 ;
+39 ;Clear out existing entries
+40 SET DIU="^BSTS(9002318.1,"
SET DIU(0)="DST"
DO EN^DIU2
+41 SET DIU="^BSTS(9002318.3,"
SET DIU(0)="DST"
DO EN^DIU2
+42 SET DIU="^BSTS(9002318.4,"
SET DIU(0)="DST"
DO EN^DIU2
+43 QUIT
