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

BSTS10P2.m

Go to the documentation of this file. 
  1. BSTS10P2 ;GDIT/HS/BEE-Version 1.0 Patch 2 Post (and Pre) Install ; 19 Nov 2012  9:41 AM
  1.  ;;1.0;IHS STANDARD TERMINOLOGY;**2**;Sep 10, 2014;Build 59
  1.  ;
  1. ENV ;EP - Environmental Checking Routine
  1.  ;
  1.  ;Check for Version 1.0
  1.  I $$VERSION^XPDUTL("BSTS")<1 D BMES^XPDUTL("Version 1.0 of BSTS is required!") S XPDQUIT=2 Q
  1.  ;
  1.  ;Make sure a refresh is not running already
  1.  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
  1.  L -^BSTS(9002318.1,0)
  1.  ;
  1.  ;Make sure an ICD9 to SNOMED compile isn't running
  1.  L +^TMP("BSTSICD2SMD"):0 E  D BMES^XPDUTL("An ICD9 to SNOMED Background Compile is Running.  Please Try later") S XPDQUIT=2 Q
  1.  L -^TMP("BSTSICD2SMD")
  1.  ;
  1.  ;Make sure another install isn't running
  1.  L +^TMP("BSTSINSTALL"):3 E  D BMES^XPDUTL("A BSTS Install is Already Running") S XPDQUIT=2 Q
  1.  L -^TMP("BSTSINSTALL")
  1.  ;
  1.  Q
  1.  ;
  1. EN ;EP Patch 2 Post Install Front End
  1.  ;
  1.  ;Set up the site parameter entry
  1.  NEW DIC,DLAYGO,X,Y,TRIEN,EXEC,ERR,KIDS
  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.  ;
  1.  ;Update LAST SUBSET CHECK now so process won't keep getting called
  1.  D
  1.  . NEW BSTS,ERROR,NMIEN
  1.  . S NMIEN=$O(^BSTS(9002318.1,"B",36,"")) Q:NMIEN=""
  1.  . S BSTS(9002318.1,NMIEN_",",.06)=DT
  1.  . D FILE^DIE("","BSTS","ERROR")
  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.  K ERR
  1.  I $G(TRIEN)'="" D IMPORT^BSTSCLAS(TRIEN,.ERR)
  1.  ;
  1.  ;Unlock installation entry
  1.  L -^TMP("BSTSINSTALL")
  1.  ;
  1.  ;Display install message
  1.  D BMES^XPDUTL("Kicking off ICD9 to SNOMED and PROBLEM/FH conversion processes")
  1.  ;
  1.  S KIDS=1
  1. RESTART ;Perform version check - to see if DTS works with the possible new ports
  1.  ;Restart from here if check below fails
  1.  ;
  1.  NEW STS,VAR
  1.  S STS=$$VERSIONS^BSTSAPI("VAR",36)
  1.  I (+STS'=2)!$G(ERR) D  W !!,"DTS is not working properly. Please contact the BSTS Support Group - Aborting Installation" H 10 S XPDABORT=1 Q
  1.  . ;
  1.  . ;Quit if a restart
  1.  . Q:'$G(KIDS)
  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.  ;Kick off process to convert problems and family history
  1.  K ^XTMP("BSTSLCMP","QUIT")  ;Reset quit flag
  1.  D
  1.  . NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSK
  1.  . ;
  1.  . ;Perform version check - to see if DTS works with the possible new ports
  1.  . ;
  1.  . L +^TMP("BSTSPBFH"):0 E  Q   ;Already running
  1.  . L -^TMP("BSTSPBFH")
  1.  . ;
  1.  . ;Queue the process off in the background
  1.  . K IO("Q")
  1.  . ;
  1.  . S ZTRTN="PBFH^BSTS10P2",ZTDESC="BSTS - Convert Problems and Family History"
  1.  . S ZTIO=""
  1.  . S ZTDTH=$H
  1.  . D ^%ZTLOAD
  1.  ; 
  1.  ;Clear out the ICD9 to SNOMED JOB flag and kick off process
  1.  D
  1.  . NEW BSTSUPD,ERR,NMIEN
  1.  . ;
  1.  . ;Make sure we have a codeset (namespace)
  1.  . S NMIEN=$O(^BSTS(9002318.1,"B",36,"")) Q:NMIEN=""
  1.  . S BSTSUPD(9002318.1,NMIEN_",",.09)="@"
  1.  . D FILE^DIE("","BSTSUPD","ERR")
  1.  . Q:$D(ERR)
  1.  . ;
  1.  . ;Kick off the background process
  1.  . D PLOAD^BSTSUTIL(NMIEN)
  1.  ;
  1.  Q
  1.  ;
  1. PRE      ;Pre-Install Front End
  1.  ;
  1.  NEW DIU,WSIEN
  1.  ;
  1.  ;Perform Lock so only one install can run and DTS calls will be switched to local
  1.  L +^TMP("BSTSINSTALL"):3 E  W !!,"A BSTS Install is Already Running - Aborting Installation" H 10 S XPDABORT=1 Q
  1.  ;
  1.  ;Check Web Service entries - convert old ports to new ports
  1.  NEW WSIEN,APCDX,STS
  1.  ;
  1.  S WSIEN=0 F  S WSIEN=$O(^BSTS(9002318.2,WSIEN)) Q:'WSIEN  D
  1.  . NEW PORT,NWPORT,BSTSUPD,ERR
  1.  . ;
  1.  . ;Get the port - Quit it old DITDTS1 or Production port not found
  1.  . S PORT=$$GET1^DIQ(9002318.2,WSIEN_",",.03,"E") Q:PORT=""
  1.  . S NWPORT=PORT
  1.  . ;
  1.  . ;Production
  1.  . I (PORT=443)!(PORT=444)!(PORT=445) S NWPORT=42102
  1.  . ;
  1.  . ;DITDTS1
  1.  . I (PORT=8080)!(PORT=8081) S NWPORT=8082
  1.  . ;
  1.  . ;Update the service patch
  1.  . S BSTSUPD(9002318.2,WSIEN_",",.11)="/soap"
  1.  . ;
  1.  . ;Update the port
  1.  . I NWPORT'=PORT S BSTSUPD(9002318.2,WSIEN_",",.03)=NWPORT
  1.  . ;
  1.  . ;Update the entry
  1.  . D FILE^DIE("","BSTSUPD","ERR")
  1.  ;
  1.  ;Clear out existing entries
  1.  S DIU="^BSTS(9002318.1,",DIU(0)="DST" D EN^DIU2
  1.  S DIU="^BSTS(9002318.3,",DIU(0)="DST" D EN^DIU2
  1.  S DIU="^BSTS(9002318.4,",DIU(0)="DST" D EN^DIU2
  1.  S DIU="^BSTSCLS(",DIU(0)="DST" D EN^DIU2
  1.  Q
  1.  ;
  1. PBFH ;This section converts the problem and family history files to the new mappings
  1.  ;
  1.  NEW X1,X2,VAR,STS,X
  1.  ;
  1.  K ^XTMP("BSTSPBFH")
  1.  ;
  1.  ;Get a later date
  1.  S X1=DT,X2=60 D C^%DTC
  1.  S ^XTMP("BSTSPBFH")=X_U_DT_U_"Patch 2 problem/family history conversion started"
  1.  ;
  1.  ;Perform lock
  1.  L +^TMP("BSTSPBFH"):0 E  S $P(^XTMP("BSTSPBFH"),U,3)="Patch 2 problem/family history conversion already running" Q
  1.  ;
  1.  ;Perform version check - to see if DTS works with the possible new ports
  1.  S STS=$$VERSIONS^BSTSAPI("VAR",36)
  1.  I +STS'=2 D  G XPBFH
  1.  . S $P(^XTMP("BSTSPBFH"),U,3)="DTS not working - conversion failed"
  1.  ;
  1.  ;Adapted from Lori's APCDPLFH routine which will run on 10/1/15 and convert ICD9
  1.  ;entries to ICD10 entries in the problem and family history files.  Due to incorrect
  1.  ;mappings delivered with BSTS v1.0, problem and family history entries may have
  1.  ;incorrect ICD9 values.  This conversion will look at each file entry, pull the correct
  1.  ;ICD9 value from BSTS and use that instead.
  1.  ;
  1.  NEW APCDX
  1.  ;
  1.  ;Do not perform conversion if after 9/30/2015
  1.  I DT>3150930 S $P(^XTMP("BSTSPBFH"),U,3)="DT is after 3150930 - conversion aborted" G XPBFH
  1.  ;
  1.  S APCDX=0
  1.  F  S APCDX=$O(^AUPNPROB(APCDX)) Q:APCDX'=+APCDX  D  Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  . ;
  1.  . ;Update log entry
  1.  . S $P(^XTMP("BSTSPBFH"),U,3)="Converting problem entry: "_APCDX
  1.  . ;
  1.  . NEW APCDCI,APCDICDS,APCDO01,APCDOA,X,Y,APCDN01,APCDNA,APCDLOGE
  1.  . NEW APCDZ,APCDFNUM,APCDNODE,APCDY
  1.  . Q:'$D(^AUPNPROB(APCDX,0))
  1.  . S APCDCI=$P($G(^AUPNPROB(APCDX,800)),U)  ;only snomed coded problems
  1.  . Q:APCDCI=""
  1.  . S ^XTMP("BSTSPBFH","P",APCDX)=""  ;Log entry
  1.  . Q:$P(^AUPNPROB(APCDX,0),U,12)="D"  ;SKIP DELETED PROBLEMS
  1.  . S APCDICDS=$P($$CONC^BSTSAPI(APCDCI_"^^^1"),U,5)  ;ALL ICD CODES
  1.  . S APCDO01=$P(^AUPNPROB(APCDX,0),U,1)  ;old .01
  1.  . S APCDOA=""  ;old additional, ":" delimited
  1.  . S X=0 F  S X=$O(^AUPNPROB(APCDX,12,X)) Q:X'=+X  D
  1.  .. S Y=$P($G(^AUPNPROB(APCDX,12,X,0)),U)
  1.  .. Q:'Y
  1.  .. S Y=$P($$ICDDX^ICDCODE(Y),U,2)
  1.  .. S APCDOA=APCDOA_Y_":"
  1.  . ;update PROBLEM entry
  1.  . S APCDN01=$P(APCDICDS,";") S:APCDN01'["." APCDN01=APCDN01_"."
  1.  . I APCDN01="" S APCDN01=".9999"  ;Default to .9999 if no map
  1.  . S:APCDN01'["." APCDN01=APCDN01_"."
  1.  . S APCDN01=+$$CODEN^ICDCODE(APCDN01,80)
  1.  . I 'APCDN01 Q
  1.  . I APCDN01=-1 Q  ;Can't change it if it isn't in file 80
  1.  . S APCDNA=$P(APCDICDS,";",2,999)  ;new additional codes
  1.  . ;now set AUPNPROB
  1.  . K DIE,DA,DR S DA=APCDX,DR=".01////"_APCDN01,DIE="^AUPNPROB(" D ^DIE K DIE,DA,DR
  1.  . ;ADDITIONAL MULTIPLE
  1.  . ;DELETE OUT OLD ADDITIONAL MULTIPLE
  1.  . S APCDZ=0 F  S APCDZ=$O(^AUPNPROB(APCDX,12,APCDZ)) Q:APCDZ'=+APCDZ  D
  1.  .. NEW DIE,DA,DR
  1.  .. S DIE="^AUPNPROB("_APCDX_",12,",DA=APCDZ,DA(1)=APCDX,DR=".01///@" D ^DIE
  1.  . ;SET 12 NODES
  1.  . S APCDFNUM=9000011.12
  1.  . S APCDNODE=12
  1.  . F APCDZ=1:1 S APCDY=$P(APCDNA,";",APCDZ) Q:APCDY=""  D
  1.  .. NEW APCDP,APCDFDA,ERR
  1.  .. S:APCDY'["." APCDY=APCDY_"."
  1.  .. S APCDP=+$$CODEN^ICDCODE(APCDY,80)
  1.  ..Q:'APCDP
  1.  ..Q:APCDP=-1
  1.  ..S APCDFDA(APCDFNUM,"+2,"_APCDX_",",.01)=APCDP
  1.  ..D UPDATE^DIE("","APCDFDA","","ERR")
  1.  ;
  1. FH       ;
  1.  S APCDX=0
  1.  F  S APCDX=$O(^AUPNFH(APCDX)) Q:APCDX'=+APCDX  D  Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  . ;
  1.  . ;Update log entry
  1.  . S $P(^XTMP("BSTSPBFH"),U,3)="Converting family history entry: "_APCDX
  1.  . ;
  1.  . NEW APCDCI,APCDICDS,APCDO01,APCDOA,X,Y,APCDN01,APCDNA,APCDLOGE
  1.  . NEW APCDZ,APCDFNUM,APCDY
  1.  . Q:'$D(^AUPNFH(APCDX,0))
  1.  . S APCDCI=$P($G(^AUPNFH(APCDX,0)),U,13)  ;only snomed coded fh ENTRIES
  1.  . Q:APCDCI=""
  1.  . S ^XTMP("BSTSPBFH","F",APCDX)=""  ;Log entry
  1.  . S APCDICDS=$P($$CONC^BSTSAPI(APCDCI_"^^^1"),U,5)  ;ALL ICD CODES
  1.  . S APCDO01=$P(^AUPNFH(APCDX,0),U,1)
  1.  . S APCDOA=""
  1.  . S X=0 F  S X=$O(^AUPNFH(APCDX,11,X)) Q:X'=+X  D
  1.  .. S Y=$P($G(^AUPNFH(APCDX,11,X,0)),U)
  1.  .. Q:'Y
  1.  .. S Y=$P($$ICDDX^ICDCODE(Y),U,2)
  1.  .. S APCDOA=APCDOA_Y_":"
  1.  . ;update fh entry
  1.  . S APCDN01=$P(APCDICDS,";")
  1.  . I APCDN01="" S APCDN01=".9999"  ;Default to .9999 if no map
  1.  . S:APCDN01'["." APCDN01=APCDN01_"."
  1.  . S APCDN01=+$$CODEN^ICDCODE(APCDN01,80)
  1.  . I 'APCDN01 Q
  1.  . I APCDN01=-1 Q
  1.  . S APCDNA=$P(APCDICDS,";",2,999)
  1.  . ;now set AUPNFH
  1.  . K DIE,DA,DR S DA=APCDX,DR=".01////"_APCDN01,DIE="^AUPNFH(" D ^DIE K DIE,DA,DR
  1.  . S APCDZ=0 F  S APCDZ=$O(^AUPNFH(APCDX,11,APCDZ)) Q:APCDZ'=+APCDZ  D
  1.  .. S DIE="^AUPNFH("_APCDX_",11,",DA=APCDZ,DA(1)=APCDX,DR=".01///@" D ^DIE K DIE,DA,DR
  1.  . ;SET 11 NODES
  1.  . S APCDFNUM=9000014.11
  1.  . F APCDZ=1:1 S APCDY=$P(APCDNA,";",APCDZ) Q:APCDY=""  D
  1.  .. NEW APCDP,APCDFDA,ERR
  1.  .. S:APCDY'["." APCDY=APCDY_"."
  1.  .. S APCDP=+$$CODEN^ICDCODE(APCDY,80)
  1.  .. Q:'APCDP
  1.  .. Q:APCDP=-1
  1.  .. S APCDFDA(APCDFNUM,"+2,"_APCDX_",",.01)=APCDP
  1.  .. D UPDATE^DIE("","APCDFDA","","ERR")
  1.  ;
  1.  ;Update log entry
  1.  S $P(^XTMP("BSTSPBFH"),U,3)="Patch 2 problem/family history conversion completed"
  1.  ;
  1.  ;Remove lock
  1. XPBFH L -^TMP("BSTSPBFH")
  1.  ;
  1.  Q