BSTSVRSN ;GDIT/HS/BEE-Standard Terminology - Local File Handling ; 5 Nov 2012 9:53 AM
;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
;
Q
;
CHECK ;EP - Check for new codeset versions and '36' subsets/custom codeset refreshes
;
NEW SITE,BSTS,ERROR,ZTRTN,ZTDESC,ZTIO,ZTDTH
;
;Get Site Parameter IEN
S SITE=$O(^BSTS(9002318,0)) I 'SITE G XCHECK
;
;Quit if all checks have been completed for the day
I $$GET1^DIQ(9002318,SITE_",",".03","I")=DT G XCHECK
;
;Do not perform check if another process is already checking
L +^BSTS("VERSION CHECK"):0 E G XCHECK
;
;Do not perform check if background process is running
L +^BSTS(9002318.1,0):0 E G XCHECK
L -^BSTS(9002318.1,0)
;
;Make sure ICD9 to SNOMED background process isn't running
L +^TMP("BSTSICD2SMD"):0 E G XCHECK
L -^TMP("BSTSICD2SMD")
;
;Job off daily checks
S ZTRTN="DAYCHK^BSTSVOF1"
S ZTDESC="BSTS - Performing daily update checks"
S ZTIO=""
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,2)
D ^%ZTLOAD
;
;Completed checks for day - mark parameter
S BSTS(9002318,SITE_",",.03)=DT
D FILE^DIE("","BSTS","ERROR")
;
XCHECK L -^BSTS("VERSION CHECK")
;
Q
;
;BSTS*2.0*1;Added override checking
VCHK(NMID,OVRRID) ;EP - Daily check for new version
;
S OVRRID=+$G(OVRRID)
;
NEW NMIEN,LVCKDT,STS,BSTS,ERROR,VAR,CVLCL,NVLCL,NVIEN,TRY,TR
S NMID=$G(NMID,"") S:NMID="" NMID=36 S:NMID=30 NMID=36
S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) I NMIEN="" Q 0
;
;Pull last version check date
S LVCKDT=$$GET1^DIQ(9002318.1,NMIEN_",",.05,"I")
I 'OVRRID,LVCKDT'<DT Q 0
;
;Pull the current version on file
S CVLCL=$$GET1^DIQ(9002318.1,NMIEN_",",".04","I")
;
;Perform version check
S STS="" F TR=1:1:60 D I +STS=2 Q
. D RESET^BSTSWSV1 ;Reset the DTS link to on
. S STS=$$VERSIONS^BSTSAPI("VAR",NMID)
. I +STS'=2 H TR
;
;Check for successful remote call - If failure, don't check again today
I +STS'=2 D Q 2
. NEW BSTS,ERROR,SITE
. S SITE=$O(^BSTS(9002318,0)) Q:SITE=""
. S BSTS(9002318,SITE_",",.03)=DT
. D FILE^DIE("","BSTS","ERROR")
;
;Get the current version from the 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")
;
;If the current version value isn't equal to the latest in the multiple need to process
I NVLCL]"",CVLCL'=NVLCL D Q 1
. ;
. ;For codesets 36, 5180, 1552
. I (NMID=36)!(NMID=5180)!(NMID=1552) D QUEUE^BSTSVOFL(NMID) Q
. ;
. ;For '36' ICD-10 autocodables
. I NMID=32777 D QUEUE^BSTSVOFL(NMID) Q
. ;
. ;For '36' ICD-9 autocodables
. I NMID=32778 D QUEUE^BSTSVOFL(NMID) Q
. ;
. ;For '36' ICD-10 conditionals
. I NMID=32779 D QUEUE^BSTSVOFL(NMID) Q
. ;
. ;For '36' ICD-10 conditionals
. I NMID=32780 D QUEUE^BSTSVOFL(NMID) Q
. ;
. ;For remaining custom codesets
. I NMID'=32777,NMID'=32778,NMID'=32779,NMID'=36,NMID'=5180,NMID'=1552 D QUEUE^BSTSVOFL(NMID) Q
;
;Update LAST VERSION CHECK
S BSTS(9002318.1,NMIEN_",",.05)=DT
D FILE^DIE("","BSTS","ERROR")
;
Q 1
;
RES ;EP - Mark Local Codeset Entries As Out of Date
;
;Perform lock so only one process is allowed
L +^BSTS(9002318.1,0):0 E Q
;
NEW NMID,VDTS,STS,NVIEN,NVLCL,CIEN,BSTS,ERROR,VAR,X1,X2,X,TR,CVRSN
;
;Passed in variable
S NMIEN=$G(NMIEN) Q:NMIEN=""
;
;Get NMID
S NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I") I NMID="" G XRES
;
;Perform version check
S STS="" F TR=1:1:60 D I +STS=2 Q
. D RESET^BSTSWSV1 ;Make sure link is turned on
. S STS=$$VERSIONS^BSTSAPI("VAR",NMID)
. I +STS'=2 H TR
;
;Check for successful remote call - If offline quit
I +STS'=2 G XRES
;
;Reset Monitoring Global
K ^XTMP("BSTSLCMP")
;
;Get a 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 up Monitoring Global
S ^XTMP("BSTSLCMP","STS")=X_U_DT_U_"Cache Codeset refresh running for "_NMID
;
;Loop through each concept in the codeset and make it Out of Date
S VDTS="" F S VDTS=$O(^BSTS(9002318.4,"D",NMID,VDTS)) Q:VDTS="" S CIEN=0 F S CIEN=$O(^BSTS(9002318.4,"D",NMID,VDTS,CIEN)) Q:'CIEN D
. ;
. ;Update status
. S ^XTMP("BSTSLCMP","STS")="Marking entry "_CIEN_" as out of date"
. ;
. NEW BSTSUPD,ERR,TIEN
. ;
. ;Mark Entry as Out of Date
. S BSTSUPD(9002318.4,CIEN_",",".11")="Y"
. ;
. ;Process the Associated Terms
. S TIEN="" F S TIEN=$O(^BSTS(9002318.3,"C",NMID,CIEN,TIEN)) Q:TIEN="" D
.. ;
.. NEW BSTSTUPD,ERR
.. ;
.. ;Mark Entry as Out of Date
.. S BSTSTUPD(9002318.3,TIEN_",",".11")="Y"
.. D FILE^DIE("","BSTSTUPD","ERR")
. ;
. ;File entry
. I $D(BSTSUPD) D FILE^DIE("","BSTSUPD","ERR")
;
;Update the current version
;
;Get the current version from the 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 it in the CURRENT VERSION field
I NVLCL]"" D
. NEW BSTS,ERROR
. S BSTS(9002318.1,NMIEN_",",.04)=NVLCL
. D FILE^DIE("","BSTS","ERROR")
;
I NMID=36 S BSTS(9002318.1,NMIEN_",",.1)="@"
E S BSTS(9002318.1,NMIEN_",",.05)="@"
D FILE^DIE("","BSTS","ERR")
;
K ^XTMP("BSTSLCMP")
;
;Queue subset refresh - only if a total refresh isn't also scheduled
I '$D(^XTMP("BSTSPROCQ","B","ACODE^BSTSVRSC")),NMID=36 D QENTRY^BSTSVOFL("SUB^BSTSVRSN",NMIEN,"S36")
;
;
;Get current version
S CVRSN=$$GET1^DIQ(9002318.1,NMIEN_",",.04,"I")
;
;Make a log entry
D LOG^BSTSAPIL("UPDE",NMID,"CURRENT",CVRSN)
;
;Unlock entry
XRES L -^BSTS(9002318.1,0)
;
Q
;
SCHK(NMID,BKGND) ;EP - Check for periodic subset updates
;
NEW LMDT,STS,BSTS,ERROR,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,NMIEN
NEW VAR,SITE,SDAYS,ZTIO,SUBLST,X1,X2,X,%H,TR
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSVRSN D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
;Only one SNOMED background process can be running 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 ICD9 to SNOMED background 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")
;
S NMID=$G(NMID,"") S:NMID="" NMID=36 S:NMID=30 NMID=36
;
;Only run it for codeset 36
I NMID'=36 Q
;
;Get Site Parameter IEN
S SITE=$O(^BSTS(9002318,0)) Q:'SITE
;
;Get subset update days
S SDAYS=$$GET1^DIQ(9002318,SITE_",",.02,"I") S:SDAYS="" SDAYS=60
;
;Make sure we have a codeset (namespace)
S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) Q:NMIEN=""
;
;Update LAST SUBSET CHECK as completed today
D
. NEW BSTS,ERROR
. S BSTS(9002318.1,NMIEN_",",.06)=DT
. D FILE^DIE("","BSTS","ERROR")
;
;Check if refresh needs run
S LMDT=$$GET1^DIQ(9002318.1,NMIEN,".1","I")
I LMDT>0 S X1=LMDT,X2=SDAYS D C^%DTC S LMDT=X
I LMDT>DT Q
;
;Only run if server set up
S STS="" F TR=1:1:60 D I +STS=2 Q
. D RESET^BSTSWSV1 ;Reset the DTS link to on
. S STS=$$VERSIONS^BSTSAPI("VAR") ;Try a quick call to see if call works
. I +STS'=2 H TR
I +STS'=2 G XSCHK
;
;Queue the process off in the background
I +$G(BKGND) D QUEUE^BSTSVOFL("S36") Q ;Daily check - queue
D CDJOB^BSTSUTIL(NMIEN,"S","") ;Manual - run now
;
XSCHK Q
;
SUB ;EP - Update IHS Standard Terminology Subsets
;
;Perform lock so only one process is allowed
L +^BSTS(9002318.1,0):1 E Q
;
NEW NMID,SDAYS,SITE
;
;Retrieve passed in variable
S NMIEN=$G(NMIEN) I NMIEN="" Q
;
;Get NMID
S NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I") I NMID="" Q
;
;Get Site Parameter IEN
S SITE=$O(^BSTS(9002318,0)) Q:'SITE
;
;Get subset update days
S SDAYS=$$GET1^DIQ(9002318,SITE_",",.02,"I") S:SDAYS="" SDAYS=60
;
NEW BSTS,ERROR,CIEN,BSTSSB,STS,CNC,SUBLST,SSCIEN,ICONC,X,X1,X2,ITEM,%H
NEW MFAIL,FWAIT,FCNT,ABORT,RUNSTRT,TR
;
;Note the run date
S RUNSTRT=DT
;
;Only run if server up
S STS="" F TR=1:1:60 D I +STS=2 Q
. D RESET^BSTSWSV1 ;Reset DTS to on
. S STS=$$VERSIONS^BSTSAPI("VRSN") ;Try quick call
. I +STS'=2 H TR
I +STS'=2 G XSUB
;
;Reset Monitoring Global
K ^XTMP("BSTSLCMP")
;
;Get a later date
S X1=DT,X2=60 D C^%DTC
;
;Retrieve Failover Variables
S MFAIL=$$FPARMS^BSTSVOFL()
S FWAIT=$P(MFAIL,U,2)
S MFAIL=$P(MFAIL,U)
;
;Update SUBSET TASK NUMBER
I +$G(ZTSK)>0 D
. NEW BSTS,ERROR
. S BSTS(9002318.1,NMIEN_",",.08)=ZTSK
. D FILE^DIE("","BSTS","ERROR")
;
;Make a log entry
D LOG^BSTSAPIL("UPDS",NMID,"SUBSET","")
;
;Set up Monitoring Global
S ^XTMP("BSTSLCMP",0)=X_U_DT_U_"Cache subset refresh running for "_NMID
;
;Loop through concepts and clear out modified date for codes in codeset
S ^XTMP("BSTSLCMP","STS")="Marking entries as out of date"
S ICONC="" F S ICONC=$O(^BSTS(9002318.4,"C",NMID,ICONC)) Q:ICONC="" D
. S CIEN="" F S CIEN=$O(^BSTS(9002318.4,"C",NMID,ICONC,CIEN)) Q:CIEN="" D
.. NEW CDSET,BSTS,ERR,LMOD
.. ;
.. ;Skip partial entries
.. I $$GET1^DIQ(9002318.4,CIEN_",",.03,"I")="P" Q
.. ;
.. ;Check last modified - skip if toda
.. S LMOD=$$GET1^DIQ(9002318.4,CIEN_",",.12,"I") I LMOD'<RUNSTRT Q
.. ;
.. ;Mark as out of date
.. S BSTS(9002318.4,CIEN_",",".12")="@"
.. D FILE^DIE("","BSTS","ERR")
;
;
;Make the call to update the subset entries
S STS=$$SCODE^BSTSWSV1()
;
;Quit on failure
I +STS=0 S ^XTMP("BSTSLCMP","QUIT")=1 G XSUB
I $D(^XTMP("BSTSLCMP","QUIT")) G XSUB
;
;Need to loop through list again to catch any deletes
S ^XTMP("BSTSLCMP","STS")="Looking for entries removed from subsets"
S ABORT=0,ICONC="" F S ICONC=$O(^BSTS(9002318.4,"C",NMID,ICONC)) Q:ICONC="" Q:$D(^XTMP("BSTSLCMP","QUIT")) S SSCIEN="" F S SSCIEN=$O(^BSTS(9002318.4,"C",NMID,ICONC,SSCIEN)) Q:SSCIEN="" D Q:$D(^XTMP("BSTSLCMP","QUIT"))
. ;
. NEW LMOD,DTSID,SBVAR,CDSET,X1,X2,X,%H,FCNT,TRY
. ;
. ;Skip partial entries
. I $$GET1^DIQ(9002318.4,SSCIEN_",",.03,"I")="P" Q
. ;
. ;Get last modified date for concept
. S LMOD=$$GET1^DIQ(9002318.4,SSCIEN_",",".12","I")
. ;
. ;Skip if not out of date
. I LMOD'<RUNSTRT Q
. ;
. ;Get DTSId
. S DTSID=$$GET1^DIQ(9002318.4,SSCIEN_",",".08","I") Q:DTSID=""
. S ^XTMP("BSTSLCMP","STS")="Refreshing removed entry: "_SSCIEN_" DTSID: "_DTSID
. ;
. ;If Out of Date, retrieve detail from server - 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 ;Make sure the link is on
.. S STS=$$DTSLKP^BSTSAPI("SBVAR",DTSID) I +STS=2!(STS="0^") Q
.. S FCNT=FCNT+1 I FCNT'<MFAIL D ;Fail handling
... S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"SUB^BSTSVRSN - Refreshing entry: "_DTSID)
... I ABORT=1 S ^XTMP("BSTSLCMP","QUIT")=1 D ELOG^BSTSVOFL("SUBSET REFRESH FAILED ON DETAIL ENTRY: "_DTSID)
... S FCNT=0
;
;Check for failure
I $D(^XTMP("BSTSLCMP","QUIT")) G XSUB
;
;Process VUID and NDC
S STS=$$NVLKP^BSTSVOFL(MFAIL,FWAIT)
;
;Update LAST SUBSET RUN as completed today
D
. NEW BSTS,ERROR
. S BSTS(9002318.1,NMIEN_",",.1)=DT
. D FILE^DIE("","BSTS","ERROR")
;
;Make a log entry
D LOG^BSTSAPIL("UPDE",NMID,"SUBSET","")
;
XSUB NEW FAIL
S FAIL=$S($D(^XTMP("BSTSLCMP","QUIT")):1,1:0)
K ^XTMP("BSTSLCMP")
S:FAIL ^XTMP("BSTSLCMP","QUIT")=1
;
;Unlock entry
L -^BSTS(9002318.1,0)
;
Q
;
SBRSET ;EP - BSTS REFRESH SUBSETS option
;
;Moved to overflow routine because of size issues
D SBRSET^BSTSVOFL Q
;
ERR ;
D ^%ZTER
Q
BSTSVRSN ;GDIT/HS/BEE-Standard Terminology - Local File Handling ; 5 Nov 2012 9:53 AM
+1 ;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
+2 ;
+3 QUIT
+4 ;
CHECK ;EP - Check for new codeset versions and '36' subsets/custom codeset refreshes
+1 ;
+2 NEW SITE,BSTS,ERROR,ZTRTN,ZTDESC,ZTIO,ZTDTH
+3 ;
+4 ;Get Site Parameter IEN
+5 SET SITE=$ORDER(^BSTS(9002318,0))
IF 'SITE
GOTO XCHECK
+6 ;
+7 ;Quit if all checks have been completed for the day
+8 IF $$GET1^DIQ(9002318,SITE_",",".03","I")=DT
GOTO XCHECK
+9 ;
+10 ;Do not perform check if another process is already checking
+11 LOCK +^BSTS("VERSION CHECK"):0
IF '$TEST
GOTO XCHECK
+12 ;
+13 ;Do not perform check if background process is running
+14 LOCK +^BSTS(9002318.1,0):0
IF '$TEST
GOTO XCHECK
+15 LOCK -^BSTS(9002318.1,0)
+16 ;
+17 ;Make sure ICD9 to SNOMED background process isn't running
+18 LOCK +^TMP("BSTSICD2SMD"):0
IF '$TEST
GOTO XCHECK
+19 LOCK -^TMP("BSTSICD2SMD")
+20 ;
+21 ;Job off daily checks
+22 SET ZTRTN="DAYCHK^BSTSVOF1"
+23 SET ZTDESC="BSTS - Performing daily update checks"
+24 SET ZTIO=""
+25 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,2)
+26 DO ^%ZTLOAD
+27 ;
+28 ;Completed checks for day - mark parameter
+29 SET BSTS(9002318,SITE_",",.03)=DT
+30 DO FILE^DIE("","BSTS","ERROR")
+31 ;
XCHECK LOCK -^BSTS("VERSION CHECK")
+1 ;
+2 QUIT
+3 ;
+4 ;BSTS*2.0*1;Added override checking
VCHK(NMID,OVRRID) ;EP - Daily check for new version
+1 ;
+2 SET OVRRID=+$GET(OVRRID)
+3 ;
+4 NEW NMIEN,LVCKDT,STS,BSTS,ERROR,VAR,CVLCL,NVLCL,NVIEN,TRY,TR
+5 SET NMID=$GET(NMID,"")
IF NMID=""
SET NMID=36
IF NMID=30
SET NMID=36
+6 SET NMIEN=$ORDER(^BSTS(9002318.1,"B",NMID,""))
IF NMIEN=""
QUIT 0
+7 ;
+8 ;Pull last version check date
+9 SET LVCKDT=$$GET1^DIQ(9002318.1,NMIEN_",",.05,"I")
+10 IF 'OVRRID
IF LVCKDT'<DT
QUIT 0
+11 ;
+12 ;Pull the current version on file
+13 SET CVLCL=$$GET1^DIQ(9002318.1,NMIEN_",",".04","I")
+14 ;
+15 ;Perform version check
+16 SET STS=""
FOR TR=1:1:60
Begin DoDot:1
+17 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+18 SET STS=$$VERSIONS^BSTSAPI("VAR",NMID)
+19 IF +STS'=2
HANG TR
End DoDot:1
IF +STS=2
QUIT
+20 ;
+21 ;Check for successful remote call - If failure, don't check again today
+22 IF +STS'=2
Begin DoDot:1
+23 NEW BSTS,ERROR,SITE
+24 SET SITE=$ORDER(^BSTS(9002318,0))
IF SITE=""
QUIT
+25 SET BSTS(9002318,SITE_",",.03)=DT
+26 DO FILE^DIE("","BSTS","ERROR")
End DoDot:1
QUIT 2
+27 ;
+28 ;Get the current version from the codeset multiple
+29 SET NVIEN=$ORDER(^BSTS(9002318.1,NMIEN,1,"A"),-1)
+30 SET NVLCL=""
IF +NVIEN>0
Begin DoDot:1
+31 NEW DA,IENS
+32 SET DA(1)=NMIEN
SET DA=+NVIEN
SET IENS=$$IENS^DILF(.DA)
+33 SET NVLCL=$$GET1^DIQ(9002318.11,IENS,".01","I")
End DoDot:1
+34 ;
+35 ;If the current version value isn't equal to the latest in the multiple need to process
+36 IF NVLCL]""
IF CVLCL'=NVLCL
Begin DoDot:1
+37 ;
+38 ;For codesets 36, 5180, 1552
+39 IF (NMID=36)!(NMID=5180)!(NMID=1552)
DO QUEUE^BSTSVOFL(NMID)
QUIT
+40 ;
+41 ;For '36' ICD-10 autocodables
+42 IF NMID=32777
DO QUEUE^BSTSVOFL(NMID)
QUIT
+43 ;
+44 ;For '36' ICD-9 autocodables
+45 IF NMID=32778
DO QUEUE^BSTSVOFL(NMID)
QUIT
+46 ;
+47 ;For '36' ICD-10 conditionals
+48 IF NMID=32779
DO QUEUE^BSTSVOFL(NMID)
QUIT
+49 ;
+50 ;For '36' ICD-10 conditionals
+51 IF NMID=32780
DO QUEUE^BSTSVOFL(NMID)
QUIT
+52 ;
+53 ;For remaining custom codesets
+54 IF NMID'=32777
IF NMID'=32778
IF NMID'=32779
IF NMID'=36
IF NMID'=5180
IF NMID'=1552
DO QUEUE^BSTSVOFL(NMID)
QUIT
End DoDot:1
QUIT 1
+55 ;
+56 ;Update LAST VERSION CHECK
+57 SET BSTS(9002318.1,NMIEN_",",.05)=DT
+58 DO FILE^DIE("","BSTS","ERROR")
+59 ;
+60 QUIT 1
+61 ;
RES ;EP - Mark Local Codeset Entries As Out of Date
+1 ;
+2 ;Perform lock so only one process is allowed
+3 LOCK +^BSTS(9002318.1,0):0
IF '$TEST
QUIT
+4 ;
+5 NEW NMID,VDTS,STS,NVIEN,NVLCL,CIEN,BSTS,ERROR,VAR,X1,X2,X,TR,CVRSN
+6 ;
+7 ;Passed in variable
+8 SET NMIEN=$GET(NMIEN)
IF NMIEN=""
QUIT
+9 ;
+10 ;Get NMID
+11 SET NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I")
IF NMID=""
GOTO XRES
+12 ;
+13 ;Perform version check
+14 SET STS=""
FOR TR=1:1:60
Begin DoDot:1
+15 ;Make sure link is turned on
DO RESET^BSTSWSV1
+16 SET STS=$$VERSIONS^BSTSAPI("VAR",NMID)
+17 IF +STS'=2
HANG TR
End DoDot:1
IF +STS=2
QUIT
+18 ;
+19 ;Check for successful remote call - If offline quit
+20 IF +STS'=2
GOTO XRES
+21 ;
+22 ;Reset Monitoring Global
+23 KILL ^XTMP("BSTSLCMP")
+24 ;
+25 ;Get a later date
+26 SET X1=DT
SET X2=60
DO C^%DTC
+27 ;
+28 ;Get current version
+29 SET CVRSN=$$GET1^DIQ(9002318.1,NMIEN_",",.04,"I")
+30 ;
+31 ;Make a log entry
+32 DO LOG^BSTSAPIL("UPDS",NMID,"CURRENT",CVRSN)
+33 ;
+34 ;Set up Monitoring Global
+35 SET ^XTMP("BSTSLCMP","STS")=X_U_DT_U_"Cache Codeset refresh running for "_NMID
+36 ;
+37 ;Loop through each concept in the codeset and make it Out of Date
+38 SET VDTS=""
FOR
SET VDTS=$ORDER(^BSTS(9002318.4,"D",NMID,VDTS))
IF VDTS=""
QUIT
SET CIEN=0
FOR
SET CIEN=$ORDER(^BSTS(9002318.4,"D",NMID,VDTS,CIEN))
IF 'CIEN
QUIT
Begin DoDot:1
+39 ;
+40 ;Update status
+41 SET ^XTMP("BSTSLCMP","STS")="Marking entry "_CIEN_" as out of date"
+42 ;
+43 NEW BSTSUPD,ERR,TIEN
+44 ;
+45 ;Mark Entry as Out of Date
+46 SET BSTSUPD(9002318.4,CIEN_",",".11")="Y"
+47 ;
+48 ;Process the Associated Terms
+49 SET TIEN=""
FOR
SET TIEN=$ORDER(^BSTS(9002318.3,"C",NMID,CIEN,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+50 ;
+51 NEW BSTSTUPD,ERR
+52 ;
+53 ;Mark Entry as Out of Date
+54 SET BSTSTUPD(9002318.3,TIEN_",",".11")="Y"
+55 DO FILE^DIE("","BSTSTUPD","ERR")
End DoDot:2
+56 ;
+57 ;File entry
+58 IF $DATA(BSTSUPD)
DO FILE^DIE("","BSTSUPD","ERR")
End DoDot:1
+59 ;
+60 ;Update the current version
+61 ;
+62 ;Get the current version from the codeset multiple
+63 SET NVIEN=$ORDER(^BSTS(9002318.1,NMIEN,1,"A"),-1)
+64 SET NVLCL=""
IF +NVIEN>0
Begin DoDot:1
+65 NEW DA,IENS
+66 SET DA(1)=NMIEN
SET DA=+NVIEN
SET IENS=$$IENS^DILF(.DA)
+67 SET NVLCL=$$GET1^DIQ(9002318.11,IENS,".01","I")
End DoDot:1
+68 ;
+69 ;Now save it in the CURRENT VERSION field
+70 IF NVLCL]""
Begin DoDot:1
+71 NEW BSTS,ERROR
+72 SET BSTS(9002318.1,NMIEN_",",.04)=NVLCL
+73 DO FILE^DIE("","BSTS","ERROR")
End DoDot:1
+74 ;
+75 IF NMID=36
SET BSTS(9002318.1,NMIEN_",",.1)="@"
+76 IF '$TEST
SET BSTS(9002318.1,NMIEN_",",.05)="@"
+77 DO FILE^DIE("","BSTS","ERR")
+78 ;
+79 KILL ^XTMP("BSTSLCMP")
+80 ;
+81 ;Queue subset refresh - only if a total refresh isn't also scheduled
+82 IF '$DATA(^XTMP("BSTSPROCQ","B","ACODE^BSTSVRSC"))
IF NMID=36
DO QENTRY^BSTSVOFL("SUB^BSTSVRSN",NMIEN,"S36")
+83 ;
+84 ;
+85 ;Get current version
+86 SET CVRSN=$$GET1^DIQ(9002318.1,NMIEN_",",.04,"I")
+87 ;
+88 ;Make a log entry
+89 DO LOG^BSTSAPIL("UPDE",NMID,"CURRENT",CVRSN)
+90 ;
+91 ;Unlock entry
XRES LOCK -^BSTS(9002318.1,0)
+1 ;
+2 QUIT
+3 ;
SCHK(NMID,BKGND) ;EP - Check for periodic subset updates
+1 ;
+2 NEW LMDT,STS,BSTS,ERROR,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,NMIEN
+3 NEW VAR,SITE,SDAYS,ZTIO,SUBLST,X1,X2,X,%H,TR
+4 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BSTSVRSN D UNWIND^%ZTER"
+5 ;
+6 ;Only one SNOMED background process can be running at a time
+7 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
+8 LOCK -^BSTS(9002318.1,0)
+9 ;
+10 ;Make sure ICD9 to SNOMED background process isn't running
+11 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
+12 LOCK -^TMP("BSTSICD2SMD")
+13 ;
+14 SET NMID=$GET(NMID,"")
IF NMID=""
SET NMID=36
IF NMID=30
SET NMID=36
+15 ;
+16 ;Only run it for codeset 36
+17 IF NMID'=36
QUIT
+18 ;
+19 ;Get Site Parameter IEN
+20 SET SITE=$ORDER(^BSTS(9002318,0))
IF 'SITE
QUIT
+21 ;
+22 ;Get subset update days
+23 SET SDAYS=$$GET1^DIQ(9002318,SITE_",",.02,"I")
IF SDAYS=""
SET SDAYS=60
+24 ;
+25 ;Make sure we have a codeset (namespace)
+26 SET NMIEN=$ORDER(^BSTS(9002318.1,"B",NMID,""))
IF NMIEN=""
QUIT
+27 ;
+28 ;Update LAST SUBSET CHECK as completed today
+29 Begin DoDot:1
+30 NEW BSTS,ERROR
+31 SET BSTS(9002318.1,NMIEN_",",.06)=DT
+32 DO FILE^DIE("","BSTS","ERROR")
End DoDot:1
+33 ;
+34 ;Check if refresh needs run
+35 SET LMDT=$$GET1^DIQ(9002318.1,NMIEN,".1","I")
+36 IF LMDT>0
SET X1=LMDT
SET X2=SDAYS
DO C^%DTC
SET LMDT=X
+37 IF LMDT>DT
QUIT
+38 ;
+39 ;Only run if server set up
+40 SET STS=""
FOR TR=1:1:60
Begin DoDot:1
+41 ;Reset the DTS link to on
DO RESET^BSTSWSV1
+42 ;Try a quick call to see if call works
SET STS=$$VERSIONS^BSTSAPI("VAR")
+43 IF +STS'=2
HANG TR
End DoDot:1
IF +STS=2
QUIT
+44 IF +STS'=2
GOTO XSCHK
+45 ;
+46 ;Queue the process off in the background
+47 ;Daily check - queue
IF +$GET(BKGND)
DO QUEUE^BSTSVOFL("S36")
QUIT
+48 ;Manual - run now
DO CDJOB^BSTSUTIL(NMIEN,"S","")
+49 ;
XSCHK QUIT
+1 ;
SUB ;EP - Update IHS Standard Terminology Subsets
+1 ;
+2 ;Perform lock so only one process is allowed
+3 LOCK +^BSTS(9002318.1,0):1
IF '$TEST
QUIT
+4 ;
+5 NEW NMID,SDAYS,SITE
+6 ;
+7 ;Retrieve passed in variable
+8 SET NMIEN=$GET(NMIEN)
IF NMIEN=""
QUIT
+9 ;
+10 ;Get NMID
+11 SET NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I")
IF NMID=""
QUIT
+12 ;
+13 ;Get Site Parameter IEN
+14 SET SITE=$ORDER(^BSTS(9002318,0))
IF 'SITE
QUIT
+15 ;
+16 ;Get subset update days
+17 SET SDAYS=$$GET1^DIQ(9002318,SITE_",",.02,"I")
IF SDAYS=""
SET SDAYS=60
+18 ;
+19 NEW BSTS,ERROR,CIEN,BSTSSB,STS,CNC,SUBLST,SSCIEN,ICONC,X,X1,X2,ITEM,%H
+20 NEW MFAIL,FWAIT,FCNT,ABORT,RUNSTRT,TR
+21 ;
+22 ;Note the run date
+23 SET RUNSTRT=DT
+24 ;
+25 ;Only run if server up
+26 SET STS=""
FOR TR=1:1:60
Begin DoDot:1
+27 ;Reset DTS to on
DO RESET^BSTSWSV1
+28 ;Try quick call
SET STS=$$VERSIONS^BSTSAPI("VRSN")
+29 IF +STS'=2
HANG TR
End DoDot:1
IF +STS=2
QUIT
+30 IF +STS'=2
GOTO XSUB
+31 ;
+32 ;Reset Monitoring Global
+33 KILL ^XTMP("BSTSLCMP")
+34 ;
+35 ;Get a later date
+36 SET X1=DT
SET X2=60
DO C^%DTC
+37 ;
+38 ;Retrieve Failover Variables
+39 SET MFAIL=$$FPARMS^BSTSVOFL()
+40 SET FWAIT=$PIECE(MFAIL,U,2)
+41 SET MFAIL=$PIECE(MFAIL,U)
+42 ;
+43 ;Update SUBSET TASK NUMBER
+44 IF +$GET(ZTSK)>0
Begin DoDot:1
+45 NEW BSTS,ERROR
+46 SET BSTS(9002318.1,NMIEN_",",.08)=ZTSK
+47 DO FILE^DIE("","BSTS","ERROR")
End DoDot:1
+48 ;
+49 ;Make a log entry
+50 DO LOG^BSTSAPIL("UPDS",NMID,"SUBSET","")
+51 ;
+52 ;Set up Monitoring Global
+53 SET ^XTMP("BSTSLCMP",0)=X_U_DT_U_"Cache subset refresh running for "_NMID
+54 ;
+55 ;Loop through concepts and clear out modified date for codes in codeset
+56 SET ^XTMP("BSTSLCMP","STS")="Marking entries as out of date"
+57 SET ICONC=""
FOR
SET ICONC=$ORDER(^BSTS(9002318.4,"C",NMID,ICONC))
IF ICONC=""
QUIT
Begin DoDot:1
+58 SET CIEN=""
FOR
SET CIEN=$ORDER(^BSTS(9002318.4,"C",NMID,ICONC,CIEN))
IF CIEN=""
QUIT
Begin DoDot:2
+59 NEW CDSET,BSTS,ERR,LMOD
+60 ;
+61 ;Skip partial entries
+62 IF $$GET1^DIQ(9002318.4,CIEN_",",.03,"I")="P"
QUIT
+63 ;
+64 ;Check last modified - skip if toda
+65 SET LMOD=$$GET1^DIQ(9002318.4,CIEN_",",.12,"I")
IF LMOD'<RUNSTRT
QUIT
+66 ;
+67 ;Mark as out of date
+68 SET BSTS(9002318.4,CIEN_",",".12")="@"
+69 DO FILE^DIE("","BSTS","ERR")
End DoDot:2
End DoDot:1
+70 ;
+71 ;
+72 ;Make the call to update the subset entries
+73 SET STS=$$SCODE^BSTSWSV1()
+74 ;
+75 ;Quit on failure
+76 IF +STS=0
SET ^XTMP("BSTSLCMP","QUIT")=1
GOTO XSUB
+77 IF $DATA(^XTMP("BSTSLCMP","QUIT"))
GOTO XSUB
+78 ;
+79 ;Need to loop through list again to catch any deletes
+80 SET ^XTMP("BSTSLCMP","STS")="Looking for entries removed from subsets"
+81 SET ABORT=0
SET ICONC=""
FOR
SET ICONC=$ORDER(^BSTS(9002318.4,"C",NMID,ICONC))
IF ICONC=""
QUIT
IF $DATA(^XTMP("BSTSLCMP","QUIT"))
QUIT
SET SSCIEN=""
FOR
SET SSCIEN=$ORDER(^BSTS(9002318.4,"C",NMID,ICONC,SSCIEN))
IF SSCIEN=""
QUIT
Begin DoDot:1
+82 ;
+83 NEW LMOD,DTSID,SBVAR,CDSET,X1,X2,X,%H,FCNT,TRY
+84 ;
+85 ;Skip partial entries
+86 IF $$GET1^DIQ(9002318.4,SSCIEN_",",.03,"I")="P"
QUIT
+87 ;
+88 ;Get last modified date for concept
+89 SET LMOD=$$GET1^DIQ(9002318.4,SSCIEN_",",".12","I")
+90 ;
+91 ;Skip if not out of date
+92 IF LMOD'<RUNSTRT
QUIT
+93 ;
+94 ;Get DTSId
+95 SET DTSID=$$GET1^DIQ(9002318.4,SSCIEN_",",".08","I")
IF DTSID=""
QUIT
+96 SET ^XTMP("BSTSLCMP","STS")="Refreshing removed entry: "_SSCIEN_" DTSID: "_DTSID
+97 ;
+98 ;If Out of Date, retrieve detail from server - Hang max of 12 times
+99 SET (FCNT,STS)=0
FOR TRY=1:1:(12*MFAIL)
Begin DoDot:2
+100 ;Make sure the link is on
DO RESET^BSTSWSV1
+101 SET STS=$$DTSLKP^BSTSAPI("SBVAR",DTSID)
IF +STS=2!(STS="0^")
QUIT
+102 ;Fail handling
SET FCNT=FCNT+1
IF FCNT'<MFAIL
Begin DoDot:3
+103 SET ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"SUB^BSTSVRSN - Refreshing entry: "_DTSID)
+104 IF ABORT=1
SET ^XTMP("BSTSLCMP","QUIT")=1
DO ELOG^BSTSVOFL("SUBSET REFRESH FAILED ON DETAIL ENTRY: "_DTSID)
+105 SET FCNT=0
End DoDot:3
End DoDot:2
IF +STS=2!(STS="0^")
QUIT
End DoDot:1
IF $DATA(^XTMP("BSTSLCMP","QUIT"))
QUIT
+106 ;
+107 ;Check for failure
+108 IF $DATA(^XTMP("BSTSLCMP","QUIT"))
GOTO XSUB
+109 ;
+110 ;Process VUID and NDC
+111 SET STS=$$NVLKP^BSTSVOFL(MFAIL,FWAIT)
+112 ;
+113 ;Update LAST SUBSET RUN as completed today
+114 Begin DoDot:1
+115 NEW BSTS,ERROR
+116 SET BSTS(9002318.1,NMIEN_",",.1)=DT
+117 DO FILE^DIE("","BSTS","ERROR")
End DoDot:1
+118 ;
+119 ;Make a log entry
+120 DO LOG^BSTSAPIL("UPDE",NMID,"SUBSET","")
+121 ;
XSUB 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 entry
+6 LOCK -^BSTS(9002318.1,0)
+7 ;
+8 QUIT
+9 ;
SBRSET ;EP - BSTS REFRESH SUBSETS option
+1 ;
+2 ;Moved to overflow routine because of size issues
+3 DO SBRSET^BSTSVOFL
QUIT
+4 ;
ERR ;
+1 DO ^%ZTER
+2 QUIT
