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

BSTSCFIX.m

Go to the documentation of this file. 
  1. BSTSCFIX ;GDIT/HS/BEE-Utility to fix duplicate terms in files ; 5 Nov 2012  9:53 AM
  1.  ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
  1.  ;
  1. EN ;EP - Main entry point
  1.  ;
  1.  NEW DIR,X,Y,FIX,CT,BST
  1.  ;
  1.  W !!
  1.  S BST(1)="This utility will loop through files that contain SNOMED description ids and"
  1.  S BST(2)="will check to make sure a term can be found for that description id.  If a"
  1.  S BST(3)="term cannot be found, it attempts to look in DTS for an exact match.  For each"
  1.  S BST(4)="match that is found the entry gets replaced with the new entry."
  1.  D EN^DDIOL(.BST)
  1.  K BST
  1.  ;
  1.  S DIR(0)="S^C:Check for Missing Concept Detail;R:Run Background Process to Fix Bad Entries;Q:Quit"
  1.  D ^DIR
  1.  ;
  1.  ;Handle Quits
  1.  I Y'="C",Y'="R" G XEN
  1.  ;
  1.  ;Check call
  1.  I Y="C" S FIX=$$CHECK() S Y=$S(FIX:"R",1:"")
  1.  ;
  1.  ;Fix call
  1.  I Y="R" D FIX G XEN
  1.  ;
  1. XEN Q
  1.  ;
  1. CHECK() ;Look for bad entries
  1.  ;
  1.  L +^XTMP("BSTSCFIX"):0 E  D  Q 0  ;Already running
  1.  . NEW RUN
  1.  . W !!,"A background fix process is running. Please try again later"
  1.  . S RUN=$G(^XTMP("BSTSCFIX","RUN")) Q:'+RUN
  1.  . W !,"Current Status: ",$G(^XTMP("BSTSCFIX",RUN,"STS"))
  1.  . H 3
  1.  L -^XTMP("BSTSCFIX")
  1.  ;
  1.  NEW IEN,FIX,DIR,X,Y,STS,VAR
  1.  ;
  1.  W !!,"This option loops through the PROBLEM, PROVIDER NARRATIVE, FAMILY HISTORY"
  1.  W !,"and V POV files and locates concepts with no detail associated with them.",!
  1.  ;
  1.  S DIR("A")="Are you sure you wish to proceed? "
  1.  S DIR(0)="Y",DIR("B")="No"
  1.  D ^DIR
  1.  I Y'=1 Q 0
  1.  ;
  1.  ;Make sure DTS is working
  1.  S STS=$$SEARCH^BSTSAPI("VAR","COMMON COLD^F")
  1.  I +STS'=2 D  Q 0
  1.  . W !!,"BSTS is set to local. It must be running properly in order to run this option"
  1.  . W !,"Please run the STS option in the BSTSMENU to troubleshoot the BSTS connection"
  1.  . H 3
  1.  ;
  1.  ;Reset flag
  1.  S FIX=0
  1.  ;
  1.  ;First look in problem file
  1.  W !!,"Reviewing PROBLEM file entries: "
  1.  W !,"Problem IEN",?20,"Patient",?60,"Description Id"
  1.  S IEN=0 F  S IEN=$O(^AUPNPROB(IEN)) Q:'IEN  D
  1.  . NEW DSCID,DESC,DFN
  1.  . ;
  1.  . ;Ignore deleted problems
  1.  . I $$GET1^DIQ(9000011,IEN_",",2.02,"I")]"" Q
  1.  . ;
  1.  . S DSCID=$P($G(^AUPNPROB(IEN,800)),U,2) Q:DSCID=""
  1.  . D RESET^BSTSWSV1 ;Make sure the link is on
  1.  . S DESC=$$DESC^BSTSAPI(DSCID)
  1.  . ;
  1.  . ;Skip if description found
  1.  . I $TR(DESC,"^")]"" Q
  1.  . ;
  1.  . S FIX=1
  1.  . S DFN=$P($G(^AUPNPROB(IEN,0)),U,2)
  1.  . W !,IEN,?20,$P($G(^DPT(DFN,0)),U),?60,DSCID
  1.  ;
  1.  ;Check PROVIDER NARRATIVE file
  1.  W !!,"Reviewing PROVIDER NARRATIVE entries: "
  1.  W !,"IEN",?60,"Description Id"
  1.  S IEN=0 F  S IEN=$O(^AUTNPOV(IEN)) Q:'IEN  D
  1.  . NEW NARR,DSCID,DESC
  1.  . ;
  1.  . ;Get the Description ID from the Narrative - Quit if not converted to SNOMED
  1.  . S NARR=$$GET1^DIQ(9999999.27,IEN_",",.01,"I")
  1.  . S DSCID=$P(NARR,"|",2) I +DSCID=0 Q
  1.  . D RESET^BSTSWSV1 ;Make sure the link is on
  1.  . S DESC=$$DESC^BSTSAPI(DSCID)
  1.  . ;
  1.  . ;Skip if description found
  1.  . I $TR(DESC,"^")]"" Q
  1.  . ;
  1.  . S FIX=1
  1.  . W !,IEN,?60,DSCID
  1.  ;
  1.  ;Check V POV file
  1.  W !!,"Reviewing V POV entries: "
  1.  W !,"VPOV IEN",?15,"Patient",?42,"Visit",?60,"Description Id"
  1.  S IEN=0 F  S IEN=$O(^AUPNVPOV(IEN)) Q:'IEN  D
  1.  . NEW DSCID,DESCID,DFN
  1.  . ;
  1.  . ;Get the Description ID - Quit if not converted to SNOMED
  1.  . S DSCID=$$GET1^DIQ(9000010.07,IEN_",",1102,"I") I +DSCID=0 Q
  1.  . D RESET^BSTSWSV1 ;Make sure the link is on
  1.  . S DESC=$$DESC^BSTSAPI(DSCID)
  1.  . ;
  1.  . ;Skip if description found
  1.  . I $TR(DESC,"^")]"" Q
  1.  . ;
  1.  . S FIX=1
  1.  . S DFN=$P($G(^AUPNVPOV(IEN,0)),U,2)
  1.  . W !,IEN,?15,$E($P($G(^DPT(DFN,0)),U),1,23),?41,$E($$GET1^DIQ(9000010.07,IEN_",",".03","E"),1,17),?60,DSCID
  1.  ;
  1.  ;Check FAMILY HISTORY
  1.  W !!,"Reviewing FAMILY HISTORY entries: "
  1.  W !,"IEN",?15,"Patient",?60,"Description Id"
  1.  S IEN=0 F  S IEN=$O(^AUPNFH(IEN)) Q:'IEN  D
  1.  . NEW DSCID,DESC,DFN
  1.  . ;
  1.  . ;Get the Description ID - Quit if not converted to SNOMED
  1.  . S DSCID=$$GET1^DIQ(9000014,IEN_",",.14,"I") I +DSCID=0 Q
  1.  . D RESET^BSTSWSV1 ;Make sure the link is on
  1.  . S DESC=$$DESC^BSTSAPI(DSCID)
  1.  . ;
  1.  . ;Skip if description found
  1.  . I $TR(DESC,"^")]"" Q
  1.  . ;
  1.  . S FIX=1
  1.  . S DFN=$P($G(^AUPNFH(IEN,0)),U,2)
  1.  . W !,IEN,?15,$P($G(^DPT(DFN,0)),U),?60,DSCID
  1.  ;
  1.  ;If issues, check if they want to run the fix
  1.  I FIX=0 D  Q 0
  1.  . W !!,"No issues were encountered.  There is no need to run the fix option."
  1.  . H 3
  1.  ;
  1.  W !!,"Concepts without detail were encountered",!
  1.  S DIR("A")="Would you like to job off the fix option now? "
  1.  S DIR(0)="Y",DIR("B")="No"
  1.  D ^DIR
  1.  I Y'=1 S FIX=0
  1.  ;
  1.  Q FIX
  1.  ;
  1. FIX ;Kick off background fix process
  1.  ;
  1.  L +^XTMP("BSTSCFIX"):0 E  D  Q   ;Already running
  1.  . NEW RUN
  1.  . W !!,"A background fix process is running. Please try again later"
  1.  . S RUN=$G(^XTMP("BSTSCFIX","RUN")) Q:'+RUN
  1.  . W !,"Current Status: ",$G(^XTMP("BSTSCFIX",RUN,"STS"))
  1.  . H 3
  1.  L -^XTMP("BSTSCFIX")
  1.  ;
  1.  NEW DIR,X,Y,VAR,STS
  1.  ;
  1.  ;Make sure DTS is working
  1.  D RESET^BSTSWSV1
  1.  S STS=$$SEARCH^BSTSAPI("VAR","COMMON COLD^F")
  1.  I +STS'=2 D  Q
  1.  . W !!,"BSTS is set to local. It must be running properly in order to run this option"
  1.  . W !,"Please run the STS option in the BSTSMENU to troubleshoot the BSTS connection"
  1.  . H 3
  1.  ;
  1.  W !!,"This option kicks off a background process which will attempt to fix concepts"
  1.  W !,"with no detail associated with them.",!
  1.  ;
  1.  S DIR("A")="Are you sure you wish to proceed? "
  1.  S DIR(0)="Y",DIR("B")="No"
  1.  D ^DIR
  1.  I Y'=1 Q
  1.  ;
  1. FIX1 ;Kick off process to convert invalid description ids to valid description ids
  1.  NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSK
  1.  ;
  1.  ;Queue the process off in the background
  1.  K IO("Q")
  1.  ;
  1.  S ZTRTN="START^BSTSCFIX",ZTDESC="BSTS - Replace invalid description ids with valid ones"
  1.  S ZTIO=""
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,2)
  1.  D ^%ZTLOAD
  1.  ;
  1.  Q
  1.  ;
  1. START ;Called by background job
  1.  ;
  1.  ;Lock so only one process can run at a time
  1.  L +^XTMP("BSTSCFIX"):0 E  Q   ;Already running
  1.  ;
  1.  NEW BSTSSRV,PRI,STS,II,DEBUG,X1,X2,X,RUN,%,%H,%I
  1.  ;
  1.  ;Get date
  1.  I $G(DT)="" D DT^DICRW
  1.  ;
  1.  ;Define DEBUG
  1.  S DEBUG=""
  1.  ;
  1.  ;Get a later date
  1.  D NOW^%DTC
  1.  S X1=DT,X2=120 D C^%DTC
  1.  ;
  1.  ;Initialize ^XTMP entry
  1.  K ^XTMP("BSTSCFIX","QUIT")
  1.  S $P(^XTMP("BSTSCFIX",0),U)=X  ;Set date in the future
  1.  S $P(^XTMP("BSTSCFIX",0),U,2)=DT  ;Set current date
  1.  S $P(^XTMP("BSTSCFIX",0),U,3)="Results of BSTSCFIX conversion"
  1.  S (RUN,^XTMP("BSTSCFIX","RUN"))=$G(^XTMP("BSTSCFIX","RUN"))+1  ;Increment Run counter
  1.  S ^XTMP("BSTSCFIX",RUN,0)=%_U_$G(DUZ)
  1.  K ^XTMP("BSTSCFIX","MAP")  ;Reset mappings
  1.  K ^XTMP("BSTSCFIX","QUIT")
  1.  ;
  1.  ;Get a list of the servers available
  1.  S STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)
  1.  ;
  1.  ;Loop through server list and perform conversion on the first active one
  1.  ;
  1.  ;Check for active server
  1.  I $D(BSTSSRV)<10 D STS(RUN,"STS","No Active Server Found") Q
  1.  ;
  1.  ;Loop through each until a good one is found
  1.  I $D(BSTSSRV)>1 S STS=0,PRI="" F II=2:1 S PRI=$O(BSTSSRV(PRI)) Q:PRI=""  D  Q:+STS
  1.  . ;
  1.  . NEW BSTSWS,TYPE,TIME,CSTS,SRV
  1.  . M BSTSWS=BSTSSRV(PRI)
  1.  . S TYPE=$G(BSTSWS("TYPE")),CSTS=""
  1.  . S SRV="SRV"_(II-1)
  1.  . ;
  1.  . ;Check if DTS server is set to local
  1.  . S STS=$$CKDTS^BSTSWSV1(.BSTSWS) I '+STS D STS(RUN,SRV,$G(BSTSWS("URLROOT"))_": Set to Local") Q
  1.  . ;
  1.  . ;Perform conversion using specified server
  1.  . D STS(RUN,SRV,$G(BSTSWS("URLROOT")))
  1.  . I TYPE="D" S STS=$$DSC(.BSTSWS,RUN)
  1.  ;
  1.  ;Mark as completed
  1.  I +STS D STS(RUN,"STS","Process Completed")
  1.  L -^XTMP("BSTSCFIX")
  1.  Q
  1.  ;
  1. DSC(BSTSWS,RUN) ;Loop through files and replace bad entries
  1.  ;
  1.  NEW SNAPDT,IEN,DSCID,REMAPTO,STS
  1.  ;
  1.  ;Set up remaining array entries needed by DTS call
  1.  S SNAPDT=$$DTCHG^BSTSUTIL(DT,2)_".0001"
  1.  S SNAPDT=$$FMTE^BSTSUTIL(SNAPDT)
  1.  S BSTSWS("STYPE")="F"
  1.  S BSTSWS("NAMESPACEID")=36
  1.  S BSTSWS("SUBSET")=""
  1.  S BSTSWS("SNAPDT")=SNAPDT
  1.  S BSTSWS("MAXRECS")=100
  1.  S BSTSWS("BCTCHRC")=""
  1.  S BSTSWS("BCTCHCT")=""
  1.  S BSTSWS("RET")="PSCBIXAV"
  1.  S BSTSWS("DAT")=""
  1.  S BSTSWS("TBYPASS")=""
  1.  ;
  1.  ;Check PROBLEM file
  1.  S STS=1,IEN=0 F  S IEN=$O(^AUPNPROB(IEN)) Q:'IEN  D  I $D(^XTMP("BSTSCFIX","QUIT")) D STS(RUN,"STS","Process Aborted") S STS=0 Q
  1.  . D STS(RUN,"STS","Checking PROBLEM file entry: "_IEN)
  1.  . NEW DSCID,MAPTO,BSTSUPD,ERROR
  1.  . ;
  1.  . ;Ignore deleted problems
  1.  . I $$GET1^DIQ(9000011,IEN_",",2.02,"I")]"" Q
  1.  . ;
  1.  . ;Get the Description ID - Quit if not converted to SNOMED
  1.  . S DSCID=$$GET1^DIQ(9000011,IEN_",",80002,"I") Q:DSCID=""
  1.  . ;
  1.  . ;Look for replacement
  1.  . S MAPTO=$$REPLACE(DSCID,.BSTSWS) Q:MAPTO=""
  1.  . ;
  1.  . ;Replace
  1.  . S BSTSUPD(9000011,IEN_",",80002)=MAPTO
  1.  . D FILE^DIE("","BSTSUPD","ERROR")
  1.  . D ESTS(RUN,9000011,80002,IEN,DSCID,MAPTO)
  1.  I STS=0 Q 0
  1.  ;
  1.  ;Check PROVIDER NARRATIVE file
  1.  S IEN=0 F  S IEN=$O(^AUTNPOV(IEN)) Q:'IEN  D  I $D(^XTMP("BSTSCFIX","QUIT")) D STS(RUN,"STS","Process Aborted") S STS=0 Q
  1.  . D STS(RUN,"STS","Checking PROVIDER NARRATIVE file entry: "_IEN)
  1.  . NEW DSCID,MAPTO,BSTSUPD,ERROR,NARR,ONARR
  1.  . ;
  1.  . ;Get the Description ID from the Narrative - Quit if not converted to SNOMED
  1.  . S (NARR,ONARR)=$$GET1^DIQ(9999999.27,IEN_",",.01,"I")
  1.  . S DSCID=$P(NARR,"|",2) I +DSCID=0 Q
  1.  . ;
  1.  . ;Look for replacement
  1.  . S MAPTO=$$REPLACE(DSCID,.BSTSWS) Q:MAPTO=""
  1.  . ;
  1.  . ;Replace
  1.  . S $P(NARR,"|",2)=MAPTO
  1.  . S BSTSUPD(9999999.27,IEN_",",".01")=NARR
  1.  . D FILE^DIE("","BSTSUPD","ERROR")
  1.  . D ESTS(RUN,9999999.27,.01,IEN,ONARR,NARR)
  1.  I STS=0 Q 0
  1.  ;
  1.  ;Check V POV file
  1.  S IEN=0 F  S IEN=$O(^AUPNVPOV(IEN)) Q:'IEN  D  I $D(^XTMP("BSTSCFIX","QUIT")) D STS(RUN,"STS","Process Aborted") S STS=0 Q
  1.  . D STS(RUN,"STS","Checking V POV file entry: "_IEN)
  1.  . NEW DSCID,MAPTO,BSTSUPD,ERROR
  1.  . ;
  1.  . ;Get the Description ID - Quit if not converted to SNOMED
  1.  . S DSCID=$$GET1^DIQ(9000010.07,IEN_",",1102,"I") I +DSCID=0 Q
  1.  . ;
  1.  . ;Look for replacement
  1.  . S MAPTO=$$REPLACE(DSCID,.BSTSWS) Q:MAPTO=""
  1.  . ;
  1.  . ;Replace
  1.  . S BSTSUPD(9000010.07,IEN_",","1102")=MAPTO
  1.  . D FILE^DIE("","BSTSUPD","ERROR")
  1.  . D ESTS(RUN,9000010.07,1102,IEN,DSCID,MAPTO)
  1.  I STS=0 Q 0
  1.  ;
  1.  ;Check FAMILY HISTORY
  1.  S IEN=0 F  S IEN=$O(^AUPNFH(IEN)) Q:'IEN  D  I $D(^XTMP("BSTSCFIX","QUIT")) D STS(RUN,"STS","Process Aborted") S STS=0 Q
  1.  . D STS(RUN,"STS","Checking FAMILY HISTORY file entry: "_IEN)
  1.  . NEW DSCID,MAPTO,BSTSUPD,ERROR
  1.  . ;
  1.  . ;Get the Description ID - Quit if not converted to SNOMED
  1.  . S DSCID=$$GET1^DIQ(9000014,IEN_",",.14,"I") I +DSCID=0 Q
  1.  . ;
  1.  . ;Look for replacement
  1.  . S MAPTO=$$REPLACE(DSCID,.BSTSWS) Q:MAPTO=""
  1.  . ;
  1.  . ;Replace
  1.  . S BSTSUPD(9000014,IEN_",",".14")=MAPTO
  1.  . D FILE^DIE("","BSTSUPD","ERROR")
  1.  . D ESTS(RUN,9000014,".14",IEN,DSCID,MAPTO)
  1.  I STS=0 Q 0
  1.  ;
  1.  Q 1
  1.  ;
  1. REPLACE(DSCID,BSTSWS) ;Look for replacement description id
  1.  ;
  1.  NEW DESC,STS,REMAPTO,MFAIL,FWAIT,TRY,FCNT,ABORT
  1.  ;
  1.  ;Retrieve Failover Variables
  1.  S MFAIL=$$FPARMS^BSTSVOFL()
  1.  S FWAIT=$P(MFAIL,U,2)
  1.  S MFAIL=$P(MFAIL,U)
  1.  ;
  1.  ;See if already mapped (may not have found one)
  1.  ;Use that value to make things quicker
  1.  I $D(^XTMP("BSTSCFIX","MAP",DSCID)) S REMAPTO=^XTMP("BSTSCFIX","MAP",DSCID) Q $S(DSCID'=REMAPTO:REMAPTO,1:"")
  1.  ;
  1.  ;Attempt to pull the value locally
  1.  ;If found, set map and quit
  1.  S DESC=$$DESC^BSTSAPI(DSCID)
  1.  I $P(DESC,U)]"",$P(DESC,U,2)]"" S ^XTMP("BSTSCFIX","MAP",DSCID)=DSCID Q ""
  1.  ;
  1.  ;Next try remote search - Clear out offline mode flag to ensure call gets made
  1.  ;If found, set map and quit
  1.  S (ABORT,FCNT,STS)=0 F TRY=1:1:(12*MFAIL) D  I +STS=2!(STS="0^") Q
  1.  . D RESET^BSTSWSV1  ;Reset the DTS link to on
  1.  . S STS=$$DSCLKP^BSTSAPI("VAR",DSCID_"^^2")
  1.  . I +STS=2 S ^XTMP("BSTSCFIX","MAP",DSCID)=DSCID Q
  1.  . I STS="0^" Q
  1.  . S FCNT=FCNT+1 I FCNT'<MFAIL D  ;Fail handling
  1.  .. S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"REPLACE^BSTSCFIX - Looking up DSC ID: "_DSCID)
  1.  .. I ABORT=1 S ^XTMP("BSTSCFIX","QUIT")=1 D ELOG^BSTSVOFL("DSCID LOOKUP UTILITY FAILED ON DSC ID: "_DSCID)
  1.  .. S FCNT=0
  1.  ;
  1.  ;If not found, current term most likely has duplicate term in the concept
  1.  ;try to locate the duplicate term
  1.  ;
  1.  S BSTSWS("SEARCH")=DSCID
  1.  S REMAPTO=$$DSCLKP(.BSTSWS,MFAIL,FWAIT)
  1.  ;
  1.  ;Set up mapped entry
  1.  S ^XTMP("BSTSCFIX","MAP",DSCID)=REMAPTO
  1.  ;
  1.  Q REMAPTO
  1.  ;
  1. DSCLKP(BSTSWS,MFAIL,FWAIT) ;
  1.  ;
  1.  NEW SEARCH,STYPE,SLIST,DLIST,NMID,STS,RES,DTSID,REMAPTO,TRY,FCNT,ABORT
  1.  ;
  1.  ;Initialize Return Value
  1.  S REMAPTO=""
  1.  ;
  1.  S SEARCH=$G(BSTSWS("SEARCH"))
  1.  S STYPE=$G(BSTSWS("STYPE"))
  1.  S SLIST=$NA(^TMP("BSTSPDET",$J)) ;Sorted List
  1.  S DLIST=$NA(^TMP("BSTSCMCL",$J)) ;DTS Return List
  1.  K @DLIST,@SLIST
  1.  ;
  1.  ;Perform Lookup on Concept Id
  1.  S (ABORT,FCNT,STS)=0 F TRY=1:1:(12*MFAIL) D  I +STS Q
  1.  . D RESET^BSTSWSV1  ;Reset the DTS link to on
  1.  . S STS=$$DSCSRCH^BSTSCMCL(.BSTSWS,.RES) I +STS Q
  1.  . S FCNT=FCNT+1 I FCNT'<MFAIL D  ;Fail handling
  1.  .. S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"DSCLKP^BSTSCFIX - Looking up: "_SEARCH)
  1.  .. I ABORT=1 S ^XTMP("BSTSCFIX","QUIT")=1 D ELOG^BSTSVOFL("DSCID LOOKUP UTILITY FAILED ON LOOKUP: "_SEARCH)
  1.  .. S FCNT=0
  1.  ;
  1.  S DTSID=$P($G(@DLIST@(1)),U) I DTSID D
  1.  . ;
  1.  . ;Loop through results and retrieve detail
  1.  . ;
  1.  . N STS,ERSLT,TLIST,STYPE,TCNT
  1.  . ;
  1.  . ;Update entry
  1.  . S BSTSWS("DTSID")=DTSID
  1.  . ;
  1.  . ;Clear result file
  1.  . K @DLIST
  1.  . ;
  1.  . ;Get Detail for concept
  1.  . S (ABORT,FCNT,STS)=0 F TRY=1:1:(12*MFAIL) D  I +STS Q
  1.  .. D RESET^BSTSWSV1  ;Reset the DTS link to on
  1.  .. S STS=$$DETAIL^BSTSCMCL(.BSTSWS,.ERSLT) I +STS Q
  1.  .. S FCNT=FCNT+1 I FCNT'<MFAIL D  ;Fail handling
  1.  ... S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"DSCLKP^BSTSCFIX - Looking up DTSID: "_DTSID)
  1.  ... I ABORT=1 S ^XTMP("BSTSCFIX","QUIT")=1 D ELOG^BSTSVOFL("DSCID LOOKUP UTILITY FAILED ON DETAIL LOOKUP: "_DTSID)
  1.  ... S FCNT=0
  1.  . ;
  1.  . ;Now loop through synonyms and try to find replacement
  1.  . S STYPE="" F  S STYPE=$O(@DLIST@(1,"SYN",STYPE)) Q:STYPE=""  S TCNT="" F  S TCNT=$O(@DLIST@(1,"SYN",STYPE,TCNT)) Q:TCNT=""  D
  1.  .. ;
  1.  .. N TERM,DSC
  1.  .. ;
  1.  .. ;Pull values
  1.  .. S TERM=$G(@DLIST@(1,"SYN",STYPE,TCNT,1)) Q:TERM=""
  1.  .. S DSC=$P($G(@DLIST@(1,"SYN",STYPE,TCNT,0)),U) Q:DSC=""
  1.  .. ;
  1.  .. ;Remap if already found
  1.  .. I $D(TLIST(TERM)) D  Q
  1.  ... ;
  1.  ... ;Only look at the one we passed in
  1.  ... I DSC'=SEARCH Q
  1.  ... S REMAPTO=$G(TLIST(TERM))
  1.  .. ;
  1.  .. ;Set up entry in array
  1.  .. S TLIST(TERM)=DSC
  1.  ;
  1.  Q REMAPTO
  1.  ;
  1. STS(RUN,NODE,MSG) ;Enter RUN status entry
  1.  ;
  1.  I $G(RUN)="" Q
  1.  I $G(NODE)="" Q
  1.  ;
  1.  ;Enter the status
  1.  S ^XTMP("BSTSCFIX",RUN,NODE)=$G(MSG)
  1.  Q
  1.  ;
  1. ESTS(RUN,FILE,FIELD,IEN,FROM,TO) ;Log changed entry
  1.  ;
  1.  I $G(RUN)="" Q
  1.  I $G(FILE)="" Q
  1.  I $G(FIELD)="" Q
  1.  ;
  1.  NEW %,%H,%I,X
  1.  ;
  1.  ;Get the time
  1.  D NOW^%DTC
  1.  ;
  1.  ;Log the entry
  1.  S ^XTMP("BSTSCFIX",RUN,FILE,FIELD,IEN)=%_U_$G(DUZ)_U_FROM_U_TO
  1.  Q