BSTS10P1.m

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