BSTSUTIL ;GDIT/HS/BEE-Standard Terminology Utility Program ; 5 Nov 2012 9:53 AM
;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
;
Q
;
DTCHG(X1,X2) ;EP - ADD/SUBTRACT FROM DATE
;
NEW X,%H
I $G(X1)="" Q ""
I $G(X2)="" Q ""
;
D C^%DTC
Q X
;
EP2FMDT(MSECS,DTONLY) ;EP - Convert UNIX (EPOCH) Date to FileMan Date (and Time)
;
;Input
; MSECS - UNIX (EPOCH) date - Milliseconds since Jan 1, 1970
; DTONLY (Optional) - If 1, return only date portion
;
;Output
; FDT - FileMan Date format
;
NEW MDATE,MTIME
S DTONLY=$G(DTONLY),DTONLY=$S(DTONLY="1":"1",1:"")
Q:MSECS'?12.13N "" ; Do not convert date beyond 11/19/2280
S MSECS=MSECS\1000
S MDATE=(MSECS\86400+47117)
S MTIME=+(MSECS#86400)
;
Q $$HTFM^XLFDT(MDATE_","_MTIME,DTONLY)
;
EP2EXDT(MSECS,FORMAT) ;EP - Convert UNIX (EPOCH) Date to External Date (and Time)
;
;Input
; MSECS - UNIX (EPOCH) date - Milliseconds since Jan 1, 1970
; FORMAT - XLFDT format field (optional) - default is "5DZ"
;
;Output
; FDT - External Date (Time) format
;
NEW MDATE,MTIME
S FORMAT=$G(FORMAT,"") S:FORMAT="" FORMAT="5DZ"
Q:MSECS'?12.13N "" ; Do not convert date beyond 11/19/2280
S MSECS=MSECS\1000
S MDATE=(MSECS\86400+47117)
S MTIME=+(MSECS#86400)
;
Q $$HTE^XLFDT(MDATE_","_MTIME,FORMAT)
;
FMDT2EP(FDT) ;EP - FileMan Date (and Time) to UNIX (EPOCH) Date
;
;Input
; FDT - FileMan Date (and Time)
;
;Output
; MSECS - UNIX (EPOCH) date - Milliseconds since Jan 1, 1970
;
NEW DOLH,DOLD,DOLT,EPOCH
S DOLH=$$FMTH^XLFDT(FDT)
S DOLD=+$P(DOLH,",")
S DOLT=+$P(DOLH,",",2)
S EPOCH=((DOLD-47117)*86400)+DOLT
;
Q (EPOCH*1000)
;
EXDT2EP(EXDT) ;EP - External Date (and Time) to UNIX (EPOCH) Date
;
;Input
; EXDT - External Date (and Time)
;
;Output
; MSECS - UNIX (EPOCH) date - Milliseconds since Jan 1, 1970
;
NEW DOLH,DOLD,DOLT,EPOCH,X,Y,%DT
S X=EXDT,%DT="TS"
D ^%DT
I Y="-1" Q Y ;Invalid date
;
S DOLH=$$FMTH^XLFDT(Y)
S DOLD=+$P(DOLH,",")
S DOLT=+$P(DOLH,",",2)
S EPOCH=((DOLD-47117)*86400)+DOLT
;
Q (EPOCH*1000)
;
DATE(DATE) ;EP - Convert standard date/time to a FileMan date/time
;Input
; DATE - In a standard format
;Output
; -1 is if it couldn't convert to a FileMan date
; otherwise a standard FileMan date
NEW %DT,X,Y
I DATE[":" D
. I DATE["/",$L(DATE," ")=3 S DATE=$P(DATE," ",1)_"@"_$P(DATE," ",2)_$P(DATE," ",3) Q
. I $L(DATE," ")=3 S DATE=$P(DATE," ",1,2)_"@"_$P(DATE," ",3)
. I $L(DATE," ")>3 S DATE=$P(DATE," ",1,3)_"@"_$P(DATE," ",4,99)
S %DT="TS",X=DATE D ^%DT
I Y=-1 S Y=""
;
Q Y
;
DTS2FMDT(DATE,FORMAT) ;EP - Convert Date/Time from DTS to a FileMan date/time
;Input
; DATE - In a standard format - 'CCYY-MM-DD HH:MM:SS'
; FORMAT - 1 - Return Date only
;
;Output
; -1 is if it couldn't convert to a FileMan date - 'CYYMMDD'
; otherwise a standard FileMan date
NEW %DT,X,Y
;
S %DT="T"
S X=$P(DATE,"-",2)_"/"_$P($P(DATE,"-",3)," ")_"/"_$P(DATE,"-")
;
I $G(FORMAT)'=1 D
. I $P(DATE," ",2)[":" S X=X_"@"_$P($P(DATE,".")," ",2,99)
. S %DT="ST"
D ^%DT
;
I Y=-1 S Y=""
;
Q Y
;
FMDT2XML(DATE) ;EP - Convert Date/Time from FileMan to XML
;Input
; DATE - In a standard FileMan format
;
;Output
; Convert to a XML date - 'CCYY-MM-DD HH:MM:SS'
;
NEW X
S X=$S($E(DATE,1)="2":"19",1:"20")_$E(DATE,2,3)_"-"_$E(DATE,4,5)_"-"_$E(DATE,6,7)_"T00:00:00"
;
Q X
;
SQL2XML(DATE) ;EP - Convert date from SQL to XML formats
;Input
; DATE - In SQL format - 'JUN 13, 2013'
;
;Output
; "" is if it couldn't convert to a XML date - '2013-06-13T00:00:00'
;
;NEW %DT,X,Y,FMDT,M,D
;
;S %DT="TS",X=DATE D ^%DT
;I Y=-1 Q ""
NEW %DT,X,Y,FMDT,M,D
I DATE[":" D
. I DATE["/",$L(DATE," ")=3 S DATE=$P(DATE," ",1)_"@"_$P(DATE," ",2)_$P(DATE," ",3) Q
. I $L(DATE," ")=3 S DATE=$P(DATE," ",1,2)_"@"_$P(DATE," ",3)
. I $L(DATE," ")>3 S DATE=$P(DATE," ",1,3)_"@"_$P(DATE," ",4,99)
S %DT="TS",X=DATE D ^%DT
I Y=-1 Q ""
;
S Y=$$FMTE^XLFDT($P(Y,"."),"7")
S M=$P(Y,"/",2) S:$L(M)=1 M="0"_M
S D=$P(Y,"/",3) S:$L(D)=1 D="0"_D
S Y=$P(Y,"/")
S Y=Y_"-"_M_"-"_D_"T00:00:01"
Q Y
;
FMTE(Y) ;EP - Convert Fileman Date/Time to 'MMM DD, CCYY HH:MM:SS' format.
;Description
; Receives Date (Y) in FileMan format and returns formatted date.
;
;Input
; Y - FileMan date/time (i.e. 3051024.123456).
;
;Output
; Date/Time in External format (i.e. OCT 24,2005 12:34:56).
;
NEW DATM,XX,I,V,DA
S DATM=$TR($$FMTE^DILIBF(Y,"5U"),"@"," ")
I DATM["24:00" S DATM=$P(DATM," ",1,2)_" 00:00"
S XX="" F I=1:1:$L(DATM) S V=$E(DATM,I,I),XX=XX_V I V="," S XX=XX_" "
S DATM=XX
Q DATM
;
WRAP(OUT,TEXT,RM,IND) ;EP - Wrap the text and insert in array
;
NEW SP
;
I $G(TEXT)="" S OUT(1)="" Q
I $G(RM)="" Q
I $G(IND)="" S IND=0
S $P(SP," ",80)=" "
;
;Strip out $c(10)
S TEXT=$TR(TEXT,$C(10))
;
F I $L(TEXT)>0 D Q:$L(TEXT)=0
. NEW PIECE,SPACE,LINE
. S PIECE=$E(TEXT,1,RM)
. ;
. ;Handle Line feeds
. I PIECE[$C(13) D Q
.. NEW LINE,I
.. S LINE=$P(PIECE,$C(13)) S:LINE="" LINE=" "
.. S OUT=$G(OUT)+1,OUT(OUT)=LINE
.. F I=1:1:$L(PIECE) I $E(PIECE,I)=$C(13) Q
.. S TEXT=$E(SP,1,IND)_$$STZ($E(TEXT,I+1,9999999999))
. ;
. ;Check if line is less than right margin
. I $L(PIECE)<RM S OUT=$G(OUT)+1,OUT(OUT)=PIECE,TEXT="" Q
. ;
. ;Locate last space in line and handle if no space
. F SPACE=$L(PIECE):-1:(IND+1) I $E(PIECE,SPACE)=" " Q
. I (SPACE=(IND+1)) D S:TEXT]"" TEXT=$E(SP,1,IND)_TEXT Q
.. S LINE=PIECE,OUT=$G(OUT)+1,OUT(OUT)=LINE,TEXT=$$STZ($E(TEXT,RM+1,999999999))
. ;
. ;Handle line with space
. S LINE=$E(PIECE,1,SPACE-1),OUT=$G(OUT)+1,OUT(OUT)=LINE,TEXT=$$STZ($E(TEXT,SPACE+1,999999999))
. S:TEXT]"" TEXT=$E(SP,1,IND)_TEXT
;
Q
;
STZ(TEXT) ;EP - Strip Leading Spaces
NEW START
F START=1:1:$L(TEXT) I $E(TEXT,START)'=" " Q
Q $E(TEXT,START,9999999999)
;
ICDSX ;EP - Set cross-reference
NEW CSET
S CSET=$$CSET() I CSET="" Q
S ^BSTS(9002318.4,"F",CSET,X,DA(1))=""
Q
;
ICDKX ;EP - Kill cross-reference
NEW CSET
S CSET=$$CSET() I CSET="" Q
K ^BSTS(9002318.4,"F",CSET,X,DA(1))
Q
;
SBSX ;EP - Set cross-reference
NEW CSET
S CSET=$$CSET() I CSET="" Q
S ^BSTS(9002318.4,"E",CSET,X,DA(1),DA)=""
Q
;
SBKX ;EP - Kill cross-reference
NEW CSET
S CSET=$$CSET() I CSET="" Q
K ^BSTS(9002318.4,"E",CSET,X,DA(1),DA)
Q
;
NDSX ;EP - Set cross-reference
NEW CSET
S CSET=$$CSET() I CSET="" Q
S ^BSTS(9002318.4,"G",CSET,X,DA(1),DA)=""
Q
;
NDKX ;EP - Kill cross-reference
NEW CSET
S CSET=$$CSET() I CSET="" Q
K ^BSTS(9002318.4,"G",CSET,X,DA(1),DA)
Q
;
VUSX ;EP - Set cross-reference
NEW CSET
S CSET=$$CSET() I CSET="" Q
S ^BSTS(9002318.4,"H",CSET,X,DA(1),DA)=""
Q
;
VUKX ;EP - Kill cross-reference
NEW CSET
S CSET=$$CSET() I CSET="" Q
K ^BSTS(9002318.4,"H",CSET,X,DA(1),DA)
Q
;
I2SSX ;EP - Set cross-reference
NEW CSET
S CSET=$$CSET() I CSET="" Q
S ^BSTS(9002318.4,"I",CSET,X,DA(1))=""
Q
;
I2SKX ;EP - Kill cross-reference
NEW CSET
S CSET=$$CSET() I CSET="" Q
K ^BSTS(9002318.4,"I",CSET,X,DA(1))
Q
;
CSET() ;EP - Get the codeset
Q $P($G(^BSTS(9002318.4,DA(1),0)),U,7)
;
DEL ;EP - Delete a codeset from cache
;
NEW NMID,C,DIR,X,Y
;
S DIR(0)="F"
S DIR("A")="Enter codeset IEN to clear out: "
D ^DIR
I +Y<1 Q
S NMID=+Y
;
I '$D(^BSTS(9002318.3,"C",NMID)) W !!,"No entries defined for codeset" H 2 Q
;
;Loop through index and clear out each entry
W !!,"DELETING TERMS"
S C="" F S C=$O(^BSTS(9002318.3,"C",NMID,C)) Q:C="" D
. NEW TIEN,DA,DIK
. S TIEN="" F S TIEN=$O(^BSTS(9002318.3,"C",NMID,C,TIEN)) Q:TIEN="" D
.. W !,"TIEN: ",TIEN,?10,$G(^BSTS(9002318.3,TIEN,0))
.. S DA=TIEN,DIK="^BSTS(9002318.3,"
.. D ^DIK
;
W !!,"DELETING CONCEPTS"
S C="" F S C=$O(^BSTS(9002318.4,"C",NMID,C)) Q:C="" D
. NEW CIEN,DA,DIK
. S CIEN="" F S CIEN=$O(^BSTS(9002318.4,"C",NMID,C,CIEN)) Q:CIEN="" D
.. W !,"CIEN: ",CIEN,?10,$G(^BSTS(9002318.4,CIEN,0))
.. S DA=CIEN,DIK="^BSTS(9002318.4,"
.. D ^DIK
Q
;
ICD10(VDT) ;EP - Determine to return ICD9 or ICD10
;
;Input value
; VDT - Date to check on
;
;Output value
; 1 - Use ICD10
; 0 - Use ICD9
;
S:$G(VDT)="" VDT=DT
;
I $$VERSION^XPDUTL("AICD")>3.51,$$IMP^ICDEXA(30)'>VDT Q 1
Q 0
;
COUNT ;Return totals of codesets and subsets
NEW SB,CD,S,I,C
;
;Get subsets first
S S="" F S S=$O(^BSTS(9002318.4,"E",9,S)) Q:S="" S I="" F S I=$O(^BSTS(9002318.4,"E",9,S,I)) Q:I="" S SB(S)=$G(SB(S))+1
;
;Now get codesets
S C="" F S C=$O(^BSTS(9002318.4,"C",C)) Q:C="" S I="" F S I=$O(^BSTS(9002318.4,"C",C,I)) Q:I="" S CD(C)=$G(CD(C))+1
;
W !,"Subsets: "
S S="" F S S=$O(SB(S)) Q:S="" W !,S,"=",SB(S)
W !!,"Codesets: "
S C="" F S C=$O(CD(C)) Q:C="" W !,C,"=",CD(C)
Q
;
TKO(STR,VAL) ;EP - Take off ending character
;
;Description
; This will take off the ending character at the end of
; a string
;Input
; STR - String of data
; VAL - Delimiter character
;Output
; same STR without the ending character
;
I $G(STR)="" Q ""
I $G(VAL)="" Q ""
;
NEW LV
S LV=$L(VAL)
I $E(STR,$L(STR)-(LV-1),$L(STR))=VAL S STR=$E(STR,1,$L(STR)-LV)
;
Q STR
;
CKJOB(ZTSK) ;Check the status of a job
;
NEW ST
;
;Check on current job
D STAT^%ZTLOAD
S ST=$G(ZTSK(2))
;
;Pending - Don't start
I ST["Pending" Q 1
;
;Running - Don't start
I ST["Running" Q 1
;
;Finished/Inactive/Interrupted/Undefined - clear and allow start
Q 0
;
CDJOB(NMIEN,TYPE,JTIME) ;EP - Kick off BSTS Background Process
;
NEW TJOB,ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BSTSUPD,ERROR,FIELD,ZTSK
;
;Determine field to pull
I TYPE="C" S FIELD=".07" ;Regular Codeset
I TYPE="I10" S FIELD=".07" ;ICD10 Autocodeable
I TYPE="I9" S FIELD=".07" ;ICD9 Autocodeable
I TYPE="CCD" S FIELD=".07" ;Custom Codesets
I (TYPE="S")!(TYPE="S1552") S FIELD=".08" ;Subset
I TYPE="I" S FIELD=".09" ;ICD9 TO SNOMED
;
;Get the previous task number
S TJOB=$$GET1^DIQ(9002318.1,NMIEN_",",FIELD,"I")
;
;Running or pending - Do not start
I TJOB]"",$$CKJOB(TJOB) Q
;
;Other status - clear task
I TJOB]"" D
. NEW BSTSUPD,ERR
. S BSTSUPD(9002318.1,NMIEN_",",FIELD)="@"
. D FILE^DIE("","BSTSUPD","ERR")
;
;Queue the process off in the background
K IO("Q")
;
;Regular codeset refresh
I TYPE="C" D
. S ZTRTN="RES^BSTSVRSN",ZTDESC="BSTS - Refresh Codeset"
. S ZTSAVE("NMIEN")=""
;
;Subset refresh
I TYPE="S" D
. S ZTRTN="SUB^BSTSVRSN",ZTDESC="BSTS - Update IHS Standard Terminology Subsets"
. S ZTSAVE("NMIEN")=""
;
;Subset refresh
I TYPE="S1552" D
. S ZTRTN="SUB^BSTSVRXN",ZTDESC="BSTS - Update IHS Standard Terminology RxNorm Subsets"
. S ZTSAVE("NMIEN")=""
;
;ICD9 to SNOMED process
I TYPE="I" D
. S ZTRTN="JOB^BSTSUTIL",ZTDESC="BSTS - Preload SNOMED Concepts"
. S ZTSAVE("NMIEN")=""
;
;ICD10 Autocodeable
I TYPE="I10" D
. S ZTRTN="ACODE^BSTSVRSC",ZTDESC="BSTS - Refresh ICD-10 Autocodeable Codeset"
. S ZTSAVE("NMIEN")=""
;
;Custom Codesets
I TYPE="CCD" D
. S ZTRTN="CDST^BSTSVRSC",ZTDESC="BSTS - Update IHS Standard Terminology Local Cache Refresh"
. S ZTSAVE("NMIEN")=""
;
;ICD9 Autocodeable
I TYPE="I9" D
. S ZTRTN="A9CODE^BSTSVRSC",ZTDESC="BSTS - Refresh ICD-9 Autocodeable Codeset"
;
S ZTIO=""
I +$G(JTIME) S ZTDTH=$$JBTIME^BSTSVOFL()
E S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,2)
D ^%ZTLOAD
;
;Save task to file
S BSTSUPD(9002318.1,NMIEN_",",FIELD)=$G(ZTSK)
D FILE^DIE("","BSTSUPD","ERR")
;
Q
;
PLOAD(NMIEN) ;Job off process to pre-load SNOMED concepts at site
;
;Quit if process has run before
I $$GET1^DIQ(9002318.1,NMIEN_",",".09","I")]"" Q 0
;
;Do not perform check if background process is running
L +^BSTS(9002318.1,0):0 E Q 1
L -^BSTS(9002318.1,0)
;
;Make sure ICD9 to SNOMED background process isn't already running
L +^TMP("BSTSICD2SMD"):0 E Q 1
L -^TMP("BSTSICD2SMD")
;
;Queue the process off in the background
D CDJOB^BSTSUTIL(NMIEN,"I")
;
Q 0
;
JOB ;Background process to preload SNOMED concepts corresponding to ICD9 values
;
;Lock process
L +^TMP("BSTSICD2SMD"):0 E Q
;
NEW AUPNPROB,JTMP,UID,JTMP,SVAR,MFAIL,FWAIT,ABORT
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S JTMP=$NA(^TMP("BSTS1POS",UID))
S SVAR=$NA(^TMP("BSTSRPC1",UID))
K @JTMP,^XTMP("BSTSLCMP","QUIT")
;
;Retrieve Failover Variables
S MFAIL=$$FPARMS^BSTSVOFL()
S FWAIT=$P(MFAIL,U,2)
S MFAIL=$P(MFAIL,U)
;
S AUPNPROB=0 F S AUPNPROB=$O(^AUPNPROB(AUPNPROB)) Q:'AUPNPROB D Q:$D(^XTMP("BSTSLCMP","QUIT"))
. NEW ICD9,STS,TRY,FCNT
. ;
. ;Reset scratch global
. K @SVAR
. ;
. ;Get the ICD9 code
. S ICD9=$$GET1^DIQ(9000011,AUPNPROB,.01,"E") Q:ICD9=""
. ;
. ;Strip off trailing "."
. S ICD9=$$TKO^BSTSUTIL(ICD9,".")
. ;
. ;Skip if that ICD9 already processed
. I $D(@JTMP@(ICD9)) Q
. ;
. ;Pre-load the SNOMED for that ICD9 - Try call maximum of 12 times
. 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=$$ICD2SMD^BSTSAPI(SVAR,ICD9_"^BCIX^2") I +STS=2!(STS="0^") Q
.. S FCNT=FCNT+1 I FCNT'<MFAIL D ;Fail handling
... S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"JOB^BSTSUTIL - Looking up ICD9: "_ICD9)
... I ABORT=1 S ^XTMP("BSTSLCMP","QUIT")=1 D ELOG^BSTSVOFL("ICD9 TO SNOMED LOOKUP FAILED ON ICD9: "_ICD9)
... S FCNT=0
. ;
. ;Mark the entry processed
. S @JTMP@(ICD9)=""
;
;Remove entry when done
K @JTMP
;
;Unlock process
L -^TMP("BSTSICD2SMD")
;
NEW FAIL
S FAIL=$S($D(^XTMP("BSTSLCMP","QUIT")):1,1:0)
K ^XTMP("BSTSLCMP")
S:FAIL ^XTMP("BSTSLCMP","QUIT")=1
;
Q
BSTSUTIL ;GDIT/HS/BEE-Standard Terminology Utility Program ; 5 Nov 2012 9:53 AM
+1 ;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
+2 ;
+3 QUIT
+4 ;
DTCHG(X1,X2) ;EP - ADD/SUBTRACT FROM DATE
+1 ;
+2 NEW X,%H
+3 IF $GET(X1)=""
QUIT ""
+4 IF $GET(X2)=""
QUIT ""
+5 ;
+6 DO C^%DTC
+7 QUIT X
+8 ;
EP2FMDT(MSECS,DTONLY) ;EP - Convert UNIX (EPOCH) Date to FileMan Date (and Time)
+1 ;
+2 ;Input
+3 ; MSECS - UNIX (EPOCH) date - Milliseconds since Jan 1, 1970
+4 ; DTONLY (Optional) - If 1, return only date portion
+5 ;
+6 ;Output
+7 ; FDT - FileMan Date format
+8 ;
+9 NEW MDATE,MTIME
+10 SET DTONLY=$GET(DTONLY)
SET DTONLY=$SELECT(DTONLY="1":"1",1:"")
+11 ; Do not convert date beyond 11/19/2280
IF MSECS'?12.13N
QUIT ""
+12 SET MSECS=MSECS\1000
+13 SET MDATE=(MSECS\86400+47117)
+14 SET MTIME=+(MSECS#86400)
+15 ;
+16 QUIT $$HTFM^XLFDT(MDATE_","_MTIME,DTONLY)
+17 ;
EP2EXDT(MSECS,FORMAT) ;EP - Convert UNIX (EPOCH) Date to External Date (and Time)
+1 ;
+2 ;Input
+3 ; MSECS - UNIX (EPOCH) date - Milliseconds since Jan 1, 1970
+4 ; FORMAT - XLFDT format field (optional) - default is "5DZ"
+5 ;
+6 ;Output
+7 ; FDT - External Date (Time) format
+8 ;
+9 NEW MDATE,MTIME
+10 SET FORMAT=$GET(FORMAT,"")
IF FORMAT=""
SET FORMAT="5DZ"
+11 ; Do not convert date beyond 11/19/2280
IF MSECS'?12.13N
QUIT ""
+12 SET MSECS=MSECS\1000
+13 SET MDATE=(MSECS\86400+47117)
+14 SET MTIME=+(MSECS#86400)
+15 ;
+16 QUIT $$HTE^XLFDT(MDATE_","_MTIME,FORMAT)
+17 ;
FMDT2EP(FDT) ;EP - FileMan Date (and Time) to UNIX (EPOCH) Date
+1 ;
+2 ;Input
+3 ; FDT - FileMan Date (and Time)
+4 ;
+5 ;Output
+6 ; MSECS - UNIX (EPOCH) date - Milliseconds since Jan 1, 1970
+7 ;
+8 NEW DOLH,DOLD,DOLT,EPOCH
+9 SET DOLH=$$FMTH^XLFDT(FDT)
+10 SET DOLD=+$PIECE(DOLH,",")
+11 SET DOLT=+$PIECE(DOLH,",",2)
+12 SET EPOCH=((DOLD-47117)*86400)+DOLT
+13 ;
+14 QUIT (EPOCH*1000)
+15 ;
EXDT2EP(EXDT) ;EP - External Date (and Time) to UNIX (EPOCH) Date
+1 ;
+2 ;Input
+3 ; EXDT - External Date (and Time)
+4 ;
+5 ;Output
+6 ; MSECS - UNIX (EPOCH) date - Milliseconds since Jan 1, 1970
+7 ;
+8 NEW DOLH,DOLD,DOLT,EPOCH,X,Y,%DT
+9 SET X=EXDT
SET %DT="TS"
+10 DO ^%DT
+11 ;Invalid date
IF Y="-1"
QUIT Y
+12 ;
+13 SET DOLH=$$FMTH^XLFDT(Y)
+14 SET DOLD=+$PIECE(DOLH,",")
+15 SET DOLT=+$PIECE(DOLH,",",2)
+16 SET EPOCH=((DOLD-47117)*86400)+DOLT
+17 ;
+18 QUIT (EPOCH*1000)
+19 ;
DATE(DATE) ;EP - Convert standard date/time to a FileMan date/time
+1 ;Input
+2 ; DATE - In a standard format
+3 ;Output
+4 ; -1 is if it couldn't convert to a FileMan date
+5 ; otherwise a standard FileMan date
+6 NEW %DT,X,Y
+7 IF DATE[":"
Begin DoDot:1
+8 IF DATE["/"
IF $LENGTH(DATE," ")=3
SET DATE=$PIECE(DATE," ",1)_"@"_$PIECE(DATE," ",2)_$PIECE(DATE," ",3)
QUIT
+9 IF $LENGTH(DATE," ")=3
SET DATE=$PIECE(DATE," ",1,2)_"@"_$PIECE(DATE," ",3)
+10 IF $LENGTH(DATE," ")>3
SET DATE=$PIECE(DATE," ",1,3)_"@"_$PIECE(DATE," ",4,99)
End DoDot:1
+11 SET %DT="TS"
SET X=DATE
DO ^%DT
+12 IF Y=-1
SET Y=""
+13 ;
+14 QUIT Y
+15 ;
DTS2FMDT(DATE,FORMAT) ;EP - Convert Date/Time from DTS to a FileMan date/time
+1 ;Input
+2 ; DATE - In a standard format - 'CCYY-MM-DD HH:MM:SS'
+3 ; FORMAT - 1 - Return Date only
+4 ;
+5 ;Output
+6 ; -1 is if it couldn't convert to a FileMan date - 'CYYMMDD'
+7 ; otherwise a standard FileMan date
+8 NEW %DT,X,Y
+9 ;
+10 SET %DT="T"
+11 SET X=$PIECE(DATE,"-",2)_"/"_$PIECE($PIECE(DATE,"-",3)," ")_"/"_$PIECE(DATE,"-")
+12 ;
+13 IF $GET(FORMAT)'=1
Begin DoDot:1
+14 IF $PIECE(DATE," ",2)[":"
SET X=X_"@"_$PIECE($PIECE(DATE,".")," ",2,99)
+15 SET %DT="ST"
End DoDot:1
+16 DO ^%DT
+17 ;
+18 IF Y=-1
SET Y=""
+19 ;
+20 QUIT Y
+21 ;
FMDT2XML(DATE) ;EP - Convert Date/Time from FileMan to XML
+1 ;Input
+2 ; DATE - In a standard FileMan format
+3 ;
+4 ;Output
+5 ; Convert to a XML date - 'CCYY-MM-DD HH:MM:SS'
+6 ;
+7 NEW X
+8 SET X=$SELECT($EXTRACT(DATE,1)="2":"19",1:"20")_$EXTRACT(DATE,2,3)_"-"_$EXTRACT(DATE,4,5)_"-"_$EXTRACT(DATE,6,7)_"T00:00:00"
+9 ;
+10 QUIT X
+11 ;
SQL2XML(DATE) ;EP - Convert date from SQL to XML formats
+1 ;Input
+2 ; DATE - In SQL format - 'JUN 13, 2013'
+3 ;
+4 ;Output
+5 ; "" is if it couldn't convert to a XML date - '2013-06-13T00:00:00'
+6 ;
+7 ;NEW %DT,X,Y,FMDT,M,D
+8 ;
+9 ;S %DT="TS",X=DATE D ^%DT
+10 ;I Y=-1 Q ""
+11 NEW %DT,X,Y,FMDT,M,D
+12 IF DATE[":"
Begin DoDot:1
+13 IF DATE["/"
IF $LENGTH(DATE," ")=3
SET DATE=$PIECE(DATE," ",1)_"@"_$PIECE(DATE," ",2)_$PIECE(DATE," ",3)
QUIT
+14 IF $LENGTH(DATE," ")=3
SET DATE=$PIECE(DATE," ",1,2)_"@"_$PIECE(DATE," ",3)
+15 IF $LENGTH(DATE," ")>3
SET DATE=$PIECE(DATE," ",1,3)_"@"_$PIECE(DATE," ",4,99)
End DoDot:1
+16 SET %DT="TS"
SET X=DATE
DO ^%DT
+17 IF Y=-1
QUIT ""
+18 ;
+19 SET Y=$$FMTE^XLFDT($PIECE(Y,"."),"7")
+20 SET M=$PIECE(Y,"/",2)
IF $LENGTH(M)=1
SET M="0"_M
+21 SET D=$PIECE(Y,"/",3)
IF $LENGTH(D)=1
SET D="0"_D
+22 SET Y=$PIECE(Y,"/")
+23 SET Y=Y_"-"_M_"-"_D_"T00:00:01"
+24 QUIT Y
+25 ;
FMTE(Y) ;EP - Convert Fileman Date/Time to 'MMM DD, CCYY HH:MM:SS' format.
+1 ;Description
+2 ; Receives Date (Y) in FileMan format and returns formatted date.
+3 ;
+4 ;Input
+5 ; Y - FileMan date/time (i.e. 3051024.123456).
+6 ;
+7 ;Output
+8 ; Date/Time in External format (i.e. OCT 24,2005 12:34:56).
+9 ;
+10 NEW DATM,XX,I,V,DA
+11 SET DATM=$TRANSLATE($$FMTE^DILIBF(Y,"5U"),"@"," ")
+12 IF DATM["24:00"
SET DATM=$PIECE(DATM," ",1,2)_" 00:00"
+13 SET XX=""
FOR I=1:1:$LENGTH(DATM)
SET V=$EXTRACT(DATM,I,I)
SET XX=XX_V
IF V=","
SET XX=XX_" "
+14 SET DATM=XX
+15 QUIT DATM
+16 ;
WRAP(OUT,TEXT,RM,IND) ;EP - Wrap the text and insert in array
+1 ;
+2 NEW SP
+3 ;
+4 IF $GET(TEXT)=""
SET OUT(1)=""
QUIT
+5 IF $GET(RM)=""
QUIT
+6 IF $GET(IND)=""
SET IND=0
+7 SET $PIECE(SP," ",80)=" "
+8 ;
+9 ;Strip out $c(10)
+10 SET TEXT=$TRANSLATE(TEXT,$CHAR(10))
+11 ;
+12 FOR
IF $LENGTH(TEXT)>0
Begin DoDot:1
+13 NEW PIECE,SPACE,LINE
+14 SET PIECE=$EXTRACT(TEXT,1,RM)
+15 ;
+16 ;Handle Line feeds
+17 IF PIECE[$CHAR(13)
Begin DoDot:2
+18 NEW LINE,I
+19 SET LINE=$PIECE(PIECE,$CHAR(13))
IF LINE=""
SET LINE=" "
+20 SET OUT=$GET(OUT)+1
SET OUT(OUT)=LINE
+21 FOR I=1:1:$LENGTH(PIECE)
IF $EXTRACT(PIECE,I)=$CHAR(13)
QUIT
+22 SET TEXT=$EXTRACT(SP,1,IND)_$$STZ($EXTRACT(TEXT,I+1,9999999999))
End DoDot:2
QUIT
+23 ;
+24 ;Check if line is less than right margin
+25 IF $LENGTH(PIECE)<RM
SET OUT=$GET(OUT)+1
SET OUT(OUT)=PIECE
SET TEXT=""
QUIT
+26 ;
+27 ;Locate last space in line and handle if no space
+28 FOR SPACE=$LENGTH(PIECE):-1:(IND+1)
IF $EXTRACT(PIECE,SPACE)=" "
QUIT
+29 IF (SPACE=(IND+1))
Begin DoDot:2
+30 SET LINE=PIECE
SET OUT=$GET(OUT)+1
SET OUT(OUT)=LINE
SET TEXT=$$STZ($EXTRACT(TEXT,RM+1,999999999))
End DoDot:2
IF TEXT]""
SET TEXT=$EXTRACT(SP,1,IND)_TEXT
QUIT
+31 ;
+32 ;Handle line with space
+33 SET LINE=$EXTRACT(PIECE,1,SPACE-1)
SET OUT=$GET(OUT)+1
SET OUT(OUT)=LINE
SET TEXT=$$STZ($EXTRACT(TEXT,SPACE+1,999999999))
+34 IF TEXT]""
SET TEXT=$EXTRACT(SP,1,IND)_TEXT
End DoDot:1
IF $LENGTH(TEXT)=0
QUIT
+35 ;
+36 QUIT
+37 ;
STZ(TEXT) ;EP - Strip Leading Spaces
+1 NEW START
+2 FOR START=1:1:$LENGTH(TEXT)
IF $EXTRACT(TEXT,START)'=" "
QUIT
+3 QUIT $EXTRACT(TEXT,START,9999999999)
+4 ;
ICDSX ;EP - Set cross-reference
+1 NEW CSET
+2 SET CSET=$$CSET()
IF CSET=""
QUIT
+3 SET ^BSTS(9002318.4,"F",CSET,X,DA(1))=""
+4 QUIT
+5 ;
ICDKX ;EP - Kill cross-reference
+1 NEW CSET
+2 SET CSET=$$CSET()
IF CSET=""
QUIT
+3 KILL ^BSTS(9002318.4,"F",CSET,X,DA(1))
+4 QUIT
+5 ;
SBSX ;EP - Set cross-reference
+1 NEW CSET
+2 SET CSET=$$CSET()
IF CSET=""
QUIT
+3 SET ^BSTS(9002318.4,"E",CSET,X,DA(1),DA)=""
+4 QUIT
+5 ;
SBKX ;EP - Kill cross-reference
+1 NEW CSET
+2 SET CSET=$$CSET()
IF CSET=""
QUIT
+3 KILL ^BSTS(9002318.4,"E",CSET,X,DA(1),DA)
+4 QUIT
+5 ;
NDSX ;EP - Set cross-reference
+1 NEW CSET
+2 SET CSET=$$CSET()
IF CSET=""
QUIT
+3 SET ^BSTS(9002318.4,"G",CSET,X,DA(1),DA)=""
+4 QUIT
+5 ;
NDKX ;EP - Kill cross-reference
+1 NEW CSET
+2 SET CSET=$$CSET()
IF CSET=""
QUIT
+3 KILL ^BSTS(9002318.4,"G",CSET,X,DA(1),DA)
+4 QUIT
+5 ;
VUSX ;EP - Set cross-reference
+1 NEW CSET
+2 SET CSET=$$CSET()
IF CSET=""
QUIT
+3 SET ^BSTS(9002318.4,"H",CSET,X,DA(1),DA)=""
+4 QUIT
+5 ;
VUKX ;EP - Kill cross-reference
+1 NEW CSET
+2 SET CSET=$$CSET()
IF CSET=""
QUIT
+3 KILL ^BSTS(9002318.4,"H",CSET,X,DA(1),DA)
+4 QUIT
+5 ;
I2SSX ;EP - Set cross-reference
+1 NEW CSET
+2 SET CSET=$$CSET()
IF CSET=""
QUIT
+3 SET ^BSTS(9002318.4,"I",CSET,X,DA(1))=""
+4 QUIT
+5 ;
I2SKX ;EP - Kill cross-reference
+1 NEW CSET
+2 SET CSET=$$CSET()
IF CSET=""
QUIT
+3 KILL ^BSTS(9002318.4,"I",CSET,X,DA(1))
+4 QUIT
+5 ;
CSET() ;EP - Get the codeset
+1 QUIT $PIECE($GET(^BSTS(9002318.4,DA(1),0)),U,7)
+2 ;
DEL ;EP - Delete a codeset from cache
+1 ;
+2 NEW NMID,C,DIR,X,Y
+3 ;
+4 SET DIR(0)="F"
+5 SET DIR("A")="Enter codeset IEN to clear out: "
+6 DO ^DIR
+7 IF +Y<1
QUIT
+8 SET NMID=+Y
+9 ;
+10 IF '$DATA(^BSTS(9002318.3,"C",NMID))
WRITE !!,"No entries defined for codeset"
HANG 2
QUIT
+11 ;
+12 ;Loop through index and clear out each entry
+13 WRITE !!,"DELETING TERMS"
+14 SET C=""
FOR
SET C=$ORDER(^BSTS(9002318.3,"C",NMID,C))
IF C=""
QUIT
Begin DoDot:1
+15 NEW TIEN,DA,DIK
+16 SET TIEN=""
FOR
SET TIEN=$ORDER(^BSTS(9002318.3,"C",NMID,C,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+17 WRITE !,"TIEN: ",TIEN,?10,$GET(^BSTS(9002318.3,TIEN,0))
+18 SET DA=TIEN
SET DIK="^BSTS(9002318.3,"
+19 DO ^DIK
End DoDot:2
End DoDot:1
+20 ;
+21 WRITE !!,"DELETING CONCEPTS"
+22 SET C=""
FOR
SET C=$ORDER(^BSTS(9002318.4,"C",NMID,C))
IF C=""
QUIT
Begin DoDot:1
+23 NEW CIEN,DA,DIK
+24 SET CIEN=""
FOR
SET CIEN=$ORDER(^BSTS(9002318.4,"C",NMID,C,CIEN))
IF CIEN=""
QUIT
Begin DoDot:2
+25 WRITE !,"CIEN: ",CIEN,?10,$GET(^BSTS(9002318.4,CIEN,0))
+26 SET DA=CIEN
SET DIK="^BSTS(9002318.4,"
+27 DO ^DIK
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
ICD10(VDT) ;EP - Determine to return ICD9 or ICD10
+1 ;
+2 ;Input value
+3 ; VDT - Date to check on
+4 ;
+5 ;Output value
+6 ; 1 - Use ICD10
+7 ; 0 - Use ICD9
+8 ;
+9 IF $GET(VDT)=""
SET VDT=DT
+10 ;
+11 IF $$VERSION^XPDUTL("AICD")>3.51
IF $$IMP^ICDEXA(30)'>VDT
QUIT 1
+12 QUIT 0
+13 ;
COUNT ;Return totals of codesets and subsets
+1 NEW SB,CD,S,I,C
+2 ;
+3 ;Get subsets first
+4 SET S=""
FOR
SET S=$ORDER(^BSTS(9002318.4,"E",9,S))
IF S=""
QUIT
SET I=""
FOR
SET I=$ORDER(^BSTS(9002318.4,"E",9,S,I))
IF I=""
QUIT
SET SB(S)=$GET(SB(S))+1
+5 ;
+6 ;Now get codesets
+7 SET C=""
FOR
SET C=$ORDER(^BSTS(9002318.4,"C",C))
IF C=""
QUIT
SET I=""
FOR
SET I=$ORDER(^BSTS(9002318.4,"C",C,I))
IF I=""
QUIT
SET CD(C)=$GET(CD(C))+1
+8 ;
+9 WRITE !,"Subsets: "
+10 SET S=""
FOR
SET S=$ORDER(SB(S))
IF S=""
QUIT
WRITE !,S,"=",SB(S)
+11 WRITE !!,"Codesets: "
+12 SET C=""
FOR
SET C=$ORDER(CD(C))
IF C=""
QUIT
WRITE !,C,"=",CD(C)
+13 QUIT
+14 ;
TKO(STR,VAL) ;EP - Take off ending character
+1 ;
+2 ;Description
+3 ; This will take off the ending character at the end of
+4 ; a string
+5 ;Input
+6 ; STR - String of data
+7 ; VAL - Delimiter character
+8 ;Output
+9 ; same STR without the ending character
+10 ;
+11 IF $GET(STR)=""
QUIT ""
+12 IF $GET(VAL)=""
QUIT ""
+13 ;
+14 NEW LV
+15 SET LV=$LENGTH(VAL)
+16 IF $EXTRACT(STR,$LENGTH(STR)-(LV-1),$LENGTH(STR))=VAL
SET STR=$EXTRACT(STR,1,$LENGTH(STR)-LV)
+17 ;
+18 QUIT STR
+19 ;
CKJOB(ZTSK) ;Check the status of a job
+1 ;
+2 NEW ST
+3 ;
+4 ;Check on current job
+5 DO STAT^%ZTLOAD
+6 SET ST=$GET(ZTSK(2))
+7 ;
+8 ;Pending - Don't start
+9 IF ST["Pending"
QUIT 1
+10 ;
+11 ;Running - Don't start
+12 IF ST["Running"
QUIT 1
+13 ;
+14 ;Finished/Inactive/Interrupted/Undefined - clear and allow start
+15 QUIT 0
+16 ;
CDJOB(NMIEN,TYPE,JTIME) ;EP - Kick off BSTS Background Process
+1 ;
+2 NEW TJOB,ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BSTSUPD,ERROR,FIELD,ZTSK
+3 ;
+4 ;Determine field to pull
+5 ;Regular Codeset
IF TYPE="C"
SET FIELD=".07"
+6 ;ICD10 Autocodeable
IF TYPE="I10"
SET FIELD=".07"
+7 ;ICD9 Autocodeable
IF TYPE="I9"
SET FIELD=".07"
+8 ;Custom Codesets
IF TYPE="CCD"
SET FIELD=".07"
+9 ;Subset
IF (TYPE="S")!(TYPE="S1552")
SET FIELD=".08"
+10 ;ICD9 TO SNOMED
IF TYPE="I"
SET FIELD=".09"
+11 ;
+12 ;Get the previous task number
+13 SET TJOB=$$GET1^DIQ(9002318.1,NMIEN_",",FIELD,"I")
+14 ;
+15 ;Running or pending - Do not start
+16 IF TJOB]""
IF $$CKJOB(TJOB)
QUIT
+17 ;
+18 ;Other status - clear task
+19 IF TJOB]""
Begin DoDot:1
+20 NEW BSTSUPD,ERR
+21 SET BSTSUPD(9002318.1,NMIEN_",",FIELD)="@"
+22 DO FILE^DIE("","BSTSUPD","ERR")
End DoDot:1
+23 ;
+24 ;Queue the process off in the background
+25 KILL IO("Q")
+26 ;
+27 ;Regular codeset refresh
+28 IF TYPE="C"
Begin DoDot:1
+29 SET ZTRTN="RES^BSTSVRSN"
SET ZTDESC="BSTS - Refresh Codeset"
+30 SET ZTSAVE("NMIEN")=""
End DoDot:1
+31 ;
+32 ;Subset refresh
+33 IF TYPE="S"
Begin DoDot:1
+34 SET ZTRTN="SUB^BSTSVRSN"
SET ZTDESC="BSTS - Update IHS Standard Terminology Subsets"
+35 SET ZTSAVE("NMIEN")=""
End DoDot:1
+36 ;
+37 ;Subset refresh
+38 IF TYPE="S1552"
Begin DoDot:1
+39 SET ZTRTN="SUB^BSTSVRXN"
SET ZTDESC="BSTS - Update IHS Standard Terminology RxNorm Subsets"
+40 SET ZTSAVE("NMIEN")=""
End DoDot:1
+41 ;
+42 ;ICD9 to SNOMED process
+43 IF TYPE="I"
Begin DoDot:1
+44 SET ZTRTN="JOB^BSTSUTIL"
SET ZTDESC="BSTS - Preload SNOMED Concepts"
+45 SET ZTSAVE("NMIEN")=""
End DoDot:1
+46 ;
+47 ;ICD10 Autocodeable
+48 IF TYPE="I10"
Begin DoDot:1
+49 SET ZTRTN="ACODE^BSTSVRSC"
SET ZTDESC="BSTS - Refresh ICD-10 Autocodeable Codeset"
+50 SET ZTSAVE("NMIEN")=""
End DoDot:1
+51 ;
+52 ;Custom Codesets
+53 IF TYPE="CCD"
Begin DoDot:1
+54 SET ZTRTN="CDST^BSTSVRSC"
SET ZTDESC="BSTS - Update IHS Standard Terminology Local Cache Refresh"
+55 SET ZTSAVE("NMIEN")=""
End DoDot:1
+56 ;
+57 ;ICD9 Autocodeable
+58 IF TYPE="I9"
Begin DoDot:1
+59 SET ZTRTN="A9CODE^BSTSVRSC"
SET ZTDESC="BSTS - Refresh ICD-9 Autocodeable Codeset"
End DoDot:1
+60 ;
+61 SET ZTIO=""
+62 IF +$GET(JTIME)
SET ZTDTH=$$JBTIME^BSTSVOFL()
+63 IF '$TEST
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,2)
+64 DO ^%ZTLOAD
+65 ;
+66 ;Save task to file
+67 SET BSTSUPD(9002318.1,NMIEN_",",FIELD)=$GET(ZTSK)
+68 DO FILE^DIE("","BSTSUPD","ERR")
+69 ;
+70 QUIT
+71 ;
PLOAD(NMIEN) ;Job off process to pre-load SNOMED concepts at site
+1 ;
+2 ;Quit if process has run before
+3 IF $$GET1^DIQ(9002318.1,NMIEN_",",".09","I")]""
QUIT 0
+4 ;
+5 ;Do not perform check if background process is running
+6 LOCK +^BSTS(9002318.1,0):0
IF '$TEST
QUIT 1
+7 LOCK -^BSTS(9002318.1,0)
+8 ;
+9 ;Make sure ICD9 to SNOMED background process isn't already running
+10 LOCK +^TMP("BSTSICD2SMD"):0
IF '$TEST
QUIT 1
+11 LOCK -^TMP("BSTSICD2SMD")
+12 ;
+13 ;Queue the process off in the background
+14 DO CDJOB^BSTSUTIL(NMIEN,"I")
+15 ;
+16 QUIT 0
+17 ;
JOB ;Background process to preload SNOMED concepts corresponding to ICD9 values
+1 ;
+2 ;Lock process
+3 LOCK +^TMP("BSTSICD2SMD"):0
IF '$TEST
QUIT
+4 ;
+5 NEW AUPNPROB,JTMP,UID,JTMP,SVAR,MFAIL,FWAIT,ABORT
+6 ;
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET JTMP=$NAME(^TMP("BSTS1POS",UID))
+9 SET SVAR=$NAME(^TMP("BSTSRPC1",UID))
+10 KILL @JTMP,^XTMP("BSTSLCMP","QUIT")
+11 ;
+12 ;Retrieve Failover Variables
+13 SET MFAIL=$$FPARMS^BSTSVOFL()
+14 SET FWAIT=$PIECE(MFAIL,U,2)
+15 SET MFAIL=$PIECE(MFAIL,U)
+16 ;
+17 SET AUPNPROB=0
FOR
SET AUPNPROB=$ORDER(^AUPNPROB(AUPNPROB))
IF 'AUPNPROB
QUIT
Begin DoDot:1
+18 NEW ICD9,STS,TRY,FCNT
+19 ;
+20 ;Reset scratch global
+21 KILL @SVAR
+22 ;
+23 ;Get the ICD9 code
+24 SET ICD9=$$GET1^DIQ(9000011,AUPNPROB,.01,"E")
IF ICD9=""
QUIT
+25 ;
+26 ;Strip off trailing "."
+27 SET ICD9=$$TKO^BSTSUTIL(ICD9,".")
+28 ;
+29 ;Skip if that ICD9 already processed
+30 IF $DATA(@JTMP@(ICD9))
QUIT
+31 ;
+32 ;Pre-load the SNOMED for that ICD9 - Try call maximum of 12 times
+33 SET (ABORT,FCNT,STS)=0
FOR TRY=1:1:(12*MFAIL)
Begin DoDot:2
+34 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+35 SET STS=$$ICD2SMD^BSTSAPI(SVAR,ICD9_"^BCIX^2")
IF +STS=2!(STS="0^")
QUIT
+36 ;Fail handling
SET FCNT=FCNT+1
IF FCNT'<MFAIL
Begin DoDot:3
+37 SET ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"JOB^BSTSUTIL - Looking up ICD9: "_ICD9)
+38 IF ABORT=1
SET ^XTMP("BSTSLCMP","QUIT")=1
DO ELOG^BSTSVOFL("ICD9 TO SNOMED LOOKUP FAILED ON ICD9: "_ICD9)
+39 SET FCNT=0
End DoDot:3
End DoDot:2
IF +STS=2!(STS="0^")
QUIT
+40 ;
+41 ;Mark the entry processed
+42 SET @JTMP@(ICD9)=""
End DoDot:1
IF $DATA(^XTMP("BSTSLCMP","QUIT"))
QUIT
+43 ;
+44 ;Remove entry when done
+45 KILL @JTMP
+46 ;
+47 ;Unlock process
+48 LOCK -^TMP("BSTSICD2SMD")
+49 ;
+50 NEW FAIL
+51 SET FAIL=$SELECT($DATA(^XTMP("BSTSLCMP","QUIT")):1,1:0)
+52 KILL ^XTMP("BSTSLCMP")
+53 IF FAIL
SET ^XTMP("BSTSLCMP","QUIT")=1
+54 ;
+55 QUIT
