BSTSVRSC ;GDIT/HS/BEE-Standard Terminology - Compile Custom Codeset ; 5 Nov 2012 9:53 AM
;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
;
Q
;
CCHK(NMID,BKGND) ;EP - Check for custom codeset updates
;
I $G(NMID)="" Q
I $G(NMID)=36 Q
I $G(NMID)=1552 Q
I $G(NMID)=5180 Q
I $G(NMID)=32777 Q
I $G(NMID)=32778 Q
;
;Only one SNOMED proc at a time
I '$G(BKGND) L +^BSTS(9002318.1,0):0 E W !!,"A Local Cache Refresh is Already Running. Please Try Later" H 3 Q
L -^BSTS(9002318.1,0)
;
;Check for ICD92SNOMED proc
I '$G(BKGND) L +^TMP("BSTSICD2SMD"):0 E W !!,"An ICD9 to SNOMED Background Process is Already Running. Please Try Later" H 3 Q
L -^TMP("BSTSICD2SMD")
;
NEW LMDT,STS,BSTS,ERROR,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,NMIEN,ZTQUEUED
NEW VAR,ZTIO,VRSN,TRY
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSVRSC D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
;Get codeset
S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) Q:NMIEN=""
;
;Check if online
S STS="" F TRY=1:1:5 D I +STS=2 Q
. D RESET^BSTSWSV1 ;Reset the DTS link to on
. S STS=$$VERSIONS^BSTSAPI("VRSN") ;Try
;
;Queue proc
I +STS=2 D CDJOB^BSTSUTIL(NMIEN,"CCD")
;
Q
;
CDST ;EP - Update IHS Standard Terminology Codeset
;
;Tasked by above. Var NMIEN should be set
;
S NMIEN=$G(NMIEN) I NMIEN="" Q
;
;Lock
L +^BSTS(9002318.1,0):0 E Q
;
NEW BSTSWS,RESULT,NMID,STS,VRSN,BSTS,ICONC,CIEN,X1,X2,X,NVIEN,NVLCL,MFAIL,FWAIT,TRY,FCNT,ABORT,TRY,CVRSN
;
;Get ext codeset Id
S NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I") I NMID="" G XCDST
;
;Update LAST VERSION CHECK so proc won't keep getting called
S BSTS(9002318.1,NMIEN_",",.05)=DT
D FILE^DIE("","BSTS","ERROR")
;
;Online?
S STS="" F TRY=1:1:5 D I +STS=2 Q
. D RESET^BSTSWSV1 ;Reset the DTS link to on
. S STS=$$VERSIONS^BSTSAPI("VRSN") ;Try
I +STS'=2 G XCDST
;
;Reset Monitoring GBL
K ^XTMP("BSTSLCMP")
;
;Get later date
S X1=DT,X2=60 D C^%DTC
;
;Get current version
S CVRSN=$$GET1^DIQ(9002318.1,NMIEN_",",.04,"I")
;
;Make a log entry
D LOG^BSTSAPIL("UPDS",NMID,"CURRENT",CVRSN)
;
;Set Monitoring GBL
S ^XTMP("BSTSLCMP",0)=X_U_DT_U_"Cache refresh running for "_NMID
;
;Mark as OOD
S ^XTMP("BSTSLCMP","STS")="Marking entries as out of date"
S ICONC="" F S ICONC=$O(^BSTS(9002318.4,"C",NMID,ICONC)) Q:ICONC="" S CIEN="" F S CIEN=$O(^BSTS(9002318.4,"C",NMID,ICONC,CIEN)) Q:CIEN="" D
. NEW BSTS,ERR,LMOD
. ;
. ;Mark OOD
. S BSTS(9002318.4,CIEN_",",".12")=""
. D FILE^DIE("","BSTS","ERR")
;
;Make call to proc
S ^XTMP("BSTSLCMP","STS")="Performing Refresh from DTS"
S BSTSWS("NAMESPACEID")=NMID
S BSTSWS("REVIN")=$$FMTE^XLFDT(DT,"7")
S STS=$$CSTMCDST^BSTSWSV1("RESULT",.BSTSWS)
S ^BXE("M")="0^"_STS
I +STS=0 G XCDST ;Quit if update failed
I $D(^XTMP("BSTSLCMP","QUIT")) G XCDST
;
S ^BXE("M")="1"
;Now refresh entries for codeset that have not been updated (to handle deletes)
S ICONC="" F S ICONC=$O(^BSTS(9002318.4,"C",NMID,ICONC)) Q:ICONC="" D Q:$D(^XTMP("BSTSLCMP","QUIT"))
. S CIEN="" F S CIEN=$O(^BSTS(9002318.4,"C",NMID,ICONC,CIEN)) Q:CIEN="" D Q:$D(^XTMP("BSTSLCMP","QUIT"))
.. NEW BSTS,ERR,TIEN,DA,DIK
.. ;
.. ;Quit if updated
.. I $$GET1^DIQ(9002318.4,CIEN_",",".12","I")]"" Q
.. ;
.. ;Update monitor
.. S ^XTMP("BSTSLCMP","STS")="Removing retired mapping "_CIEN
.. ;
.. ;First remove terms
.. S TIEN="" F S TIEN=$O(^BSTS(9002318.3,"C",NMID,CIEN,TIEN)) Q:TIEN="" D
... NEW DA,DIK
... S DA=TIEN,DIK="^BSTS(9002318.3," D ^DIK
.. ;
.. ;Remove concept
.. S DA=CIEN,DIK="^BSTS(9002318.4," D ^DIK
;
;Retrieve Failover Vars
S MFAIL=$$FPARMS^BSTSVOFL()
S FWAIT=$P(MFAIL,U,2)
S MFAIL=$P(MFAIL,U)
;
S ^BXE("M")=2
;Loop through, grab concept that mappings linked to
S ABORT=0,ICONC="" F S ICONC=$O(^BSTS(9002318.4,"C",NMID,ICONC)) Q:ICONC="" D Q:$D(^XTMP("BSTSLCMP","QUIT"))
. NEW IEN
. S IEN="" F S IEN=$O(^BSTS(9002318.4,"C",NMID,ICONC,IEN)) Q:IEN="" D Q:$D(^XTMP("BSTSLCMP","QUIT"))
.. NEW AS
.. S AS=0 F S AS=$O(^BSTS(9002318.4,IEN,9,AS)) Q:'AS D
... NEW NODE,NM,DTS,VAR,FCNT,TRY
... S NODE=$G(^BSTS(9002318.4,IEN,9,AS,0))
... S ^XTMP("BSTSLCMP","STS")="Getting Association details for entry: "_ICONC
... S NM=$P(NODE,U,2) Q:NM=""
... S DTS=$P(NODE,U,3) Q:DTS=""
... ;
... ;Update entry-Hang max of 12 times
... S (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=$$DTSLKP^BSTSAPI("VAR",DTS_"^"_NM) I +STS=2!(STS="0^") Q
.... S FCNT=FCNT+1 I FCNT'<MFAIL D ;Fail handling
..... S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"CDST^BSTSVRSC - Getting Assoc for entry: "_DTS)
..... I ABORT=1 S ^XTMP("BSTSLCMP","QUIT")=1 D ELOG^BSTSVOFL("CUSTOM CODESET REFRESH FAILED ON DETAIL ENTRY: "_DTS)
..... S FCNT=0
;
S ^BXE("M")="3^"_STS
;Check for failure
I +STS=0 G XCDST
I $D(^XTMP("BSTSLCMP","QUIT")) G XCDST
;
;Get current version from mult
S NVIEN=$O(^BSTS(9002318.1,NMIEN,1,"A"),-1)
S NVLCL="" I +NVIEN>0 D
. NEW DA,IENS
. S DA(1)=NMIEN,DA=+NVIEN,IENS=$$IENS^DILF(.DA)
. S NVLCL=$$GET1^DIQ(9002318.11,IENS,".01","I")
;
S ^BXE("M")="4^"_NVLCL
;Save CURRENT VERSION
I NVLCL]"" D
. NEW BSTS,ERROR
. S BSTS(9002318.1,NMIEN_",",.04)=NVLCL
. D FILE^DIE("","BSTS","ERROR")
;
;Get new current version
S CVRSN=$$GET1^DIQ(9002318.1,NMIEN_",",.04,"I")
;
;Make a log entry
D LOG^BSTSAPIL("UPDE",NMID,"CURRENT",CVRSN)
;
;Reset Monitoring GBL
XCDST NEW FAIL
S FAIL=$S($D(^XTMP("BSTSLCMP","QUIT")):1,1:0)
K ^XTMP("BSTSLCMP")
S:FAIL ^XTMP("BSTSLCMP","QUIT")=1
;
;Unlock
L -^BSTS(9002318.1,0)
;
Q
;
ACHK(NMID,BKGND) ;EP - Check for '36' auto-codable ICD-10s
;
;Only one SNOMED proc at a time
I '$G(BKGND) L +^BSTS(9002318.1,0):0 E W !!,"A Local Cache Refresh is Already Running. Please Try Later" H 3 Q
L -^BSTS(9002318.1,0)
;
;Make sure ICD92SNOMED process isn't running
I '$G(BKGND) L +^TMP("BSTSICD2SMD"):0 E W !!,"An ICD9 to SNOMED Background Process is Already Running. Please Try Later" H 3 Q
L -^TMP("BSTSICD2SMD")
;
;Validate input
I $G(NMID)="" Q
I $G(NMID)'=32777 Q
;
NEW LMDT,STS,BSTS,ERROR,NMIEN
NEW VAR,SITE,VRSN,TRY
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSVRSC D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
;Get codeset
S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) Q:NMIEN=""
;
;Online?
S STS="" F TRY=1:1:5 D I +STS=2 Q
. D RESET^BSTSWSV1 ;Reset the DTS link to on
. S STS=$$VERSIONS^BSTSAPI("VRSN") ;Try
;
;Queue process
I +STS=2 D CDJOB^BSTSUTIL(NMIEN,"I10")
;
Q
;
ACODE ;EP - Update SNOMED '36' auto-codable ICD-10 mappings
;
;Tasked above. Variable NMIEN should be set
;
S NMIEN=$G(NMIEN) I NMIEN="" Q
;
;Lock
L +^BSTS(9002318.1,0):0 E Q
;
NEW BSTSWS,RESULT,NMID,STS,VRSN,BSTS,ICONC,CIEN,X1,X2,X,RUNDT,DEBUG,NVIEN,NVLCL,FWAIT,TRY,FCNT,ABORT,TRY,CVRSN
NEW CDST
;
;Get run date
S RUNDT=DT
;
;Get external codeset Id
S NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I") I NMID="" G XACODE
;
;Update LAST VERSION CHECK now so proc won't keep getting called
S BSTS(9002318.1,NMIEN_",",.05)=DT
D FILE^DIE("","BSTS","ERROR")
;
;Online?
S STS="" F TRY=1:1:5 D I +STS=2 Q
. D RESET^BSTSWSV1 ;Reset the DTS link to on
. S STS=$$VERSIONS^BSTSAPI("VRSN") ;Try
I +STS'=2 G XACODE
;
;Reset Monitoring GBL
K ^XTMP("BSTSLCMP")
;
;Get later date
S X1=DT,X2=60 D C^%DTC
;
;Log updates
F CDST=32777,32779,32780 D
. NEW CVRSN,NM
. ;
. S NM=$O(^BSTS(9002318.1,"B",CDST,"")) Q:NM=""
. ;
. ;Get current version
. S CVRSN=$$GET1^DIQ(9002318.1,NM_",",.04,"I")
. ;
. ;Make a log entry
. D LOG^BSTSAPIL("UPDS",CDST,"CURRENT",CVRSN)
;
;Make a log entry
D LOG^BSTSAPIL("UPDS",36,"SUBSET","")
;
;Set up Monitoring GBL
S ^XTMP("BSTSLCMP",0)=X_U_DT_U_"SNOMED '36' auto-codable ICD-10 mapping running"
;
;BSTS*1.0*4;Mark codeset as OOD
D CLLMDT^BSTSVOF1(36)
;
;Make call to proc custom codeset
S ^XTMP("BSTSLCMP","STS")="Performing Refresh from DTS"
S DEBUG=""
S BSTSWS("REVIN")=$$FMTE^XLFDT(DT,"7")
S STS=$$ACODE^BSTSWSV1("RESULT",.BSTSWS,DEBUG)
;
;Failure check
I +STS=0 G XACODE
I $D(^XTMP("BSTSLCMP","QUIT")) G XACODE
;
;Retrieve Failover Vars
S MFAIL=$$FPARMS^BSTSVOFL()
S FWAIT=$P(MFAIL,U,2)
S MFAIL=$P(MFAIL,U)
;
;Loop through again and proc skipped entries (no longer mapped)
S ^XTMP("BSTSLCMP","STS")="Looking for skipped entries (no longer mapped)"
S ABORT=0,ICONC="" F S ICONC=$O(^BSTS(9002318.4,"C",36,ICONC)) Q:ICONC="" D Q:$D(^XTMP("BSTSLCMP","QUIT"))
. S CIEN="" F S CIEN=$O(^BSTS(9002318.4,"C",36,ICONC,CIEN)) Q:CIEN="" D Q:$D(^XTMP("BSTSLCMP","QUIT"))
.. NEW DTSID,VAR
.. ;
.. ;Skip partials
.. I $$GET1^DIQ(9002318.4,CIEN_",",.03,"I")="P" Q
.. ;
.. ;Quit if entry updated
.. I $$GET1^DIQ(9002318.4,CIEN_",",".12","I")'<RUNDT Q
.. ;
.. ;Only update if ICD info on file
.. I $O(^BSTS(9002318.4,CIEN,3,"B",""))="" Q
.. ;
.. ;Update monitor
.. S ^XTMP("BSTSLCMP","STS")="Updating skipped entry "_CIEN
.. ;
.. ;Get DTSID
.. S DTSID=$$GET1^DIQ(9002318.4,CIEN_",",.08,"I") Q:DTSID=""
.. ;
.. ;Refresh entry - Hang max of 12 times
.. S (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=$$DTSLKP^BSTSAPI("VAR",DTSID_"^36") I +STS=2!(STS="0^") Q
... S FCNT=FCNT+1 I FCNT'<MFAIL D ;Fail handling
.... S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"ACODE^BSTSVRSC - Getting update for entry: "_DTSID)
.... I ABORT=1 S ^XTMP("BSTSLCMP","QUIT")=1 D ELOG^BSTSVOFL("ICD10 MAPPING REFRESH FAILED ON DETAIL ENTRY: "_DTSID)
.... S FCNT=0
;
;Failure check
I +STS=0 G XACODE
I $D(^XTMP("BSTSLCMP","QUIT")) G XACODE
;
;BSTS*1.0*6;Update both 32777 and 32779
;BSTS*1.0*7;Update 32780 and LAST SUBSET RUN
D
. NEW BSTS,ERROR,NMID36
. S NMID36=$O(^BSTS(9002318.1,"B",36,"")) Q:NMID36=""
. S BSTS(9002318.1,NMID36_",",.1)=DT
. D FILE^DIE("","BSTS","ERROR")
;
F NMID=32777,32779,32780 D
. ;
. S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) Q:NMIEN=""
. ;
. ;Update current version
. ;
. ;Get current version from codeset multiple
. S NVIEN=$O(^BSTS(9002318.1,NMIEN,1,"A"),-1)
. S NVLCL="" I +NVIEN>0 D
.. NEW DA,IENS
.. S DA(1)=NMIEN,DA=+NVIEN,IENS=$$IENS^DILF(.DA)
.. S NVLCL=$$GET1^DIQ(9002318.11,IENS,".01","I")
. ;
. ;Now save CURRENT VERSION
. I NVLCL]"" D
.. NEW BSTS,ERROR
.. S BSTS(9002318.1,NMIEN_",",.04)=NVLCL
.. D FILE^DIE("","BSTS","ERROR")
;
;BSTS*2.0*1;Move call to BSTSVOF1
D UIFS^BSTSVOF1(.ZTQUEUED)
;
;Proc VUID and NDC
S STS=$$NVLKP^BSTSVOFL(MFAIL,FWAIT)
;
;Log updates
F CDST=32777,32779,32780 D
. NEW CVRSN,NM
. ;
. S NM=$O(^BSTS(9002318.1,"B",CDST,"")) Q:NM=""
. ;
. ;Get current version
. S CVRSN=$$GET1^DIQ(9002318.1,NM_",",.04,"I")
. ;
. ;Make a log entry
. D LOG^BSTSAPIL("UPDE",CDST,"CURRENT",CVRSN)
;
;Make a log entry
D LOG^BSTSAPIL("UPDE",36,"SUBSET","")
;
;Reset Monitoring GBL
XACODE NEW FAIL
S FAIL=$S($D(^XTMP("BSTSLCMP","QUIT")):1,1:0)
K ^XTMP("BSTSLCMP")
S:FAIL ^XTMP("BSTSLCMP","QUIT")=1
;
;Unlock
L -^BSTS(9002318.1,0)
;
Q
;
A9CHK(NMID,BKGND) ;EP - Check for '36' auto-codable ICD-9s
;
;ICD9 updates no longer supported
Q
;
A9CODE ;EP - Update SNOMED '36' auto-codable ICD-9 mappings
;
;ICD9 updates no longer supported
Q
;
ERR ;
D ^%ZTER
Q
BSTSVRSC ;GDIT/HS/BEE-Standard Terminology - Compile Custom Codeset ; 5 Nov 2012 9:53 AM
+1 ;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
+2 ;
+3 QUIT
+4 ;
CCHK(NMID,BKGND) ;EP - Check for custom codeset updates
+1 ;
+2 IF $GET(NMID)=""
QUIT
+3 IF $GET(NMID)=36
QUIT
+4 IF $GET(NMID)=1552
QUIT
+5 IF $GET(NMID)=5180
QUIT
+6 IF $GET(NMID)=32777
QUIT
+7 IF $GET(NMID)=32778
QUIT
+8 ;
+9 ;Only one SNOMED proc at a time
+10 IF '$GET(BKGND)
LOCK +^BSTS(9002318.1,0):0
IF '$TEST
WRITE !!,"A Local Cache Refresh is Already Running. Please Try Later"
HANG 3
QUIT
+11 LOCK -^BSTS(9002318.1,0)
+12 ;
+13 ;Check for ICD92SNOMED proc
+14 IF '$GET(BKGND)
LOCK +^TMP("BSTSICD2SMD"):0
IF '$TEST
WRITE !!,"An ICD9 to SNOMED Background Process is Already Running. Please Try Later"
HANG 3
QUIT
+15 LOCK -^TMP("BSTSICD2SMD")
+16 ;
+17 NEW LMDT,STS,BSTS,ERROR,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,NMIEN,ZTQUEUED
+18 NEW VAR,ZTIO,VRSN,TRY
+19 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BSTSVRSC D UNWIND^%ZTER"
+20 ;
+21 ;Get codeset
+22 SET NMIEN=$ORDER(^BSTS(9002318.1,"B",NMID,""))
IF NMIEN=""
QUIT
+23 ;
+24 ;Check if online
+25 SET STS=""
FOR TRY=1:1:5
Begin DoDot:1
+26 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+27 ;Try
SET STS=$$VERSIONS^BSTSAPI("VRSN")
End DoDot:1
IF +STS=2
QUIT
+28 ;
+29 ;Queue proc
+30 IF +STS=2
DO CDJOB^BSTSUTIL(NMIEN,"CCD")
+31 ;
+32 QUIT
+33 ;
CDST ;EP - Update IHS Standard Terminology Codeset
+1 ;
+2 ;Tasked by above. Var NMIEN should be set
+3 ;
+4 SET NMIEN=$GET(NMIEN)
IF NMIEN=""
QUIT
+5 ;
+6 ;Lock
+7 LOCK +^BSTS(9002318.1,0):0
IF '$TEST
QUIT
+8 ;
+9 NEW BSTSWS,RESULT,NMID,STS,VRSN,BSTS,ICONC,CIEN,X1,X2,X,NVIEN,NVLCL,MFAIL,FWAIT,TRY,FCNT,ABORT,TRY,CVRSN
+10 ;
+11 ;Get ext codeset Id
+12 SET NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I")
IF NMID=""
GOTO XCDST
+13 ;
+14 ;Update LAST VERSION CHECK so proc won't keep getting called
+15 SET BSTS(9002318.1,NMIEN_",",.05)=DT
+16 DO FILE^DIE("","BSTS","ERROR")
+17 ;
+18 ;Online?
+19 SET STS=""
FOR TRY=1:1:5
Begin DoDot:1
+20 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+21 ;Try
SET STS=$$VERSIONS^BSTSAPI("VRSN")
End DoDot:1
IF +STS=2
QUIT
+22 IF +STS'=2
GOTO XCDST
+23 ;
+24 ;Reset Monitoring GBL
+25 KILL ^XTMP("BSTSLCMP")
+26 ;
+27 ;Get later date
+28 SET X1=DT
SET X2=60
DO C^%DTC
+29 ;
+30 ;Get current version
+31 SET CVRSN=$$GET1^DIQ(9002318.1,NMIEN_",",.04,"I")
+32 ;
+33 ;Make a log entry
+34 DO LOG^BSTSAPIL("UPDS",NMID,"CURRENT",CVRSN)
+35 ;
+36 ;Set Monitoring GBL
+37 SET ^XTMP("BSTSLCMP",0)=X_U_DT_U_"Cache refresh running for "_NMID
+38 ;
+39 ;Mark as OOD
+40 SET ^XTMP("BSTSLCMP","STS")="Marking entries as out of date"
+41 SET ICONC=""
FOR
SET ICONC=$ORDER(^BSTS(9002318.4,"C",NMID,ICONC))
IF ICONC=""
QUIT
SET CIEN=""
FOR
SET CIEN=$ORDER(^BSTS(9002318.4,"C",NMID,ICONC,CIEN))
IF CIEN=""
QUIT
Begin DoDot:1
+42 NEW BSTS,ERR,LMOD
+43 ;
+44 ;Mark OOD
+45 SET BSTS(9002318.4,CIEN_",",".12")=""
+46 DO FILE^DIE("","BSTS","ERR")
End DoDot:1
+47 ;
+48 ;Make call to proc
+49 SET ^XTMP("BSTSLCMP","STS")="Performing Refresh from DTS"
+50 SET BSTSWS("NAMESPACEID")=NMID
+51 SET BSTSWS("REVIN")=$$FMTE^XLFDT(DT,"7")
+52 SET STS=$$CSTMCDST^BSTSWSV1("RESULT",.BSTSWS)
+53 SET ^BXE("M")="0^"_STS
+54 ;Quit if update failed
IF +STS=0
GOTO XCDST
+55 IF $DATA(^XTMP("BSTSLCMP","QUIT"))
GOTO XCDST
+56 ;
+57 SET ^BXE("M")="1"
+58 ;Now refresh entries for codeset that have not been updated (to handle deletes)
+59 SET ICONC=""
FOR
SET ICONC=$ORDER(^BSTS(9002318.4,"C",NMID,ICONC))
IF ICONC=""
QUIT
Begin DoDot:1
+60 SET CIEN=""
FOR
SET CIEN=$ORDER(^BSTS(9002318.4,"C",NMID,ICONC,CIEN))
IF CIEN=""
QUIT
Begin DoDot:2
+61 NEW BSTS,ERR,TIEN,DA,DIK
+62 ;
+63 ;Quit if updated
+64 IF $$GET1^DIQ(9002318.4,CIEN_",",".12","I")]""
QUIT
+65 ;
+66 ;Update monitor
+67 SET ^XTMP("BSTSLCMP","STS")="Removing retired mapping "_CIEN
+68 ;
+69 ;First remove terms
+70 SET TIEN=""
FOR
SET TIEN=$ORDER(^BSTS(9002318.3,"C",NMID,CIEN,TIEN))
IF TIEN=""
QUIT
Begin DoDot:3
+71 NEW DA,DIK
+72 SET DA=TIEN
SET DIK="^BSTS(9002318.3,"
DO ^DIK
End DoDot:3
+73 ;
+74 ;Remove concept
+75 SET DA=CIEN
SET DIK="^BSTS(9002318.4,"
DO ^DIK
End DoDot:2
IF $DATA(^XTMP("BSTSLCMP","QUIT"))
QUIT
End DoDot:1
IF $DATA(^XTMP("BSTSLCMP","QUIT"))
QUIT
+76 ;
+77 ;Retrieve Failover Vars
+78 SET MFAIL=$$FPARMS^BSTSVOFL()
+79 SET FWAIT=$PIECE(MFAIL,U,2)
+80 SET MFAIL=$PIECE(MFAIL,U)
+81 ;
+82 SET ^BXE("M")=2
+83 ;Loop through, grab concept that mappings linked to
+84 SET ABORT=0
SET ICONC=""
FOR
SET ICONC=$ORDER(^BSTS(9002318.4,"C",NMID,ICONC))
IF ICONC=""
QUIT
Begin DoDot:1
+85 NEW IEN
+86 SET IEN=""
FOR
SET IEN=$ORDER(^BSTS(9002318.4,"C",NMID,ICONC,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+87 NEW AS
+88 SET AS=0
FOR
SET AS=$ORDER(^BSTS(9002318.4,IEN,9,AS))
IF 'AS
QUIT
Begin DoDot:3
+89 NEW NODE,NM,DTS,VAR,FCNT,TRY
+90 SET NODE=$GET(^BSTS(9002318.4,IEN,9,AS,0))
+91 SET ^XTMP("BSTSLCMP","STS")="Getting Association details for entry: "_ICONC
+92 SET NM=$PIECE(NODE,U,2)
IF NM=""
QUIT
+93 SET DTS=$PIECE(NODE,U,3)
IF DTS=""
QUIT
+94 ;
+95 ;Update entry-Hang max of 12 times
+96 SET (FCNT,STS)=0
FOR TRY=1:1:(12*MFAIL)
Begin DoDot:4
+97 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+98 SET STS=$$DTSLKP^BSTSAPI("VAR",DTS_"^"_NM)
IF +STS=2!(STS="0^")
QUIT
+99 ;Fail handling
SET FCNT=FCNT+1
IF FCNT'<MFAIL
Begin DoDot:5
+100 SET ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"CDST^BSTSVRSC - Getting Assoc for entry: "_DTS)
+101 IF ABORT=1
SET ^XTMP("BSTSLCMP","QUIT")=1
DO ELOG^BSTSVOFL("CUSTOM CODESET REFRESH FAILED ON DETAIL ENTRY: "_DTS)
+102 SET FCNT=0
End DoDot:5
End DoDot:4
IF +STS=2!(STS="0^")
QUIT
End DoDot:3
End DoDot:2
IF $DATA(^XTMP("BSTSLCMP","QUIT"))
QUIT
End DoDot:1
IF $DATA(^XTMP("BSTSLCMP","QUIT"))
QUIT
+103 ;
+104 SET ^BXE("M")="3^"_STS
+105 ;Check for failure
+106 IF +STS=0
GOTO XCDST
+107 IF $DATA(^XTMP("BSTSLCMP","QUIT"))
GOTO XCDST
+108 ;
+109 ;Get current version from mult
+110 SET NVIEN=$ORDER(^BSTS(9002318.1,NMIEN,1,"A"),-1)
+111 SET NVLCL=""
IF +NVIEN>0
Begin DoDot:1
+112 NEW DA,IENS
+113 SET DA(1)=NMIEN
SET DA=+NVIEN
SET IENS=$$IENS^DILF(.DA)
+114 SET NVLCL=$$GET1^DIQ(9002318.11,IENS,".01","I")
End DoDot:1
+115 ;
+116 SET ^BXE("M")="4^"_NVLCL
+117 ;Save CURRENT VERSION
+118 IF NVLCL]""
Begin DoDot:1
+119 NEW BSTS,ERROR
+120 SET BSTS(9002318.1,NMIEN_",",.04)=NVLCL
+121 DO FILE^DIE("","BSTS","ERROR")
End DoDot:1
+122 ;
+123 ;Get new current version
+124 SET CVRSN=$$GET1^DIQ(9002318.1,NMIEN_",",.04,"I")
+125 ;
+126 ;Make a log entry
+127 DO LOG^BSTSAPIL("UPDE",NMID,"CURRENT",CVRSN)
+128 ;
+129 ;Reset Monitoring GBL
XCDST NEW FAIL
+1 SET FAIL=$SELECT($DATA(^XTMP("BSTSLCMP","QUIT")):1,1:0)
+2 KILL ^XTMP("BSTSLCMP")
+3 IF FAIL
SET ^XTMP("BSTSLCMP","QUIT")=1
+4 ;
+5 ;Unlock
+6 LOCK -^BSTS(9002318.1,0)
+7 ;
+8 QUIT
+9 ;
ACHK(NMID,BKGND) ;EP - Check for '36' auto-codable ICD-10s
+1 ;
+2 ;Only one SNOMED proc at a time
+3 IF '$GET(BKGND)
LOCK +^BSTS(9002318.1,0):0
IF '$TEST
WRITE !!,"A Local Cache Refresh is Already Running. Please Try Later"
HANG 3
QUIT
+4 LOCK -^BSTS(9002318.1,0)
+5 ;
+6 ;Make sure ICD92SNOMED process isn't running
+7 IF '$GET(BKGND)
LOCK +^TMP("BSTSICD2SMD"):0
IF '$TEST
WRITE !!,"An ICD9 to SNOMED Background Process is Already Running. Please Try Later"
HANG 3
QUIT
+8 LOCK -^TMP("BSTSICD2SMD")
+9 ;
+10 ;Validate input
+11 IF $GET(NMID)=""
QUIT
+12 IF $GET(NMID)'=32777
QUIT
+13 ;
+14 NEW LMDT,STS,BSTS,ERROR,NMIEN
+15 NEW VAR,SITE,VRSN,TRY
+16 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BSTSVRSC D UNWIND^%ZTER"
+17 ;
+18 ;Get codeset
+19 SET NMIEN=$ORDER(^BSTS(9002318.1,"B",NMID,""))
IF NMIEN=""
QUIT
+20 ;
+21 ;Online?
+22 SET STS=""
FOR TRY=1:1:5
Begin DoDot:1
+23 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+24 ;Try
SET STS=$$VERSIONS^BSTSAPI("VRSN")
End DoDot:1
IF +STS=2
QUIT
+25 ;
+26 ;Queue process
+27 IF +STS=2
DO CDJOB^BSTSUTIL(NMIEN,"I10")
+28 ;
+29 QUIT
+30 ;
ACODE ;EP - Update SNOMED '36' auto-codable ICD-10 mappings
+1 ;
+2 ;Tasked above. Variable NMIEN should be set
+3 ;
+4 SET NMIEN=$GET(NMIEN)
IF NMIEN=""
QUIT
+5 ;
+6 ;Lock
+7 LOCK +^BSTS(9002318.1,0):0
IF '$TEST
QUIT
+8 ;
+9 NEW BSTSWS,RESULT,NMID,STS,VRSN,BSTS,ICONC,CIEN,X1,X2,X,RUNDT,DEBUG,NVIEN,NVLCL,FWAIT,TRY,FCNT,ABORT,TRY,CVRSN
+10 NEW CDST
+11 ;
+12 ;Get run date
+13 SET RUNDT=DT
+14 ;
+15 ;Get external codeset Id
+16 SET NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I")
IF NMID=""
GOTO XACODE
+17 ;
+18 ;Update LAST VERSION CHECK now so proc won't keep getting called
+19 SET BSTS(9002318.1,NMIEN_",",.05)=DT
+20 DO FILE^DIE("","BSTS","ERROR")
+21 ;
+22 ;Online?
+23 SET STS=""
FOR TRY=1:1:5
Begin DoDot:1
+24 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+25 ;Try
SET STS=$$VERSIONS^BSTSAPI("VRSN")
End DoDot:1
IF +STS=2
QUIT
+26 IF +STS'=2
GOTO XACODE
+27 ;
+28 ;Reset Monitoring GBL
+29 KILL ^XTMP("BSTSLCMP")
+30 ;
+31 ;Get later date
+32 SET X1=DT
SET X2=60
DO C^%DTC
+33 ;
+34 ;Log updates
+35 FOR CDST=32777,32779,32780
Begin DoDot:1
+36 NEW CVRSN,NM
+37 ;
+38 SET NM=$ORDER(^BSTS(9002318.1,"B",CDST,""))
IF NM=""
QUIT
+39 ;
+40 ;Get current version
+41 SET CVRSN=$$GET1^DIQ(9002318.1,NM_",",.04,"I")
+42 ;
+43 ;Make a log entry
+44 DO LOG^BSTSAPIL("UPDS",CDST,"CURRENT",CVRSN)
End DoDot:1
+45 ;
+46 ;Make a log entry
+47 DO LOG^BSTSAPIL("UPDS",36,"SUBSET","")
+48 ;
+49 ;Set up Monitoring GBL
+50 SET ^XTMP("BSTSLCMP",0)=X_U_DT_U_"SNOMED '36' auto-codable ICD-10 mapping running"
+51 ;
+52 ;BSTS*1.0*4;Mark codeset as OOD
+53 DO CLLMDT^BSTSVOF1(36)
+54 ;
+55 ;Make call to proc custom codeset
+56 SET ^XTMP("BSTSLCMP","STS")="Performing Refresh from DTS"
+57 SET DEBUG=""
+58 SET BSTSWS("REVIN")=$$FMTE^XLFDT(DT,"7")
+59 SET STS=$$ACODE^BSTSWSV1("RESULT",.BSTSWS,DEBUG)
+60 ;
+61 ;Failure check
+62 IF +STS=0
GOTO XACODE
+63 IF $DATA(^XTMP("BSTSLCMP","QUIT"))
GOTO XACODE
+64 ;
+65 ;Retrieve Failover Vars
+66 SET MFAIL=$$FPARMS^BSTSVOFL()
+67 SET FWAIT=$PIECE(MFAIL,U,2)
+68 SET MFAIL=$PIECE(MFAIL,U)
+69 ;
+70 ;Loop through again and proc skipped entries (no longer mapped)
+71 SET ^XTMP("BSTSLCMP","STS")="Looking for skipped entries (no longer mapped)"
+72 SET ABORT=0
SET ICONC=""
FOR
SET ICONC=$ORDER(^BSTS(9002318.4,"C",36,ICONC))
IF ICONC=""
QUIT
Begin DoDot:1
+73 SET CIEN=""
FOR
SET CIEN=$ORDER(^BSTS(9002318.4,"C",36,ICONC,CIEN))
IF CIEN=""
QUIT
Begin DoDot:2
+74 NEW DTSID,VAR
+75 ;
+76 ;Skip partials
+77 IF $$GET1^DIQ(9002318.4,CIEN_",",.03,"I")="P"
QUIT
+78 ;
+79 ;Quit if entry updated
+80 IF $$GET1^DIQ(9002318.4,CIEN_",",".12","I")'<RUNDT
QUIT
+81 ;
+82 ;Only update if ICD info on file
+83 IF $ORDER(^BSTS(9002318.4,CIEN,3,"B",""))=""
QUIT
+84 ;
+85 ;Update monitor
+86 SET ^XTMP("BSTSLCMP","STS")="Updating skipped entry "_CIEN
+87 ;
+88 ;Get DTSID
+89 SET DTSID=$$GET1^DIQ(9002318.4,CIEN_",",.08,"I")
IF DTSID=""
QUIT
+90 ;
+91 ;Refresh entry - Hang max of 12 times
+92 SET (FCNT,STS)=0
FOR TRY=1:1:(12*MFAIL)
Begin DoDot:3
+93 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+94 SET STS=$$DTSLKP^BSTSAPI("VAR",DTSID_"^36")
IF +STS=2!(STS="0^")
QUIT
+95 ;Fail handling
SET FCNT=FCNT+1
IF FCNT'<MFAIL
Begin DoDot:4
+96 SET ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"ACODE^BSTSVRSC - Getting update for entry: "_DTSID)
+97 IF ABORT=1
SET ^XTMP("BSTSLCMP","QUIT")=1
DO ELOG^BSTSVOFL("ICD10 MAPPING REFRESH FAILED ON DETAIL ENTRY: "_DTSID)
+98 SET FCNT=0
End DoDot:4
End DoDot:3
IF +STS=2!(STS="0^")
QUIT
End DoDot:2
IF $DATA(^XTMP("BSTSLCMP","QUIT"))
QUIT
End DoDot:1
IF $DATA(^XTMP("BSTSLCMP","QUIT"))
QUIT
+99 ;
+100 ;Failure check
+101 IF +STS=0
GOTO XACODE
+102 IF $DATA(^XTMP("BSTSLCMP","QUIT"))
GOTO XACODE
+103 ;
+104 ;BSTS*1.0*6;Update both 32777 and 32779
+105 ;BSTS*1.0*7;Update 32780 and LAST SUBSET RUN
+106 Begin DoDot:1
+107 NEW BSTS,ERROR,NMID36
+108 SET NMID36=$ORDER(^BSTS(9002318.1,"B",36,""))
IF NMID36=""
QUIT
+109 SET BSTS(9002318.1,NMID36_",",.1)=DT
+110 DO FILE^DIE("","BSTS","ERROR")
End DoDot:1
+111 ;
+112 FOR NMID=32777,32779,32780
Begin DoDot:1
+113 ;
+114 SET NMIEN=$ORDER(^BSTS(9002318.1,"B",NMID,""))
IF NMIEN=""
QUIT
+115 ;
+116 ;Update current version
+117 ;
+118 ;Get current version from codeset multiple
+119 SET NVIEN=$ORDER(^BSTS(9002318.1,NMIEN,1,"A"),-1)
+120 SET NVLCL=""
IF +NVIEN>0
Begin DoDot:2
+121 NEW DA,IENS
+122 SET DA(1)=NMIEN
SET DA=+NVIEN
SET IENS=$$IENS^DILF(.DA)
+123 SET NVLCL=$$GET1^DIQ(9002318.11,IENS,".01","I")
End DoDot:2
+124 ;
+125 ;Now save CURRENT VERSION
+126 IF NVLCL]""
Begin DoDot:2
+127 NEW BSTS,ERROR
+128 SET BSTS(9002318.1,NMIEN_",",.04)=NVLCL
+129 DO FILE^DIE("","BSTS","ERROR")
End DoDot:2
End DoDot:1
+130 ;
+131 ;BSTS*2.0*1;Move call to BSTSVOF1
+132 DO UIFS^BSTSVOF1(.ZTQUEUED)
+133 ;
+134 ;Proc VUID and NDC
+135 SET STS=$$NVLKP^BSTSVOFL(MFAIL,FWAIT)
+136 ;
+137 ;Log updates
+138 FOR CDST=32777,32779,32780
Begin DoDot:1
+139 NEW CVRSN,NM
+140 ;
+141 SET NM=$ORDER(^BSTS(9002318.1,"B",CDST,""))
IF NM=""
QUIT
+142 ;
+143 ;Get current version
+144 SET CVRSN=$$GET1^DIQ(9002318.1,NM_",",.04,"I")
+145 ;
+146 ;Make a log entry
+147 DO LOG^BSTSAPIL("UPDE",CDST,"CURRENT",CVRSN)
End DoDot:1
+148 ;
+149 ;Make a log entry
+150 DO LOG^BSTSAPIL("UPDE",36,"SUBSET","")
+151 ;
+152 ;Reset Monitoring GBL
XACODE NEW FAIL
+1 SET FAIL=$SELECT($DATA(^XTMP("BSTSLCMP","QUIT")):1,1:0)
+2 KILL ^XTMP("BSTSLCMP")
+3 IF FAIL
SET ^XTMP("BSTSLCMP","QUIT")=1
+4 ;
+5 ;Unlock
+6 LOCK -^BSTS(9002318.1,0)
+7 ;
+8 QUIT
+9 ;
A9CHK(NMID,BKGND) ;EP - Check for '36' auto-codable ICD-9s
+1 ;
+2 ;ICD9 updates no longer supported
+3 QUIT
+4 ;
A9CODE ;EP - Update SNOMED '36' auto-codable ICD-9 mappings
+1 ;
+2 ;ICD9 updates no longer supported
+3 QUIT
+4 ;
ERR ;
+1 DO ^%ZTER
+2 QUIT
