BSTSCFIX ;GDIT/HS/BEE-Utility to fix duplicate terms in files ; 5 Nov 2012 9:53 AM
;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
;
EN ;EP - Main entry point
;
NEW DIR,X,Y,FIX,CT,BST
;
W !!
S BST(1)="This utility will loop through files that contain SNOMED description ids and"
S BST(2)="will check to make sure a term can be found for that description id. If a"
S BST(3)="term cannot be found, it attempts to look in DTS for an exact match. For each"
S BST(4)="match that is found the entry gets replaced with the new entry."
D EN^DDIOL(.BST)
K BST
;
S DIR(0)="S^C:Check for Missing Concept Detail;R:Run Background Process to Fix Bad Entries;Q:Quit"
D ^DIR
;
;Handle Quits
I Y'="C",Y'="R" G XEN
;
;Check call
I Y="C" S FIX=$$CHECK() S Y=$S(FIX:"R",1:"")
;
;Fix call
I Y="R" D FIX G XEN
;
XEN Q
;
CHECK() ;Look for bad entries
;
L +^XTMP("BSTSCFIX"):0 E D Q 0 ;Already running
. NEW RUN
. W !!,"A background fix process is running. Please try again later"
. S RUN=$G(^XTMP("BSTSCFIX","RUN")) Q:'+RUN
. W !,"Current Status: ",$G(^XTMP("BSTSCFIX",RUN,"STS"))
. H 3
L -^XTMP("BSTSCFIX")
;
NEW IEN,FIX,DIR,X,Y,STS,VAR
;
W !!,"This option loops through the PROBLEM, PROVIDER NARRATIVE, FAMILY HISTORY"
W !,"and V POV files and locates concepts with no detail associated with them.",!
;
S DIR("A")="Are you sure you wish to proceed? "
S DIR(0)="Y",DIR("B")="No"
D ^DIR
I Y'=1 Q 0
;
;Make sure DTS is working
S STS=$$SEARCH^BSTSAPI("VAR","COMMON COLD^F")
I +STS'=2 D Q 0
. W !!,"BSTS is set to local. It must be running properly in order to run this option"
. W !,"Please run the STS option in the BSTSMENU to troubleshoot the BSTS connection"
. H 3
;
;Reset flag
S FIX=0
;
;First look in problem file
W !!,"Reviewing PROBLEM file entries: "
W !,"Problem IEN",?20,"Patient",?60,"Description Id"
S IEN=0 F S IEN=$O(^AUPNPROB(IEN)) Q:'IEN D
. NEW DSCID,DESC,DFN
. ;
. ;Ignore deleted problems
. I $$GET1^DIQ(9000011,IEN_",",2.02,"I")]"" Q
. ;
. S DSCID=$P($G(^AUPNPROB(IEN,800)),U,2) Q:DSCID=""
. D RESET^BSTSWSV1 ;Make sure the link is on
. S DESC=$$DESC^BSTSAPI(DSCID)
. ;
. ;Skip if description found
. I $TR(DESC,"^")]"" Q
. ;
. S FIX=1
. S DFN=$P($G(^AUPNPROB(IEN,0)),U,2)
. W !,IEN,?20,$P($G(^DPT(DFN,0)),U),?60,DSCID
;
;Check PROVIDER NARRATIVE file
W !!,"Reviewing PROVIDER NARRATIVE entries: "
W !,"IEN",?60,"Description Id"
S IEN=0 F S IEN=$O(^AUTNPOV(IEN)) Q:'IEN D
. NEW NARR,DSCID,DESC
. ;
. ;Get the Description ID from the Narrative - Quit if not converted to SNOMED
. S NARR=$$GET1^DIQ(9999999.27,IEN_",",.01,"I")
. S DSCID=$P(NARR,"|",2) I +DSCID=0 Q
. D RESET^BSTSWSV1 ;Make sure the link is on
. S DESC=$$DESC^BSTSAPI(DSCID)
. ;
. ;Skip if description found
. I $TR(DESC,"^")]"" Q
. ;
. S FIX=1
. W !,IEN,?60,DSCID
;
;Check V POV file
W !!,"Reviewing V POV entries: "
W !,"VPOV IEN",?15,"Patient",?42,"Visit",?60,"Description Id"
S IEN=0 F S IEN=$O(^AUPNVPOV(IEN)) Q:'IEN D
. NEW DSCID,DESCID,DFN
. ;
. ;Get the Description ID - Quit if not converted to SNOMED
. S DSCID=$$GET1^DIQ(9000010.07,IEN_",",1102,"I") I +DSCID=0 Q
. D RESET^BSTSWSV1 ;Make sure the link is on
. S DESC=$$DESC^BSTSAPI(DSCID)
. ;
. ;Skip if description found
. I $TR(DESC,"^")]"" Q
. ;
. S FIX=1
. S DFN=$P($G(^AUPNVPOV(IEN,0)),U,2)
. 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
;
;Check FAMILY HISTORY
W !!,"Reviewing FAMILY HISTORY entries: "
W !,"IEN",?15,"Patient",?60,"Description Id"
S IEN=0 F S IEN=$O(^AUPNFH(IEN)) Q:'IEN D
. NEW DSCID,DESC,DFN
. ;
. ;Get the Description ID - Quit if not converted to SNOMED
. S DSCID=$$GET1^DIQ(9000014,IEN_",",.14,"I") I +DSCID=0 Q
. D RESET^BSTSWSV1 ;Make sure the link is on
. S DESC=$$DESC^BSTSAPI(DSCID)
. ;
. ;Skip if description found
. I $TR(DESC,"^")]"" Q
. ;
. S FIX=1
. S DFN=$P($G(^AUPNFH(IEN,0)),U,2)
. W !,IEN,?15,$P($G(^DPT(DFN,0)),U),?60,DSCID
;
;If issues, check if they want to run the fix
I FIX=0 D Q 0
. W !!,"No issues were encountered. There is no need to run the fix option."
. H 3
;
W !!,"Concepts without detail were encountered",!
S DIR("A")="Would you like to job off the fix option now? "
S DIR(0)="Y",DIR("B")="No"
D ^DIR
I Y'=1 S FIX=0
;
Q FIX
;
FIX ;Kick off background fix process
;
L +^XTMP("BSTSCFIX"):0 E D Q ;Already running
. NEW RUN
. W !!,"A background fix process is running. Please try again later"
. S RUN=$G(^XTMP("BSTSCFIX","RUN")) Q:'+RUN
. W !,"Current Status: ",$G(^XTMP("BSTSCFIX",RUN,"STS"))
. H 3
L -^XTMP("BSTSCFIX")
;
NEW DIR,X,Y,VAR,STS
;
;Make sure DTS is working
D RESET^BSTSWSV1
S STS=$$SEARCH^BSTSAPI("VAR","COMMON COLD^F")
I +STS'=2 D Q
. W !!,"BSTS is set to local. It must be running properly in order to run this option"
. W !,"Please run the STS option in the BSTSMENU to troubleshoot the BSTS connection"
. H 3
;
W !!,"This option kicks off a background process which will attempt to fix concepts"
W !,"with no detail associated with them.",!
;
S DIR("A")="Are you sure you wish to proceed? "
S DIR(0)="Y",DIR("B")="No"
D ^DIR
I Y'=1 Q
;
FIX1 ;Kick off process to convert invalid description ids to valid description ids
NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSK
;
;Queue the process off in the background
K IO("Q")
;
S ZTRTN="START^BSTSCFIX",ZTDESC="BSTS - Replace invalid description ids with valid ones"
S ZTIO=""
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,2)
D ^%ZTLOAD
;
Q
;
START ;Called by background job
;
;Lock so only one process can run at a time
L +^XTMP("BSTSCFIX"):0 E Q ;Already running
;
NEW BSTSSRV,PRI,STS,II,DEBUG,X1,X2,X,RUN,%,%H,%I
;
;Get date
I $G(DT)="" D DT^DICRW
;
;Define DEBUG
S DEBUG=""
;
;Get a later date
D NOW^%DTC
S X1=DT,X2=120 D C^%DTC
;
;Initialize ^XTMP entry
K ^XTMP("BSTSCFIX","QUIT")
S $P(^XTMP("BSTSCFIX",0),U)=X ;Set date in the future
S $P(^XTMP("BSTSCFIX",0),U,2)=DT ;Set current date
S $P(^XTMP("BSTSCFIX",0),U,3)="Results of BSTSCFIX conversion"
S (RUN,^XTMP("BSTSCFIX","RUN"))=$G(^XTMP("BSTSCFIX","RUN"))+1 ;Increment Run counter
S ^XTMP("BSTSCFIX",RUN,0)=%_U_$G(DUZ)
K ^XTMP("BSTSCFIX","MAP") ;Reset mappings
K ^XTMP("BSTSCFIX","QUIT")
;
;Get a list of the servers available
S STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)
;
;Loop through server list and perform conversion on the first active one
;
;Check for active server
I $D(BSTSSRV)<10 D STS(RUN,"STS","No Active Server Found") Q
;
;Loop through each until a good one is found
I $D(BSTSSRV)>1 S STS=0,PRI="" F II=2:1 S PRI=$O(BSTSSRV(PRI)) Q:PRI="" D Q:+STS
. ;
. NEW BSTSWS,TYPE,TIME,CSTS,SRV
. M BSTSWS=BSTSSRV(PRI)
. S TYPE=$G(BSTSWS("TYPE")),CSTS=""
. S SRV="SRV"_(II-1)
. ;
. ;Check if DTS server is set to local
. S STS=$$CKDTS^BSTSWSV1(.BSTSWS) I '+STS D STS(RUN,SRV,$G(BSTSWS("URLROOT"))_": Set to Local") Q
. ;
. ;Perform conversion using specified server
. D STS(RUN,SRV,$G(BSTSWS("URLROOT")))
. I TYPE="D" S STS=$$DSC(.BSTSWS,RUN)
;
;Mark as completed
I +STS D STS(RUN,"STS","Process Completed")
L -^XTMP("BSTSCFIX")
Q
;
DSC(BSTSWS,RUN) ;Loop through files and replace bad entries
;
NEW SNAPDT,IEN,DSCID,REMAPTO,STS
;
;Set up remaining array entries needed by DTS call
S SNAPDT=$$DTCHG^BSTSUTIL(DT,2)_".0001"
S SNAPDT=$$FMTE^BSTSUTIL(SNAPDT)
S BSTSWS("STYPE")="F"
S BSTSWS("NAMESPACEID")=36
S BSTSWS("SUBSET")=""
S BSTSWS("SNAPDT")=SNAPDT
S BSTSWS("MAXRECS")=100
S BSTSWS("BCTCHRC")=""
S BSTSWS("BCTCHCT")=""
S BSTSWS("RET")="PSCBIXAV"
S BSTSWS("DAT")=""
S BSTSWS("TBYPASS")=""
;
;Check PROBLEM file
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
. D STS(RUN,"STS","Checking PROBLEM file entry: "_IEN)
. NEW DSCID,MAPTO,BSTSUPD,ERROR
. ;
. ;Ignore deleted problems
. I $$GET1^DIQ(9000011,IEN_",",2.02,"I")]"" Q
. ;
. ;Get the Description ID - Quit if not converted to SNOMED
. S DSCID=$$GET1^DIQ(9000011,IEN_",",80002,"I") Q:DSCID=""
. ;
. ;Look for replacement
. S MAPTO=$$REPLACE(DSCID,.BSTSWS) Q:MAPTO=""
. ;
. ;Replace
. S BSTSUPD(9000011,IEN_",",80002)=MAPTO
. D FILE^DIE("","BSTSUPD","ERROR")
. D ESTS(RUN,9000011,80002,IEN,DSCID,MAPTO)
I STS=0 Q 0
;
;Check PROVIDER NARRATIVE file
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
. D STS(RUN,"STS","Checking PROVIDER NARRATIVE file entry: "_IEN)
. NEW DSCID,MAPTO,BSTSUPD,ERROR,NARR,ONARR
. ;
. ;Get the Description ID from the Narrative - Quit if not converted to SNOMED
. S (NARR,ONARR)=$$GET1^DIQ(9999999.27,IEN_",",.01,"I")
. S DSCID=$P(NARR,"|",2) I +DSCID=0 Q
. ;
. ;Look for replacement
. S MAPTO=$$REPLACE(DSCID,.BSTSWS) Q:MAPTO=""
. ;
. ;Replace
. S $P(NARR,"|",2)=MAPTO
. S BSTSUPD(9999999.27,IEN_",",".01")=NARR
. D FILE^DIE("","BSTSUPD","ERROR")
. D ESTS(RUN,9999999.27,.01,IEN,ONARR,NARR)
I STS=0 Q 0
;
;Check V POV file
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
. D STS(RUN,"STS","Checking V POV file entry: "_IEN)
. NEW DSCID,MAPTO,BSTSUPD,ERROR
. ;
. ;Get the Description ID - Quit if not converted to SNOMED
. S DSCID=$$GET1^DIQ(9000010.07,IEN_",",1102,"I") I +DSCID=0 Q
. ;
. ;Look for replacement
. S MAPTO=$$REPLACE(DSCID,.BSTSWS) Q:MAPTO=""
. ;
. ;Replace
. S BSTSUPD(9000010.07,IEN_",","1102")=MAPTO
. D FILE^DIE("","BSTSUPD","ERROR")
. D ESTS(RUN,9000010.07,1102,IEN,DSCID,MAPTO)
I STS=0 Q 0
;
;Check FAMILY HISTORY
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
. D STS(RUN,"STS","Checking FAMILY HISTORY file entry: "_IEN)
. NEW DSCID,MAPTO,BSTSUPD,ERROR
. ;
. ;Get the Description ID - Quit if not converted to SNOMED
. S DSCID=$$GET1^DIQ(9000014,IEN_",",.14,"I") I +DSCID=0 Q
. ;
. ;Look for replacement
. S MAPTO=$$REPLACE(DSCID,.BSTSWS) Q:MAPTO=""
. ;
. ;Replace
. S BSTSUPD(9000014,IEN_",",".14")=MAPTO
. D FILE^DIE("","BSTSUPD","ERROR")
. D ESTS(RUN,9000014,".14",IEN,DSCID,MAPTO)
I STS=0 Q 0
;
Q 1
;
REPLACE(DSCID,BSTSWS) ;Look for replacement description id
;
NEW DESC,STS,REMAPTO,MFAIL,FWAIT,TRY,FCNT,ABORT
;
;Retrieve Failover Variables
S MFAIL=$$FPARMS^BSTSVOFL()
S FWAIT=$P(MFAIL,U,2)
S MFAIL=$P(MFAIL,U)
;
;See if already mapped (may not have found one)
;Use that value to make things quicker
I $D(^XTMP("BSTSCFIX","MAP",DSCID)) S REMAPTO=^XTMP("BSTSCFIX","MAP",DSCID) Q $S(DSCID'=REMAPTO:REMAPTO,1:"")
;
;Attempt to pull the value locally
;If found, set map and quit
S DESC=$$DESC^BSTSAPI(DSCID)
I $P(DESC,U)]"",$P(DESC,U,2)]"" S ^XTMP("BSTSCFIX","MAP",DSCID)=DSCID Q ""
;
;Next try remote search - Clear out offline mode flag to ensure call gets made
;If found, set map and quit
S (ABORT,FCNT,STS)=0 F TRY=1:1:(12*MFAIL) D I +STS=2!(STS="0^") Q
. D RESET^BSTSWSV1 ;Reset the DTS link to on
. S STS=$$DSCLKP^BSTSAPI("VAR",DSCID_"^^2")
. I +STS=2 S ^XTMP("BSTSCFIX","MAP",DSCID)=DSCID Q
. I STS="0^" Q
. S FCNT=FCNT+1 I FCNT'<MFAIL D ;Fail handling
.. S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"REPLACE^BSTSCFIX - Looking up DSC ID: "_DSCID)
.. I ABORT=1 S ^XTMP("BSTSCFIX","QUIT")=1 D ELOG^BSTSVOFL("DSCID LOOKUP UTILITY FAILED ON DSC ID: "_DSCID)
.. S FCNT=0
;
;If not found, current term most likely has duplicate term in the concept
;try to locate the duplicate term
;
S BSTSWS("SEARCH")=DSCID
S REMAPTO=$$DSCLKP(.BSTSWS,MFAIL,FWAIT)
;
;Set up mapped entry
S ^XTMP("BSTSCFIX","MAP",DSCID)=REMAPTO
;
Q REMAPTO
;
DSCLKP(BSTSWS,MFAIL,FWAIT) ;
;
NEW SEARCH,STYPE,SLIST,DLIST,NMID,STS,RES,DTSID,REMAPTO,TRY,FCNT,ABORT
;
;Initialize Return Value
S REMAPTO=""
;
S SEARCH=$G(BSTSWS("SEARCH"))
S STYPE=$G(BSTSWS("STYPE"))
S SLIST=$NA(^TMP("BSTSPDET",$J)) ;Sorted List
S DLIST=$NA(^TMP("BSTSCMCL",$J)) ;DTS Return List
K @DLIST,@SLIST
;
;Perform Lookup on Concept Id
S (ABORT,FCNT,STS)=0 F TRY=1:1:(12*MFAIL) D I +STS Q
. D RESET^BSTSWSV1 ;Reset the DTS link to on
. S STS=$$DSCSRCH^BSTSCMCL(.BSTSWS,.RES) I +STS Q
. S FCNT=FCNT+1 I FCNT'<MFAIL D ;Fail handling
.. S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"DSCLKP^BSTSCFIX - Looking up: "_SEARCH)
.. I ABORT=1 S ^XTMP("BSTSCFIX","QUIT")=1 D ELOG^BSTSVOFL("DSCID LOOKUP UTILITY FAILED ON LOOKUP: "_SEARCH)
.. S FCNT=0
;
S DTSID=$P($G(@DLIST@(1)),U) I DTSID D
. ;
. ;Loop through results and retrieve detail
. ;
. N STS,ERSLT,TLIST,STYPE,TCNT
. ;
. ;Update entry
. S BSTSWS("DTSID")=DTSID
. ;
. ;Clear result file
. K @DLIST
. ;
. ;Get Detail for concept
. S (ABORT,FCNT,STS)=0 F TRY=1:1:(12*MFAIL) D I +STS Q
.. D RESET^BSTSWSV1 ;Reset the DTS link to on
.. S STS=$$DETAIL^BSTSCMCL(.BSTSWS,.ERSLT) I +STS Q
.. S FCNT=FCNT+1 I FCNT'<MFAIL D ;Fail handling
... S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"DSCLKP^BSTSCFIX - Looking up DTSID: "_DTSID)
... I ABORT=1 S ^XTMP("BSTSCFIX","QUIT")=1 D ELOG^BSTSVOFL("DSCID LOOKUP UTILITY FAILED ON DETAIL LOOKUP: "_DTSID)
... S FCNT=0
. ;
. ;Now loop through synonyms and try to find replacement
. 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
.. ;
.. N TERM,DSC
.. ;
.. ;Pull values
.. S TERM=$G(@DLIST@(1,"SYN",STYPE,TCNT,1)) Q:TERM=""
.. S DSC=$P($G(@DLIST@(1,"SYN",STYPE,TCNT,0)),U) Q:DSC=""
.. ;
.. ;Remap if already found
.. I $D(TLIST(TERM)) D Q
... ;
... ;Only look at the one we passed in
... I DSC'=SEARCH Q
... S REMAPTO=$G(TLIST(TERM))
.. ;
.. ;Set up entry in array
.. S TLIST(TERM)=DSC
;
Q REMAPTO
;
STS(RUN,NODE,MSG) ;Enter RUN status entry
;
I $G(RUN)="" Q
I $G(NODE)="" Q
;
;Enter the status
S ^XTMP("BSTSCFIX",RUN,NODE)=$G(MSG)
Q
;
ESTS(RUN,FILE,FIELD,IEN,FROM,TO) ;Log changed entry
;
I $G(RUN)="" Q
I $G(FILE)="" Q
I $G(FIELD)="" Q
;
NEW %,%H,%I,X
;
;Get the time
D NOW^%DTC
;
;Log the entry
S ^XTMP("BSTSCFIX",RUN,FILE,FIELD,IEN)=%_U_$G(DUZ)_U_FROM_U_TO
Q
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
+2 ;
EN ;EP - Main entry point
+1 ;
+2 NEW DIR,X,Y,FIX,CT,BST
+3 ;
+4 WRITE !!
+5 SET BST(1)="This utility will loop through files that contain SNOMED description ids and"
+6 SET BST(2)="will check to make sure a term can be found for that description id. If a"
+7 SET BST(3)="term cannot be found, it attempts to look in DTS for an exact match. For each"
+8 SET BST(4)="match that is found the entry gets replaced with the new entry."
+9 DO EN^DDIOL(.BST)
+10 KILL BST
+11 ;
+12 SET DIR(0)="S^C:Check for Missing Concept Detail;R:Run Background Process to Fix Bad Entries;Q:Quit"
+13 DO ^DIR
+14 ;
+15 ;Handle Quits
+16 IF Y'="C"
IF Y'="R"
GOTO XEN
+17 ;
+18 ;Check call
+19 IF Y="C"
SET FIX=$$CHECK()
SET Y=$SELECT(FIX:"R",1:"")
+20 ;
+21 ;Fix call
+22 IF Y="R"
DO FIX
GOTO XEN
+23 ;
XEN QUIT
+1 ;
CHECK() ;Look for bad entries
+1 ;
+2 ;Already running
LOCK +^XTMP("BSTSCFIX"):0
IF '$TEST
Begin DoDot:1
+3 NEW RUN
+4 WRITE !!,"A background fix process is running. Please try again later"
+5 SET RUN=$GET(^XTMP("BSTSCFIX","RUN"))
IF '+RUN
QUIT
+6 WRITE !,"Current Status: ",$GET(^XTMP("BSTSCFIX",RUN,"STS"))
+7 HANG 3
End DoDot:1
QUIT 0
+8 LOCK -^XTMP("BSTSCFIX")
+9 ;
+10 NEW IEN,FIX,DIR,X,Y,STS,VAR
+11 ;
+12 WRITE !!,"This option loops through the PROBLEM, PROVIDER NARRATIVE, FAMILY HISTORY"
+13 WRITE !,"and V POV files and locates concepts with no detail associated with them.",!
+14 ;
+15 SET DIR("A")="Are you sure you wish to proceed? "
+16 SET DIR(0)="Y"
SET DIR("B")="No"
+17 DO ^DIR
+18 IF Y'=1
QUIT 0
+19 ;
+20 ;Make sure DTS is working
+21 SET STS=$$SEARCH^BSTSAPI("VAR","COMMON COLD^F")
+22 IF +STS'=2
Begin DoDot:1
+23 WRITE !!,"BSTS is set to local. It must be running properly in order to run this option"
+24 WRITE !,"Please run the STS option in the BSTSMENU to troubleshoot the BSTS connection"
+25 HANG 3
End DoDot:1
QUIT 0
+26 ;
+27 ;Reset flag
+28 SET FIX=0
+29 ;
+30 ;First look in problem file
+31 WRITE !!,"Reviewing PROBLEM file entries: "
+32 WRITE !,"Problem IEN",?20,"Patient",?60,"Description Id"
+33 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNPROB(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+34 NEW DSCID,DESC,DFN
+35 ;
+36 ;Ignore deleted problems
+37 IF $$GET1^DIQ(9000011,IEN_",",2.02,"I")]""
QUIT
+38 ;
+39 SET DSCID=$PIECE($GET(^AUPNPROB(IEN,800)),U,2)
IF DSCID=""
QUIT
+40 ;Make sure the link is on
DO RESET^BSTSWSV1
+41 SET DESC=$$DESC^BSTSAPI(DSCID)
+42 ;
+43 ;Skip if description found
+44 IF $TRANSLATE(DESC,"^")]""
QUIT
+45 ;
+46 SET FIX=1
+47 SET DFN=$PIECE($GET(^AUPNPROB(IEN,0)),U,2)
+48 WRITE !,IEN,?20,$PIECE($GET(^DPT(DFN,0)),U),?60,DSCID
End DoDot:1
+49 ;
+50 ;Check PROVIDER NARRATIVE file
+51 WRITE !!,"Reviewing PROVIDER NARRATIVE entries: "
+52 WRITE !,"IEN",?60,"Description Id"
+53 SET IEN=0
FOR
SET IEN=$ORDER(^AUTNPOV(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+54 NEW NARR,DSCID,DESC
+55 ;
+56 ;Get the Description ID from the Narrative - Quit if not converted to SNOMED
+57 SET NARR=$$GET1^DIQ(9999999.27,IEN_",",.01,"I")
+58 SET DSCID=$PIECE(NARR,"|",2)
IF +DSCID=0
QUIT
+59 ;Make sure the link is on
DO RESET^BSTSWSV1
+60 SET DESC=$$DESC^BSTSAPI(DSCID)
+61 ;
+62 ;Skip if description found
+63 IF $TRANSLATE(DESC,"^")]""
QUIT
+64 ;
+65 SET FIX=1
+66 WRITE !,IEN,?60,DSCID
End DoDot:1
+67 ;
+68 ;Check V POV file
+69 WRITE !!,"Reviewing V POV entries: "
+70 WRITE !,"VPOV IEN",?15,"Patient",?42,"Visit",?60,"Description Id"
+71 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPOV(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+72 NEW DSCID,DESCID,DFN
+73 ;
+74 ;Get the Description ID - Quit if not converted to SNOMED
+75 SET DSCID=$$GET1^DIQ(9000010.07,IEN_",",1102,"I")
IF +DSCID=0
QUIT
+76 ;Make sure the link is on
DO RESET^BSTSWSV1
+77 SET DESC=$$DESC^BSTSAPI(DSCID)
+78 ;
+79 ;Skip if description found
+80 IF $TRANSLATE(DESC,"^")]""
QUIT
+81 ;
+82 SET FIX=1
+83 SET DFN=$PIECE($GET(^AUPNVPOV(IEN,0)),U,2)
+84 WRITE !,IEN,?15,$EXTRACT($PIECE($GET(^DPT(DFN,0)),U),1,23),?41,$EXTRACT($$GET1^DIQ(9000010.07,IEN_",",".03","E"),1,17),?60,DSCID
End DoDot:1
+85 ;
+86 ;Check FAMILY HISTORY
+87 WRITE !!,"Reviewing FAMILY HISTORY entries: "
+88 WRITE !,"IEN",?15,"Patient",?60,"Description Id"
+89 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNFH(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+90 NEW DSCID,DESC,DFN
+91 ;
+92 ;Get the Description ID - Quit if not converted to SNOMED
+93 SET DSCID=$$GET1^DIQ(9000014,IEN_",",.14,"I")
IF +DSCID=0
QUIT
+94 ;Make sure the link is on
DO RESET^BSTSWSV1
+95 SET DESC=$$DESC^BSTSAPI(DSCID)
+96 ;
+97 ;Skip if description found
+98 IF $TRANSLATE(DESC,"^")]""
QUIT
+99 ;
+100 SET FIX=1
+101 SET DFN=$PIECE($GET(^AUPNFH(IEN,0)),U,2)
+102 WRITE !,IEN,?15,$PIECE($GET(^DPT(DFN,0)),U),?60,DSCID
End DoDot:1
+103 ;
+104 ;If issues, check if they want to run the fix
+105 IF FIX=0
Begin DoDot:1
+106 WRITE !!,"No issues were encountered. There is no need to run the fix option."
+107 HANG 3
End DoDot:1
QUIT 0
+108 ;
+109 WRITE !!,"Concepts without detail were encountered",!
+110 SET DIR("A")="Would you like to job off the fix option now? "
+111 SET DIR(0)="Y"
SET DIR("B")="No"
+112 DO ^DIR
+113 IF Y'=1
SET FIX=0
+114 ;
+115 QUIT FIX
+116 ;
FIX ;Kick off background fix process
+1 ;
+2 ;Already running
LOCK +^XTMP("BSTSCFIX"):0
IF '$TEST
Begin DoDot:1
+3 NEW RUN
+4 WRITE !!,"A background fix process is running. Please try again later"
+5 SET RUN=$GET(^XTMP("BSTSCFIX","RUN"))
IF '+RUN
QUIT
+6 WRITE !,"Current Status: ",$GET(^XTMP("BSTSCFIX",RUN,"STS"))
+7 HANG 3
End DoDot:1
QUIT
+8 LOCK -^XTMP("BSTSCFIX")
+9 ;
+10 NEW DIR,X,Y,VAR,STS
+11 ;
+12 ;Make sure DTS is working
+13 DO RESET^BSTSWSV1
+14 SET STS=$$SEARCH^BSTSAPI("VAR","COMMON COLD^F")
+15 IF +STS'=2
Begin DoDot:1
+16 WRITE !!,"BSTS is set to local. It must be running properly in order to run this option"
+17 WRITE !,"Please run the STS option in the BSTSMENU to troubleshoot the BSTS connection"
+18 HANG 3
End DoDot:1
QUIT
+19 ;
+20 WRITE !!,"This option kicks off a background process which will attempt to fix concepts"
+21 WRITE !,"with no detail associated with them.",!
+22 ;
+23 SET DIR("A")="Are you sure you wish to proceed? "
+24 SET DIR(0)="Y"
SET DIR("B")="No"
+25 DO ^DIR
+26 IF Y'=1
QUIT
+27 ;
FIX1 ;Kick off process to convert invalid description ids to valid description ids
+1 NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSK
+2 ;
+3 ;Queue the process off in the background
+4 KILL IO("Q")
+5 ;
+6 SET ZTRTN="START^BSTSCFIX"
SET ZTDESC="BSTS - Replace invalid description ids with valid ones"
+7 SET ZTIO=""
+8 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,2)
+9 DO ^%ZTLOAD
+10 ;
+11 QUIT
+12 ;
START ;Called by background job
+1 ;
+2 ;Lock so only one process can run at a time
+3 ;Already running
LOCK +^XTMP("BSTSCFIX"):0
IF '$TEST
QUIT
+4 ;
+5 NEW BSTSSRV,PRI,STS,II,DEBUG,X1,X2,X,RUN,%,%H,%I
+6 ;
+7 ;Get date
+8 IF $GET(DT)=""
DO DT^DICRW
+9 ;
+10 ;Define DEBUG
+11 SET DEBUG=""
+12 ;
+13 ;Get a later date
+14 DO NOW^%DTC
+15 SET X1=DT
SET X2=120
DO C^%DTC
+16 ;
+17 ;Initialize ^XTMP entry
+18 KILL ^XTMP("BSTSCFIX","QUIT")
+19 ;Set date in the future
SET $PIECE(^XTMP("BSTSCFIX",0),U)=X
+20 ;Set current date
SET $PIECE(^XTMP("BSTSCFIX",0),U,2)=DT
+21 SET $PIECE(^XTMP("BSTSCFIX",0),U,3)="Results of BSTSCFIX conversion"
+22 ;Increment Run counter
SET (RUN,^XTMP("BSTSCFIX","RUN"))=$GET(^XTMP("BSTSCFIX","RUN"))+1
+23 SET ^XTMP("BSTSCFIX",RUN,0)=%_U_$GET(DUZ)
+24 ;Reset mappings
KILL ^XTMP("BSTSCFIX","MAP")
+25 KILL ^XTMP("BSTSCFIX","QUIT")
+26 ;
+27 ;Get a list of the servers available
+28 SET STS=$$WSERVER^BSTSWSV(.BSTSSRV,DEBUG)
+29 ;
+30 ;Loop through server list and perform conversion on the first active one
+31 ;
+32 ;Check for active server
+33 IF $DATA(BSTSSRV)<10
DO STS(RUN,"STS","No Active Server Found")
QUIT
+34 ;
+35 ;Loop through each until a good one is found
+36 IF $DATA(BSTSSRV)>1
SET STS=0
SET PRI=""
FOR II=2:1
SET PRI=$ORDER(BSTSSRV(PRI))
IF PRI=""
QUIT
Begin DoDot:1
+37 ;
+38 NEW BSTSWS,TYPE,TIME,CSTS,SRV
+39 MERGE BSTSWS=BSTSSRV(PRI)
+40 SET TYPE=$GET(BSTSWS("TYPE"))
SET CSTS=""
+41 SET SRV="SRV"_(II-1)
+42 ;
+43 ;Check if DTS server is set to local
+44 SET STS=$$CKDTS^BSTSWSV1(.BSTSWS)
IF '+STS
DO STS(RUN,SRV,$GET(BSTSWS("URLROOT"))_": Set to Local")
QUIT
+45 ;
+46 ;Perform conversion using specified server
+47 DO STS(RUN,SRV,$GET(BSTSWS("URLROOT")))
+48 IF TYPE="D"
SET STS=$$DSC(.BSTSWS,RUN)
End DoDot:1
IF +STS
QUIT
+49 ;
+50 ;Mark as completed
+51 IF +STS
DO STS(RUN,"STS","Process Completed")
+52 LOCK -^XTMP("BSTSCFIX")
+53 QUIT
+54 ;
DSC(BSTSWS,RUN) ;Loop through files and replace bad entries
+1 ;
+2 NEW SNAPDT,IEN,DSCID,REMAPTO,STS
+3 ;
+4 ;Set up remaining array entries needed by DTS call
+5 SET SNAPDT=$$DTCHG^BSTSUTIL(DT,2)_".0001"
+6 SET SNAPDT=$$FMTE^BSTSUTIL(SNAPDT)
+7 SET BSTSWS("STYPE")="F"
+8 SET BSTSWS("NAMESPACEID")=36
+9 SET BSTSWS("SUBSET")=""
+10 SET BSTSWS("SNAPDT")=SNAPDT
+11 SET BSTSWS("MAXRECS")=100
+12 SET BSTSWS("BCTCHRC")=""
+13 SET BSTSWS("BCTCHCT")=""
+14 SET BSTSWS("RET")="PSCBIXAV"
+15 SET BSTSWS("DAT")=""
+16 SET BSTSWS("TBYPASS")=""
+17 ;
+18 ;Check PROBLEM file
+19 SET STS=1
SET IEN=0
FOR
SET IEN=$ORDER(^AUPNPROB(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+20 DO STS(RUN,"STS","Checking PROBLEM file entry: "_IEN)
+21 NEW DSCID,MAPTO,BSTSUPD,ERROR
+22 ;
+23 ;Ignore deleted problems
+24 IF $$GET1^DIQ(9000011,IEN_",",2.02,"I")]""
QUIT
+25 ;
+26 ;Get the Description ID - Quit if not converted to SNOMED
+27 SET DSCID=$$GET1^DIQ(9000011,IEN_",",80002,"I")
IF DSCID=""
QUIT
+28 ;
+29 ;Look for replacement
+30 SET MAPTO=$$REPLACE(DSCID,.BSTSWS)
IF MAPTO=""
QUIT
+31 ;
+32 ;Replace
+33 SET BSTSUPD(9000011,IEN_",",80002)=MAPTO
+34 DO FILE^DIE("","BSTSUPD","ERROR")
+35 DO ESTS(RUN,9000011,80002,IEN,DSCID,MAPTO)
End DoDot:1
IF $DATA(^XTMP("BSTSCFIX","QUIT"))
DO STS(RUN,"STS","Process Aborted")
SET STS=0
QUIT
+36 IF STS=0
QUIT 0
+37 ;
+38 ;Check PROVIDER NARRATIVE file
+39 SET IEN=0
FOR
SET IEN=$ORDER(^AUTNPOV(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+40 DO STS(RUN,"STS","Checking PROVIDER NARRATIVE file entry: "_IEN)
+41 NEW DSCID,MAPTO,BSTSUPD,ERROR,NARR,ONARR
+42 ;
+43 ;Get the Description ID from the Narrative - Quit if not converted to SNOMED
+44 SET (NARR,ONARR)=$$GET1^DIQ(9999999.27,IEN_",",.01,"I")
+45 SET DSCID=$PIECE(NARR,"|",2)
IF +DSCID=0
QUIT
+46 ;
+47 ;Look for replacement
+48 SET MAPTO=$$REPLACE(DSCID,.BSTSWS)
IF MAPTO=""
QUIT
+49 ;
+50 ;Replace
+51 SET $PIECE(NARR,"|",2)=MAPTO
+52 SET BSTSUPD(9999999.27,IEN_",",".01")=NARR
+53 DO FILE^DIE("","BSTSUPD","ERROR")
+54 DO ESTS(RUN,9999999.27,.01,IEN,ONARR,NARR)
End DoDot:1
IF $DATA(^XTMP("BSTSCFIX","QUIT"))
DO STS(RUN,"STS","Process Aborted")
SET STS=0
QUIT
+55 IF STS=0
QUIT 0
+56 ;
+57 ;Check V POV file
+58 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPOV(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+59 DO STS(RUN,"STS","Checking V POV file entry: "_IEN)
+60 NEW DSCID,MAPTO,BSTSUPD,ERROR
+61 ;
+62 ;Get the Description ID - Quit if not converted to SNOMED
+63 SET DSCID=$$GET1^DIQ(9000010.07,IEN_",",1102,"I")
IF +DSCID=0
QUIT
+64 ;
+65 ;Look for replacement
+66 SET MAPTO=$$REPLACE(DSCID,.BSTSWS)
IF MAPTO=""
QUIT
+67 ;
+68 ;Replace
+69 SET BSTSUPD(9000010.07,IEN_",","1102")=MAPTO
+70 DO FILE^DIE("","BSTSUPD","ERROR")
+71 DO ESTS(RUN,9000010.07,1102,IEN,DSCID,MAPTO)
End DoDot:1
IF $DATA(^XTMP("BSTSCFIX","QUIT"))
DO STS(RUN,"STS","Process Aborted")
SET STS=0
QUIT
+72 IF STS=0
QUIT 0
+73 ;
+74 ;Check FAMILY HISTORY
+75 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNFH(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+76 DO STS(RUN,"STS","Checking FAMILY HISTORY file entry: "_IEN)
+77 NEW DSCID,MAPTO,BSTSUPD,ERROR
+78 ;
+79 ;Get the Description ID - Quit if not converted to SNOMED
+80 SET DSCID=$$GET1^DIQ(9000014,IEN_",",.14,"I")
IF +DSCID=0
QUIT
+81 ;
+82 ;Look for replacement
+83 SET MAPTO=$$REPLACE(DSCID,.BSTSWS)
IF MAPTO=""
QUIT
+84 ;
+85 ;Replace
+86 SET BSTSUPD(9000014,IEN_",",".14")=MAPTO
+87 DO FILE^DIE("","BSTSUPD","ERROR")
+88 DO ESTS(RUN,9000014,".14",IEN,DSCID,MAPTO)
End DoDot:1
IF $DATA(^XTMP("BSTSCFIX","QUIT"))
DO STS(RUN,"STS","Process Aborted")
SET STS=0
QUIT
+89 IF STS=0
QUIT 0
+90 ;
+91 QUIT 1
+92 ;
REPLACE(DSCID,BSTSWS) ;Look for replacement description id
+1 ;
+2 NEW DESC,STS,REMAPTO,MFAIL,FWAIT,TRY,FCNT,ABORT
+3 ;
+4 ;Retrieve Failover Variables
+5 SET MFAIL=$$FPARMS^BSTSVOFL()
+6 SET FWAIT=$PIECE(MFAIL,U,2)
+7 SET MFAIL=$PIECE(MFAIL,U)
+8 ;
+9 ;See if already mapped (may not have found one)
+10 ;Use that value to make things quicker
+11 IF $DATA(^XTMP("BSTSCFIX","MAP",DSCID))
SET REMAPTO=^XTMP("BSTSCFIX","MAP",DSCID)
QUIT $SELECT(DSCID'=REMAPTO:REMAPTO,1:"")
+12 ;
+13 ;Attempt to pull the value locally
+14 ;If found, set map and quit
+15 SET DESC=$$DESC^BSTSAPI(DSCID)
+16 IF $PIECE(DESC,U)]""
IF $PIECE(DESC,U,2)]""
SET ^XTMP("BSTSCFIX","MAP",DSCID)=DSCID
QUIT ""
+17 ;
+18 ;Next try remote search - Clear out offline mode flag to ensure call gets made
+19 ;If found, set map and quit
+20 SET (ABORT,FCNT,STS)=0
FOR TRY=1:1:(12*MFAIL)
Begin DoDot:1
+21 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+22 SET STS=$$DSCLKP^BSTSAPI("VAR",DSCID_"^^2")
+23 IF +STS=2
SET ^XTMP("BSTSCFIX","MAP",DSCID)=DSCID
QUIT
+24 IF STS="0^"
QUIT
+25 ;Fail handling
SET FCNT=FCNT+1
IF FCNT'<MFAIL
Begin DoDot:2
+26 SET ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"REPLACE^BSTSCFIX - Looking up DSC ID: "_DSCID)
+27 IF ABORT=1
SET ^XTMP("BSTSCFIX","QUIT")=1
DO ELOG^BSTSVOFL("DSCID LOOKUP UTILITY FAILED ON DSC ID: "_DSCID)
+28 SET FCNT=0
End DoDot:2
End DoDot:1
IF +STS=2!(STS="0^")
QUIT
+29 ;
+30 ;If not found, current term most likely has duplicate term in the concept
+31 ;try to locate the duplicate term
+32 ;
+33 SET BSTSWS("SEARCH")=DSCID
+34 SET REMAPTO=$$DSCLKP(.BSTSWS,MFAIL,FWAIT)
+35 ;
+36 ;Set up mapped entry
+37 SET ^XTMP("BSTSCFIX","MAP",DSCID)=REMAPTO
+38 ;
+39 QUIT REMAPTO
+40 ;
DSCLKP(BSTSWS,MFAIL,FWAIT) ;
+1 ;
+2 NEW SEARCH,STYPE,SLIST,DLIST,NMID,STS,RES,DTSID,REMAPTO,TRY,FCNT,ABORT
+3 ;
+4 ;Initialize Return Value
+5 SET REMAPTO=""
+6 ;
+7 SET SEARCH=$GET(BSTSWS("SEARCH"))
+8 SET STYPE=$GET(BSTSWS("STYPE"))
+9 ;Sorted List
SET SLIST=$NAME(^TMP("BSTSPDET",$JOB))
+10 ;DTS Return List
SET DLIST=$NAME(^TMP("BSTSCMCL",$JOB))
+11 KILL @DLIST,@SLIST
+12 ;
+13 ;Perform Lookup on Concept Id
+14 SET (ABORT,FCNT,STS)=0
FOR TRY=1:1:(12*MFAIL)
Begin DoDot:1
+15 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+16 SET STS=$$DSCSRCH^BSTSCMCL(.BSTSWS,.RES)
IF +STS
QUIT
+17 ;Fail handling
SET FCNT=FCNT+1
IF FCNT'<MFAIL
Begin DoDot:2
+18 SET ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"DSCLKP^BSTSCFIX - Looking up: "_SEARCH)
+19 IF ABORT=1
SET ^XTMP("BSTSCFIX","QUIT")=1
DO ELOG^BSTSVOFL("DSCID LOOKUP UTILITY FAILED ON LOOKUP: "_SEARCH)
+20 SET FCNT=0
End DoDot:2
End DoDot:1
IF +STS
QUIT
+21 ;
+22 SET DTSID=$PIECE($GET(@DLIST@(1)),U)
IF DTSID
Begin DoDot:1
+23 ;
+24 ;Loop through results and retrieve detail
+25 ;
+26 NEW STS,ERSLT,TLIST,STYPE,TCNT
+27 ;
+28 ;Update entry
+29 SET BSTSWS("DTSID")=DTSID
+30 ;
+31 ;Clear result file
+32 KILL @DLIST
+33 ;
+34 ;Get Detail for concept
+35 SET (ABORT,FCNT,STS)=0
FOR TRY=1:1:(12*MFAIL)
Begin DoDot:2
+36 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+37 SET STS=$$DETAIL^BSTSCMCL(.BSTSWS,.ERSLT)
IF +STS
QUIT
+38 ;Fail handling
SET FCNT=FCNT+1
IF FCNT'<MFAIL
Begin DoDot:3
+39 SET ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"DSCLKP^BSTSCFIX - Looking up DTSID: "_DTSID)
+40 IF ABORT=1
SET ^XTMP("BSTSCFIX","QUIT")=1
DO ELOG^BSTSVOFL("DSCID LOOKUP UTILITY FAILED ON DETAIL LOOKUP: "_DTSID)
+41 SET FCNT=0
End DoDot:3
End DoDot:2
IF +STS
QUIT
+42 ;
+43 ;Now loop through synonyms and try to find replacement
+44 SET STYPE=""
FOR
SET STYPE=$ORDER(@DLIST@(1,"SYN",STYPE))
IF STYPE=""
QUIT
SET TCNT=""
FOR
SET TCNT=$ORDER(@DLIST@(1,"SYN",STYPE,TCNT))
IF TCNT=""
QUIT
Begin DoDot:2
+45 ;
+46 NEW TERM,DSC
+47 ;
+48 ;Pull values
+49 SET TERM=$GET(@DLIST@(1,"SYN",STYPE,TCNT,1))
IF TERM=""
QUIT
+50 SET DSC=$PIECE($GET(@DLIST@(1,"SYN",STYPE,TCNT,0)),U)
IF DSC=""
QUIT
+51 ;
+52 ;Remap if already found
+53 IF $DATA(TLIST(TERM))
Begin DoDot:3
+54 ;
+55 ;Only look at the one we passed in
+56 IF DSC'=SEARCH
QUIT
+57 SET REMAPTO=$GET(TLIST(TERM))
End DoDot:3
QUIT
+58 ;
+59 ;Set up entry in array
+60 SET TLIST(TERM)=DSC
End DoDot:2
End DoDot:1
+61 ;
+62 QUIT REMAPTO
+63 ;
STS(RUN,NODE,MSG) ;Enter RUN status entry
+1 ;
+2 IF $GET(RUN)=""
QUIT
+3 IF $GET(NODE)=""
QUIT
+4 ;
+5 ;Enter the status
+6 SET ^XTMP("BSTSCFIX",RUN,NODE)=$GET(MSG)
+7 QUIT
+8 ;
ESTS(RUN,FILE,FIELD,IEN,FROM,TO) ;Log changed entry
+1 ;
+2 IF $GET(RUN)=""
QUIT
+3 IF $GET(FILE)=""
QUIT
+4 IF $GET(FIELD)=""
QUIT
+5 ;
+6 NEW %,%H,%I,X
+7 ;
+8 ;Get the time
+9 DO NOW^%DTC
+10 ;
+11 ;Log the entry
+12 SET ^XTMP("BSTSCFIX",RUN,FILE,FIELD,IEN)=%_U_$GET(DUZ)_U_FROM_U_TO
+13 QUIT
