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

BSTSVOF1.m

Go to the documentation of this file. 
  1. BSTSVOF1 ;GDIT/HS/BEE-Standard Terminology - Versioning handling overflow 2 ; 5 Nov 2012  9:53 AM
  1.  ;;2.0;IHS STANDARD TERMINOLOGY;**1**;Dec 01, 2016;Build 36
  1.  ;
  1.  Q
  1.  ;
  1.  ;BSTS*1.0*6;Change to updates
  1.  ;Run the PCC update option
  1.  ;BSTS*2.0*1;CR#8457;Switch DUZ to PCC UIFS UPDATE USER (or ADAM,ADAM)
  1. UIFS(ZTQUEUED) ;Run the PCC UIFS option
  1.  ;
  1.  S:'$D(ZTQUEUED) ZTQUEUED=1
  1.  ;
  1.  NEW NDUZ,ODUZ,DA
  1.  ;
  1.  ;Retrieve the default BSTS,PROXY USER
  1.  S NDUZ=$O(^VA(200,"B","BSTS,PROXY USER",""))
  1.  S:NDUZ="" NDUZ=DUZ  ;Default to existing user if BSTS,PROXY USER cannot be found
  1.  ;
  1.  ;Switch users, run PCC UIFS option, and switch back to original user
  1.  S ^XTMP("BSTSLCMP","STS")="Running the PCC Update ICD-10 Diagnoses from SNOMED Concept ID (UIFS) option"
  1. EX1 M ODUZ=DUZ K DUZ S DUZ=NDUZ D DUZ^XUP(.DUZ) D QUEUE^APCDPLFH K DUZ M DUZ=ODUZ  ;SAC Exemption Granted 1/31/17-See bsts0200.01t
  1.  Q
  1.  ;
  1. ASKSB() ;Ask Individual Subset
  1.  ;
  1.  NEW DIR,X,Y,SUBSET,DIRUT,DUOUT,SLIST,STS,I
  1.  ;
  1.  ;Get subsets
  1.  S STS=$$SUBSET^BSTSAPI("SLIST","^2")
  1.  ;
  1.  S SLIST="" F  S SLIST=$O(SLIST(SLIST)) Q:'SLIST  I SLIST(SLIST)]"" S SLIST("B",SLIST(SLIST))=""  ;Sort
  1.  S SLIST="" F I=1:1 S SLIST=$O(SLIST("B",SLIST)) Q:SLIST=""  S DIR("?",I)=SLIST
  1.  ;
  1.  S SUBSET=""
  1.  ;
  1. ASKSB1 W !! S DIR("?")="Select a subset from the following list or type ALL for all subsets"
  1.  S DIR("A")="Enter the exact name of the subset to refresh or ALL: "
  1.  S DIR("B")="ALL"
  1.  S DIR(0)="F^3:50"
  1.  D ^DIR I $G(DIRUT)!$G(DUOUT)!(Y="") Q "-1"
  1.  ;
  1.  ;BSTS*1.0*4;Filter out IHS PROBLEM ALL SNOMED
  1.  I Y="IHS PROBLEM ALL SNOMED" W !!,"CANNOT DOWNLOAD IHS PROBLEM ALL SNOMED" H 3 G ASKSB1
  1.  I Y]"",Y'="ALL",'$D(SLIST("B",Y)) W !!,"INVALID SUBSET" H 3 G ASKSB1
  1.  ;
  1.  S SUBSET=Y
  1.  ;
  1.  Q SUBSET
  1.  ;
  1. ISCHK(SUBSET) ;EP - Recompile one subset
  1.  ;
  1.  NEW STS,VAR,ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BSTSUPD,ERROR,FIELD,ZTSK,TR
  1.  ;
  1.  ;Only one SNOMED background process can be running at a time
  1.  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.  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.  ;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 W !!,"The DTS server link is down. Aborting..." G XISCHK
  1.  ;
  1.  ;Queue the process off in the background
  1.  S ZTRTN="ISUB^BSTSVOF1",ZTDESC="BSTS - Refresh BSTS subset "_SUBSET
  1.  S ZTSAVE("SUBSET")=""
  1.  ;
  1.  S ZTIO=""
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,2)
  1.  D ^%ZTLOAD
  1.  I $G(ZTSK)]"" W !!,"Task: ",ZTSK," scheduled to start in two minutes"
  1.  ;
  1. XISCHK Q
  1.  ;
  1. ISUB ;Recompile one subset
  1.  ;
  1.  ;Perform lock so only one process is allowed
  1.  L +^BSTS(9002318.1,0):1 E  Q
  1.  ;
  1.  NEW BSTSBPRC,MFAIL,FWAIT,TRY,STS,ABORT,NMIEN,CIEN
  1.  ;
  1.  I $G(SUBSET)="" G XISUB
  1.  ;
  1.  ;Save current entries
  1.  K ^TMP("BSTSISUB",$J)
  1.  S NMIEN=$O(^BSTS(9002318.1,"B",36,"")) I NMIEN="" G XISUB
  1.  S CIEN="" F  S CIEN=$O(^BSTS(9002318.4,"E",NMIEN,SUBSET,CIEN)) Q:CIEN=""  S ^TMP("BSTSISUB",$J,CIEN)=$$GET1^DIQ(9002318.4,CIEN_",",.08,"I")
  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.  ;Make the call until success - Hang max of 12 times
  1.  S ABORT=0 F TRY=1:1:(12*MFAIL) D  Q:$D(^XTMP("BSTSLCMP","QUIT"))  I +STS=2!(STS="0^") Q
  1.  . NEW IN,OUT
  1.  . S IN=SUBSET_"^^2",FCNT=0
  1.  . S OUT=$NA(^TMP("BSTSSUPD",$J)) K @OUT
  1.  . S BSTSBPRC=1  ;Set variable showing background call
  1.  . D RESET^BSTSWSV1 ;Make sure the link is on
  1.  . S STS=$$SUBLST^BSTSAPI(OUT,IN) I +STS=2 Q  ;Quit if success
  1.  . Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  . S FCNT=FCNT+1 I FCNT'<MFAIL D  ;Fail handling
  1.  .. S ABORT=$$FAIL^BSTSVOFL(MFAIL,FWAIT,TRY,"SUB^BSTSVOD1 - Processing subset: "_SUBSET)
  1.  . I ABORT=1 S ^XTMP("BSTSLCMP","QUIT")=1 D ELOG^BSTSVOFL("SUBSET REFRESH FAILED ON SUBSET: "_SUBSET)
  1.  . S FCNT=0
  1.  ;
  1.  ;Look for removed entries
  1.  I ABORT=0 S CIEN="" F  S CIEN=$O(^TMP("BSTSISUB",$J,CIEN)) Q:CIEN=""  D  Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  . NEW LMOD,DTSID,ABORT,FCNT,TRY
  1.  . S DTSID=$G(^TMP("BSTSISUB",$J,CIEN)) Q:DTSID=""
  1.  . ;
  1.  . ;Check last modified - skip if today
  1.  . S LMOD=$$GET1^DIQ(9002318.4,CIEN_",",.12,"I") I LMOD'<DT Q
  1.  . ;
  1.  . ;Pull detail from DTS - Hang max of 12 times
  1.  . S (ABORT,FCNT)=0 F TRY=1:1:(12*MFAIL) D  I +STS=2!(STS="0^") Q
  1.  .. D RESET^BSTSWSV1  ;Reset the DTS link to on
  1.  .. S STS=$$DTSLKP^BSTSAPI("VAR",DTSID_"^36^^^^1") 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,"ISUB^BSTSVRSN - Getting Update for entry: "_DTSID)
  1.  ... I ABORT=1 S ^XTMP("BSTSLCMP","QUIT")=1 D ELOG^BSTSVOFL(SUBSET_" SUBSET REFRESH FAILED ON DETAIL LOOKUP: "_DTSID)
  1.  ... S FCNT=0
  1.  ;
  1. XISUB L -^BSTS(9002318.1,0)
  1.  K ^TMP("BSTSISUB",$J)
  1.  Q
  1.  ;
  1. UPCNC ;Refresh any outdated concepts
  1.  ;
  1.  NEW DTSID,ABORT,CIEN,STS,MFAIL,FWAIT,X1,X2,X
  1.  ;
  1.  ;
  1.  ;Perform lock
  1.  L +^BSTS(9002318.1,0):0 E  Q
  1.  ;
  1.  ;Reset Monitoring Global
  1.  K ^XTMP("BSTSLCMP")
  1.  ;
  1.  ;Get later date
  1.  S X1=DT,X2=60 D C^%DTC
  1.  ;
  1.  ;Set up Monitoring Global
  1.  S ^XTMP("BSTSLCMP",0)=X_U_DT_U_"Updating concepts found to be out of date"
  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.  ;Look for removed entries
  1.  S ABORT=0,STS="" S CIEN="" F  S CIEN=$O(^XTMP("BSTSPROCQ","C",CIEN)) Q:CIEN=""  D  Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  . NEW LMOD,DTSID,FCNT,TRY,DTSID,NMID,OOD
  1.  . ;
  1.  . ;Get DTSId
  1.  . S DTSID=$$GET1^DIQ(9002318.4,CIEN_",",".08","I") I DTSID="" K ^XTMP("BSTSPROCQ","C",CIEN) Q
  1.  . ;
  1.  . ;Get NMID
  1.  . S NMID=$$GET1^DIQ(9002318.4,CIEN_",",.07,"E") I NMID="" K ^XTMP("BSTSPROCQ","C",CIEN) Q
  1.  . ;
  1.  . ;Check last modified - skip if today
  1.  . S OOD=$$GET1^DIQ(9002318.4,CIEN_",",".11","I")
  1.  . S LMOD=$$GET1^DIQ(9002318.4,CIEN_",",.12,"I") I OOD'="Y",LMOD'<DT K ^XTMP("BSTSPROCQ","C",CIEN) Q
  1.  . ;
  1.  . S ^XTMP("BSTSLCMP","STS")="Updating out of date entry with DTSID: "_DTSID
  1.  . ;Pull detail from DTS - Hang max of 12 times
  1.  . S (ABORT,FCNT)=0 F TRY=1:1:(12*MFAIL) D  I +STS=2!(STS="0^") Q
  1.  .. D RESET^BSTSWSV1  ;Reset the DTS link to on
  1.  .. S STS=$$DTSLKP^BSTSAPI("VAR",DTSID_"^"_NMID_"^^^^1") 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,"UPCNC^BSTSVOF1 - Getting Update for entry: "_DTSID)
  1.  ... I ABORT=1 S ^XTMP("BSTSLCMP","QUIT")=1 D ELOG^BSTSVOFL("UPCNC^BSTSVOF1 Refresh failed on entry: "_DTSID)
  1.  ... S FCNT=0
  1.  . ;
  1.  . ;Clear entry
  1.  . I +STS=2!(STS="0^") K ^XTMP("BSTSPROCQ","C",CIEN)
  1.  ;
  1. XUPCNC ;
  1.  ;
  1.  ;Unlock entry
  1.  L -^BSTS(9002318.1,0)
  1.  ;
  1.  ;Reset Monitoring Global
  1.  K ^XTMP("BSTSLCMP")
  1.  ;
  1.  Q
  1.  ;
  1. CLLMDT(NMID) ;Mark CODESET concepts last modified date to null
  1.  ;
  1.  I $G(NMID)="" Q
  1.  ;
  1.  NEW ICONC,CIEN
  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,LMD,OOD
  1.  .. ;
  1.  .. ;Skip partial entries
  1.  .. I $$GET1^DIQ(9002318.4,CIEN_",",.03,"I")="P" Q
  1.  .. ;
  1.  .. ;Don't clear if updated today (or later as process could run across days)
  1.  .. S OOD=$$GET1^DIQ(9002318.4,CIEN_",",.11,"I")
  1.  .. S LMD=$$GET1^DIQ(9002318.4,CIEN_",",.12,"I")
  1.  .. I OOD'="Y",LMD'<DT Q
  1.  .. ;
  1.  .. ;Mark as out of date
  1.  .. S ^XTMP("BSTSLCMP","STS")="Marking entry "_CIEN_" as out of date"
  1.  .. S BSTS(9002318.4,CIEN_",",".12")="@"
  1.  .. D FILE^DIE("","BSTS","ERR")
  1.  ;
  1.  Q
  1.  ;
  1.  ;BSTS*2.0*1;Added override checking
  1. DAYCHK(OVRRID) ;Perform daily update checks - jobbed off by CHECK^BSTSVRSN
  1.  ;
  1.  S OVRRID=+$G(OVRRID)
  1.  ;
  1.  NEW BSTS,STS,NMIEN,ZTSK,SITE,ERROR,ZTRTN,ZTDESC,ZTIO,ZTDTH,TFND,ZT1,ZTS
  1.  ;
  1.  ;Get Site Parameter IEN
  1.  S SITE=$O(^BSTS(9002318,0)) I 'SITE G XDAYCHK
  1.  ;
  1.  ;Check for new SNOMED CT US Extension '36' version - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(36,OVRRID)
  1.  ;
  1.  ;Check for new RxNorm R '1552' version - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(1552,OVRRID)
  1.  ;
  1.  ;Check for new UNII '5180' version - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(5180,OVRRID)
  1.  ;
  1.  ;Check for new IHS VANDF '32771' - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(32771,OVRRID)
  1.  ;
  1.  ;Check for new GMRA Signs Symptoms '32772' - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(32772,OVRRID)
  1.  ;
  1.  ;Check for new GMRA Allergies with Maps '32773' - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(32773,OVRRID)
  1.  ;
  1.  ;Check for new IHS Med Route '32774' - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(32774,OVRRID)
  1.  ;
  1.  ;Check for new CPT Meds with Maps '32775' - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(32775,OVRRID)
  1.  ;
  1.  ;Check for new SNOMED CT to ICD-10-CM Auto-Codeables '32777' - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(32777,OVRRID)
  1.  ;
  1.  ;Check for new SNOMED CT to ICD-10-CM Auto-Codeables '32779' - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(32779,OVRRID)
  1.  ;
  1.  ;BSTS*1.0*7;Added 32780 check
  1.  ;Check for new SNOMED CT to ICD-10-CM Auto-Codeables '32780' - Quit if check performed or DTS timed out
  1.  S STS=$$VCHK^BSTSVRSN(32780,OVRRID)
  1.  ;
  1.  ;Check for new SNOMED CT to ICD-9-CM Auto-Codeables '32778' - Quit if check performed or DTS timed out
  1.  ;BSTS*1.0*6;No longer look for ICD9 updates
  1.  ;S STS=$$VCHK(32778) I STS G XCHECK
  1.  ;
  1.  ;Check for needed subset refresh - Also refresh VUID/NDC entries
  1.  S NMIEN=$O(^BSTS(9002318.1,"B",36,"")) I NMIEN="" G XDAYCHK
  1.  I ($$GET1^DIQ(9002318.1,NMIEN_",",.06,"I")'=DT)!(OVRRID) D SCHK^BSTSVRSN(36,1)
  1.  ;
  1.  ;Check for needed RxNorm subset refresh
  1.  S NMIEN=$O(^BSTS(9002318.1,"B",1552,"")) I NMIEN="" G XDAYCHK
  1.  I ($$GET1^DIQ(9002318.1,NMIEN_",",.06,"I")'=DT)!(OVRRID) D SCHK^BSTSVRXN(1552,1)
  1.  ;
  1.  ;BSTS*1.0*8;Process no longer works
  1.  ;Check to see if ICD9 to SMD process needs run - Only run once
  1.  ;I $$GET1^DIQ(9002318.1,NMIEN_",",".09","I")="" D QUEUE^BSTSVOFL("ICD")
  1.  ;
  1.  ;Schedule daily error purge
  1.  D QUEUE^BSTSVOFL("PRG")
  1.  ;
  1.  ;Schedule status logging
  1.  D QUEUE^BSTSVOFL("STS")
  1.  ;
  1.  ;Completed checks for day - mark parameter
  1.  S BSTS(9002318,SITE_",",.03)=DT
  1.  D FILE^DIE("","BSTS","ERROR")
  1.  ;
  1.  ;Schedule the process to run at 6:02
  1.  I '$$PSCHD("BSTSVOFL") S ZTSK=$$JOB^BSTSVOFL()
  1.  ;
  1.  ;Schedule job to run tomorrow if not already scheduled
  1.  I '$$PSCHD("BSTSVRSN") D
  1.  . S ZTRTN="CHECK^BSTSVRSN"
  1.  . S ZTDESC="BSTS - Schedule check to run"
  1.  . S ZTIO=""
  1.  . S ZTDTH=$$FMADD^XLFDT(DT_".1030",,24)
  1.  . D ^%ZTLOAD
  1.  ;
  1. XDAYCHK Q
  1.  ;
  1. PSCHD(RTN) ;Check if process already scheduled to run
  1.  ;
  1.  I $G(RTN)="" Q ""
  1.  ;
  1.  NEW TFND,ZT1,ZTS
  1.  ;
  1.  S TFND="",ZT1=$$H3^%ZTM($H) F  S ZT1=$O(^%ZTSCH(ZT1)) Q:'ZT1  D
  1.  . S ZTS=0 F  S ZTS=$O(^%ZTSCH(ZT1,ZTS)) Q:'ZTS  D
  1.  .. ;
  1.  .. NEW TASKND,SCHDT,RUNDT
  1.  .. ;
  1.  .. ;Get the task
  1.  .. S TASKND=$G(^%ZTSK(ZTS,0)) Q:TASKND=""
  1.  .. I $P(TASKND,U,2)'=RTN Q
  1.  .. S TFND=1
  1.  ;
  1.  Q TFND