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

BSTSVRXN.m

Go to the documentation of this file. 
  1. BSTSVRXN ;GDIT/HS/BEE-Standard Terminology - RxNorm Subset Updates ; 5 Nov 2012  9:53 AM
  1.  ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
  1.  ;
  1.  Q
  1.  ;
  1. SCHK(NMID,BKGND) ;EP - Check for periodic RxNorm subset updates
  1.  ;
  1.  NEW LMDT,STS,BSTS,ERROR,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,NMIEN
  1.  NEW VAR,SITE,SDAYS,ZTIO,SUBLST,X1,X2,X,%H,TR
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSVRXN D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Only one SNOMED background process can be running at a time
  1.  I '$G(BKGND)  L +^BSTS(9002318.1,0):0 E  W !!,"A Local Cache Refresh is Already Running. Please Try Later" H 3 Q
  1.  L -^BSTS(9002318.1,0)
  1.  ;
  1.  ;Make sure ICD9 to SNOMED background process isn't running
  1.  I '$G(BKGND) L +^TMP("BSTSICD2SMD"):0 E  W !!,"An ICD9 to SNOMED Background Process is Already Running. Please Try Later" H 3 Q
  1.  L -^TMP("BSTSICD2SMD")
  1.  ;
  1.  S NMID=$G(NMID,"") S:NMID="" NMID=1552
  1.  ;
  1.  ;Only run it for codeset 1552
  1.  I NMID'=1552 Q
  1.  ;
  1.  ;Get Site Parameter IEN
  1.  S SITE=$O(^BSTS(9002318,0)) Q:'SITE
  1.  ;
  1.  ;Get subset update days
  1.  S SDAYS=$$GET1^DIQ(9002318,SITE_",",.02,"I") S:SDAYS="" SDAYS=60
  1.  ;
  1.  ;Make sure we have a codeset (namespace)
  1.  S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) Q:NMIEN=""
  1.  ;
  1.  ;Update LAST SUBSET CHECK as completed today
  1.  D
  1.  . NEW BSTS,ERROR
  1.  . S BSTS(9002318.1,NMIEN_",",.06)=DT
  1.  . D FILE^DIE("","BSTS","ERROR")
  1.  ;
  1.  ;Check if refresh needs run
  1.  S LMDT=$$GET1^DIQ(9002318.1,NMIEN,".1","I")
  1.  I LMDT>0 S X1=LMDT,X2=SDAYS D C^%DTC S LMDT=X
  1.  I LMDT>DT Q
  1.  ;
  1.  ;Only run if server set up
  1.  S STS="" F TR=1:1:60 D  I +STS=2 Q
  1.  . D RESET^BSTSWSV1  ;Reset the DTS link to on
  1.  . S STS=$$VERSIONS^BSTSAPI("VAR") ;Try a quick call to see if call works
  1.  . I +STS'=2 H TR
  1.  I +STS'=2 G XSCHK
  1.  ;
  1.  ;Queue the process off in the background
  1.  I +$G(BKGND) D QUEUE^BSTSVOFL("S1552") Q  ;Daily check - queue
  1.  D CDJOB^BSTSUTIL(NMIEN,"S1552","")  ;Manual - run now
  1.  ;
  1. XSCHK Q
  1.  ;
  1. SUB ;EP - Update IHS Standard Terminology RxNorm Subsets
  1.  ;
  1.  ;Perform lock so only one process is allowed
  1.  L +^BSTS(9002318.1,0):1 E  Q
  1.  ;
  1.  NEW NMID,SDAYS,SITE
  1.  ;
  1.  ;Retrieve passed in variable
  1.  S NMIEN=$G(NMIEN) I NMIEN="" Q
  1.  ;
  1.  ;Get NMID
  1.  S NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I") I NMID="" Q
  1.  ;
  1.  ;Get Site Parameter IEN
  1.  S SITE=$O(^BSTS(9002318,0)) Q:'SITE
  1.  ;
  1.  ;Get subset update days
  1.  S SDAYS=$$GET1^DIQ(9002318,SITE_",",.02,"I") S:SDAYS="" SDAYS=60
  1.  ;
  1.  NEW BSTS,ERROR,CIEN,BSTSSB,STS,CNC,SUBLST,SSCIEN,ICONC,X,X1,X2,ITEM,%H
  1.  NEW MFAIL,FWAIT,FCNT,ABORT,RUNSTRT,TR
  1.  ;
  1.  ;Note the run date
  1.  S RUNSTRT=DT
  1.  ;
  1.  ;Only run if server up
  1.  S STS="" F TR=1:1:60 D  I +STS=2 Q
  1.  . D RESET^BSTSWSV1  ;Reset DTS to on
  1.  . S STS=$$VERSIONS^BSTSAPI("VRSN") ;Try quick call
  1.  . I +STS'=2 H TR
  1.  I +STS'=2 G XSUB
  1.  ;
  1.  ;Reset Monitoring Global
  1.  K ^XTMP("BSTSLCMP")
  1.  ;
  1.  ;Get a later date
  1.  S X1=DT,X2=60 D C^%DTC
  1.  ;
  1.  ;Retrieve Failover Variables
  1.  S MFAIL=$$FPARMS^BSTSVOFL()
  1.  S FWAIT=$P(MFAIL,U,2)
  1.  S MFAIL=$P(MFAIL,U)
  1.  ;
  1.  ;Update SUBSET TASK NUMBER
  1.  I +$G(ZTSK)>0 D
  1.  . NEW BSTS,ERROR
  1.  . S BSTS(9002318.1,NMIEN_",",.08)=ZTSK
  1.  . D FILE^DIE("","BSTS","ERROR")
  1.  ;
  1.  ;Set up Monitoring Global
  1.  S ^XTMP("BSTSLCMP",0)=X_U_DT_U_"RxNorm Cache subset refresh running for "_NMID
  1.  ;
  1.  ;Loop through concepts and clear out modified date for codes in codeset
  1.  S ^XTMP("BSTSLCMP","STS")="Marking entries as out of date"
  1.  S ICONC="" F  S ICONC=$O(^BSTS(9002318.4,"C",NMID,ICONC)) Q:ICONC=""  D
  1.  . S CIEN="" F  S CIEN=$O(^BSTS(9002318.4,"C",NMID,ICONC,CIEN)) Q:CIEN=""  D
  1.  .. NEW CDSET,BSTS,ERR,LMOD
  1.  .. ;
  1.  .. ;Skip partial entries
  1.  .. I $$GET1^DIQ(9002318.4,CIEN_",",.03,"I")="P" Q
  1.  .. ;
  1.  .. ;Check last modified - skip if today
  1.  .. S LMOD=$$GET1^DIQ(9002318.4,CIEN_",",.12,"I") I LMOD'<RUNSTRT Q
  1.  .. ;
  1.  .. ;Mark as out of date
  1.  .. S BSTS(9002318.4,CIEN_",",".12")="@"
  1.  .. D FILE^DIE("","BSTS","ERR")
  1.  ;
  1.  ;Make the call to update the subset entries
  1.  S STS=$$SCODE^BSTSWSV1(1552)
  1.  ;
  1.  ;Quit on failure
  1.  I +STS=0 S ^XTMP("BSTSLCMP","QUIT")=1 G XSUB
  1.  I $D(^XTMP("BSTSLCMP","QUIT")) G XSUB
  1.  ;
  1.  ;Need to loop through list again to catch any deletes
  1.  S ^XTMP("BSTSLCMP","STS")="Looking for entries removed from subsets"
  1.  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"))
  1.  . ;
  1.  . NEW LMOD,DTSID,SBVAR,CDSET,X1,X2,X,%H,FCNT,TRY
  1.  . ;
  1.  . ;Skip partial entries
  1.  . I $$GET1^DIQ(9002318.4,SSCIEN_",",.03,"I")="P" Q
  1.  . ;
  1.  . ;Get last modified date for concept
  1.  . S LMOD=$$GET1^DIQ(9002318.4,SSCIEN_",",".12","I")
  1.  . ;
  1.  . ;Skip if not out of date
  1.  . I LMOD'<RUNSTRT Q
  1.  . ;
  1.  . ;Get DTSId
  1.  . S DTSID=$$GET1^DIQ(9002318.4,SSCIEN_",",".08","I") Q:DTSID=""
  1.  . S ^XTMP("BSTSLCMP","STS")="Refreshing removed entry: "_SSCIEN_" DTSID: "_DTSID
  1.  . ;
  1.  . ;If Out of Date, retrieve detail from server - Hang max of 12 times
  1.  . S (FCNT,STS)=0 F TRY=1:1:(12*MFAIL) D  I +STS=2!(STS="0^") Q
  1.  .. D RESET^BSTSWSV1 ;Make sure the link is on
  1.  .. S STS=$$DTSLKP^BSTSAPI("SBVAR",DTSID_"^1552") I +STS=2!(STS="0^") Q
  1.  .. S FCNT=FCNT+1 I FCNT'<MFAIL D  ;Fail handling
  1.  ... S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"SUB^BSTSVRSN - Refreshing entry: "_DTSID)
  1.  ... I ABORT=1 S ^XTMP("BSTSLCMP","QUIT")=1 D ELOG^BSTSVOFL("SUBSET REFRESH FAILED ON DETAIL ENTRY: "_DTSID)
  1.  ... S FCNT=0
  1.  ;
  1.  ;Check for failure
  1.  I $D(^XTMP("BSTSLCMP","QUIT")) G XSUB
  1.  ;
  1.  ;Process VUID and NDC
  1.  ;S STS=$$NVLKP^BSTSVOFL(MFAIL,FWAIT)
  1.  ;
  1.  ;Update LAST SUBSET RUN as completed today
  1.  D
  1.  . NEW BSTS,ERROR
  1.  . S BSTS(9002318.1,NMIEN_",",.1)=DT
  1.  . D FILE^DIE("","BSTS","ERROR")
  1.  ;
  1. XSUB NEW FAIL
  1.  S FAIL=$S($D(^XTMP("BSTSLCMP","QUIT")):1,1:0)
  1.  K ^XTMP("BSTSLCMP")
  1.  S:FAIL ^XTMP("BSTSLCMP","QUIT")=1
  1.  ;
  1.  ;Unlock entry
  1.  L -^BSTS(9002318.1,0)
  1.  ;
  1.  Q
  1.  ;
  1. SBRSET ;EP - BSTS REFRESH SUBSETS option
  1.  ;
  1.  ;Moved to overflow routine because of size issues
  1.  D SBRSET^BSTSVOFL Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  Q