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

BSTSVRSC.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  Q
  1.  ;
  1. CCHK(NMID,BKGND) ;EP - Check for custom codeset updates
  1.  ;
  1.  I $G(NMID)="" Q
  1.  I $G(NMID)=36 Q
  1.  I $G(NMID)=1552 Q
  1.  I $G(NMID)=5180 Q
  1.  I $G(NMID)=32777 Q
  1.  I $G(NMID)=32778 Q
  1.  ;
  1.  ;Only one SNOMED proc 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.  ;Check for ICD92SNOMED proc
  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.  NEW LMDT,STS,BSTS,ERROR,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,NMIEN,ZTQUEUED
  1.  NEW VAR,ZTIO,VRSN,TRY
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSVRSC D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Get codeset
  1.  S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) Q:NMIEN=""
  1.  ;
  1.  ;Check if online
  1.  S STS="" F TRY=1:1:5 D  I +STS=2 Q
  1.  . D RESET^BSTSWSV1  ;Reset the DTS link to on
  1.  . S STS=$$VERSIONS^BSTSAPI("VRSN") ;Try
  1.  ;
  1.  ;Queue proc
  1.  I +STS=2 D CDJOB^BSTSUTIL(NMIEN,"CCD")
  1.  ;
  1.  Q
  1.  ;
  1. CDST ;EP - Update IHS Standard Terminology Codeset
  1.  ;
  1.  ;Tasked by above.  Var NMIEN should be set
  1.  ;
  1.  S NMIEN=$G(NMIEN) I NMIEN="" Q
  1.  ;
  1.  ;Lock
  1.  L +^BSTS(9002318.1,0):0 E  Q
  1.  ;
  1.  NEW BSTSWS,RESULT,NMID,STS,VRSN,BSTS,ICONC,CIEN,X1,X2,X,NVIEN,NVLCL,MFAIL,FWAIT,TRY,FCNT,ABORT,TRY,CVRSN
  1.  ;
  1.  ;Get ext codeset Id
  1.  S NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I") I NMID="" G XCDST
  1.  ;
  1.  ;Update LAST VERSION CHECK so proc won't keep getting called
  1.  S BSTS(9002318.1,NMIEN_",",.05)=DT
  1.  D FILE^DIE("","BSTS","ERROR")
  1.  ;
  1.  ;Online?
  1.  S STS="" F TRY=1:1:5 D  I +STS=2 Q
  1.  . D RESET^BSTSWSV1  ;Reset the DTS link to on
  1.  . S STS=$$VERSIONS^BSTSAPI("VRSN") ;Try
  1.  I +STS'=2 G XCDST
  1.  ;
  1.  ;Reset Monitoring GBL
  1.  K ^XTMP("BSTSLCMP")
  1.  ;
  1.  ;Get later date
  1.  S X1=DT,X2=60 D C^%DTC
  1.  ;
  1.  ;Get current version
  1.  S CVRSN=$$GET1^DIQ(9002318.1,NMIEN_",",.04,"I")
  1.  ;
  1.  ;Make a log entry
  1.  D LOG^BSTSAPIL("UPDS",NMID,"CURRENT",CVRSN)
  1.  ;
  1.  ;Set Monitoring GBL
  1.  S ^XTMP("BSTSLCMP",0)=X_U_DT_U_"Cache refresh running for "_NMID
  1.  ;
  1.  ;Mark as OOD
  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=""  S CIEN="" F  S CIEN=$O(^BSTS(9002318.4,"C",NMID,ICONC,CIEN)) Q:CIEN=""  D
  1.  . NEW BSTS,ERR,LMOD
  1.  . ;
  1.  . ;Mark OOD
  1.  . S BSTS(9002318.4,CIEN_",",".12")=""
  1.  . D FILE^DIE("","BSTS","ERR")
  1.  ;
  1.  ;Make call to proc
  1.  S ^XTMP("BSTSLCMP","STS")="Performing Refresh from DTS"
  1.  S BSTSWS("NAMESPACEID")=NMID
  1.  S BSTSWS("REVIN")=$$FMTE^XLFDT(DT,"7")
  1.  S STS=$$CSTMCDST^BSTSWSV1("RESULT",.BSTSWS)
  1.  S ^BXE("M")="0^"_STS
  1.  I +STS=0 G XCDST  ;Quit if update failed
  1.  I $D(^XTMP("BSTSLCMP","QUIT")) G XCDST
  1.  ;
  1.  S ^BXE("M")="1"
  1.  ;Now refresh entries for codeset that have not been updated (to handle deletes)
  1.  S ICONC="" F  S ICONC=$O(^BSTS(9002318.4,"C",NMID,ICONC)) Q:ICONC=""  D  Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  . S CIEN="" F  S CIEN=$O(^BSTS(9002318.4,"C",NMID,ICONC,CIEN)) Q:CIEN=""  D  Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  .. NEW BSTS,ERR,TIEN,DA,DIK
  1.  .. ;
  1.  .. ;Quit if updated
  1.  .. I $$GET1^DIQ(9002318.4,CIEN_",",".12","I")]"" Q
  1.  .. ;
  1.  .. ;Update monitor
  1.  .. S ^XTMP("BSTSLCMP","STS")="Removing retired mapping "_CIEN
  1.  .. ;
  1.  .. ;First remove terms
  1.  .. S TIEN="" F  S TIEN=$O(^BSTS(9002318.3,"C",NMID,CIEN,TIEN)) Q:TIEN=""  D
  1.  ... NEW DA,DIK
  1.  ... S DA=TIEN,DIK="^BSTS(9002318.3," D ^DIK
  1.  .. ;
  1.  .. ;Remove concept
  1.  .. S DA=CIEN,DIK="^BSTS(9002318.4," D ^DIK
  1.  ;
  1.  ;Retrieve Failover Vars
  1.  S MFAIL=$$FPARMS^BSTSVOFL()
  1.  S FWAIT=$P(MFAIL,U,2)
  1.  S MFAIL=$P(MFAIL,U)
  1.  ;
  1.  S ^BXE("M")=2
  1.  ;Loop through, grab concept that mappings linked to
  1.  S ABORT=0,ICONC="" F  S ICONC=$O(^BSTS(9002318.4,"C",NMID,ICONC)) Q:ICONC=""  D  Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  . NEW IEN
  1.  . S IEN="" F  S IEN=$O(^BSTS(9002318.4,"C",NMID,ICONC,IEN)) Q:IEN=""  D  Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  .. NEW AS
  1.  .. S AS=0 F  S AS=$O(^BSTS(9002318.4,IEN,9,AS)) Q:'AS  D
  1.  ... NEW NODE,NM,DTS,VAR,FCNT,TRY
  1.  ... S NODE=$G(^BSTS(9002318.4,IEN,9,AS,0))
  1.  ... S ^XTMP("BSTSLCMP","STS")="Getting Association details for entry: "_ICONC
  1.  ... S NM=$P(NODE,U,2) Q:NM=""
  1.  ... S DTS=$P(NODE,U,3) Q:DTS=""
  1.  ... ;
  1.  ... ;Update entry-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  ;Reset the DTS link to on
  1.  .... S STS=$$DTSLKP^BSTSAPI("VAR",DTS_"^"_NM) 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,"CDST^BSTSVRSC - Getting Assoc for entry: "_DTS)
  1.  ..... I ABORT=1 S ^XTMP("BSTSLCMP","QUIT")=1 D ELOG^BSTSVOFL("CUSTOM CODESET REFRESH FAILED ON DETAIL ENTRY: "_DTS)
  1.  ..... S FCNT=0
  1.  ;
  1.  S ^BXE("M")="3^"_STS
  1.  ;Check for failure
  1.  I +STS=0 G XCDST
  1.  I $D(^XTMP("BSTSLCMP","QUIT")) G XCDST
  1.  ;
  1.  ;Get current version from mult
  1.  S NVIEN=$O(^BSTS(9002318.1,NMIEN,1,"A"),-1)
  1.  S NVLCL="" I +NVIEN>0 D
  1.  . NEW DA,IENS
  1.  . S DA(1)=NMIEN,DA=+NVIEN,IENS=$$IENS^DILF(.DA)
  1.  . S NVLCL=$$GET1^DIQ(9002318.11,IENS,".01","I")
  1.  ;
  1.  S ^BXE("M")="4^"_NVLCL
  1.  ;Save CURRENT VERSION
  1.  I NVLCL]"" D
  1.  . NEW BSTS,ERROR
  1.  . S BSTS(9002318.1,NMIEN_",",.04)=NVLCL
  1.  . D FILE^DIE("","BSTS","ERROR")
  1.  ;
  1.  ;Get new current version
  1.  S CVRSN=$$GET1^DIQ(9002318.1,NMIEN_",",.04,"I")
  1.  ;
  1.  ;Make a log entry
  1.  D LOG^BSTSAPIL("UPDE",NMID,"CURRENT",CVRSN)
  1.  ;
  1.  ;Reset Monitoring GBL
  1. XCDST 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
  1.  L -^BSTS(9002318.1,0)
  1.  ;
  1.  Q
  1.  ;
  1. ACHK(NMID,BKGND) ;EP - Check for '36' auto-codable ICD-10s
  1.  ;
  1.  ;Only one SNOMED proc 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 ICD92SNOMED 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.  ;Validate input
  1.  I $G(NMID)="" Q
  1.  I $G(NMID)'=32777 Q
  1.  ;
  1.  NEW LMDT,STS,BSTS,ERROR,NMIEN
  1.  NEW VAR,SITE,VRSN,TRY
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSVRSC D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Get codeset
  1.  S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) Q:NMIEN=""
  1.  ;
  1.  ;Online?
  1.  S STS="" F TRY=1:1:5 D  I +STS=2 Q
  1.  . D RESET^BSTSWSV1  ;Reset the DTS link to on
  1.  . S STS=$$VERSIONS^BSTSAPI("VRSN") ;Try
  1.  ;
  1.  ;Queue process
  1.  I +STS=2 D CDJOB^BSTSUTIL(NMIEN,"I10")
  1.  ;
  1.  Q
  1.  ;
  1. ACODE ;EP - Update SNOMED '36' auto-codable ICD-10 mappings
  1.  ;
  1.  ;Tasked above.  Variable NMIEN should be set
  1.  ;
  1.  S NMIEN=$G(NMIEN) I NMIEN="" Q
  1.  ;
  1.  ;Lock
  1.  L +^BSTS(9002318.1,0):0 E  Q
  1.  ;
  1.  NEW BSTSWS,RESULT,NMID,STS,VRSN,BSTS,ICONC,CIEN,X1,X2,X,RUNDT,DEBUG,NVIEN,NVLCL,FWAIT,TRY,FCNT,ABORT,TRY,CVRSN
  1.  NEW CDST
  1.  ;
  1.  ;Get run date
  1.  S RUNDT=DT
  1.  ;
  1.  ;Get external codeset Id
  1.  S NMID=$$GET1^DIQ(9002318.1,NMIEN_",",.01,"I") I NMID="" G XACODE
  1.  ;
  1.  ;Update LAST VERSION CHECK now so proc won't keep getting called
  1.  S BSTS(9002318.1,NMIEN_",",.05)=DT
  1.  D FILE^DIE("","BSTS","ERROR")
  1.  ;
  1.  ;Online?
  1.  S STS="" F TRY=1:1:5 D  I +STS=2 Q
  1.  . D RESET^BSTSWSV1  ;Reset the DTS link to on
  1.  . S STS=$$VERSIONS^BSTSAPI("VRSN") ;Try
  1.  I +STS'=2 G XACODE
  1.  ;
  1.  ;Reset Monitoring GBL
  1.  K ^XTMP("BSTSLCMP")
  1.  ;
  1.  ;Get later date
  1.  S X1=DT,X2=60 D C^%DTC
  1.  ;
  1.  ;Log updates
  1.  F CDST=32777,32779,32780 D
  1.  . NEW CVRSN,NM
  1.  . ;
  1.  . S NM=$O(^BSTS(9002318.1,"B",CDST,"")) Q:NM=""
  1.  . ;
  1.  . ;Get current version
  1.  . S CVRSN=$$GET1^DIQ(9002318.1,NM_",",.04,"I")
  1.  . ;
  1.  . ;Make a log entry
  1.  . D LOG^BSTSAPIL("UPDS",CDST,"CURRENT",CVRSN)
  1.  ;
  1.  ;Make a log entry
  1.  D LOG^BSTSAPIL("UPDS",36,"SUBSET","")
  1.  ;
  1.  ;Set up Monitoring GBL
  1.  S ^XTMP("BSTSLCMP",0)=X_U_DT_U_"SNOMED '36' auto-codable ICD-10 mapping running"
  1.  ;
  1.  ;BSTS*1.0*4;Mark codeset as OOD
  1.  D CLLMDT^BSTSVOF1(36)
  1.  ;
  1.  ;Make call to proc custom codeset
  1.  S ^XTMP("BSTSLCMP","STS")="Performing Refresh from DTS"
  1.  S DEBUG=""
  1.  S BSTSWS("REVIN")=$$FMTE^XLFDT(DT,"7")
  1.  S STS=$$ACODE^BSTSWSV1("RESULT",.BSTSWS,DEBUG)
  1.  ;
  1.  ;Failure check
  1.  I +STS=0 G XACODE
  1.  I $D(^XTMP("BSTSLCMP","QUIT")) G XACODE
  1.  ;
  1.  ;Retrieve Failover Vars
  1.  S MFAIL=$$FPARMS^BSTSVOFL()
  1.  S FWAIT=$P(MFAIL,U,2)
  1.  S MFAIL=$P(MFAIL,U)
  1.  ;
  1.  ;Loop through again and proc skipped entries (no longer mapped)
  1.  S ^XTMP("BSTSLCMP","STS")="Looking for skipped entries (no longer mapped)"
  1.  S ABORT=0,ICONC="" F  S ICONC=$O(^BSTS(9002318.4,"C",36,ICONC)) Q:ICONC=""  D  Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  . S CIEN="" F  S CIEN=$O(^BSTS(9002318.4,"C",36,ICONC,CIEN)) Q:CIEN=""  D  Q:$D(^XTMP("BSTSLCMP","QUIT"))
  1.  .. NEW DTSID,VAR
  1.  .. ;
  1.  .. ;Skip partials
  1.  .. I $$GET1^DIQ(9002318.4,CIEN_",",.03,"I")="P" Q
  1.  .. ;
  1.  .. ;Quit if entry updated
  1.  .. I $$GET1^DIQ(9002318.4,CIEN_",",".12","I")'<RUNDT Q
  1.  .. ;
  1.  .. ;Only update if ICD info on file
  1.  .. I $O(^BSTS(9002318.4,CIEN,3,"B",""))="" Q
  1.  .. ;
  1.  .. ;Update monitor
  1.  .. S ^XTMP("BSTSLCMP","STS")="Updating skipped entry "_CIEN
  1.  .. ;
  1.  .. ;Get DTSID
  1.  .. S DTSID=$$GET1^DIQ(9002318.4,CIEN_",",.08,"I") Q:DTSID=""
  1.  .. ;
  1.  .. ;Refresh entry - 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  ;Reset the DTS link to on
  1.  ... S STS=$$DTSLKP^BSTSAPI("VAR",DTSID_"^36") 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,"ACODE^BSTSVRSC - Getting update for entry: "_DTSID)
  1.  .... I ABORT=1 S ^XTMP("BSTSLCMP","QUIT")=1 D ELOG^BSTSVOFL("ICD10 MAPPING REFRESH FAILED ON DETAIL ENTRY: "_DTSID)
  1.  .... S FCNT=0
  1.  ;
  1.  ;Failure check
  1.  I +STS=0 G XACODE
  1.  I $D(^XTMP("BSTSLCMP","QUIT")) G XACODE
  1.  ;
  1.  ;BSTS*1.0*6;Update both 32777 and 32779
  1.  ;BSTS*1.0*7;Update 32780 and LAST SUBSET RUN
  1.  D
  1.  . NEW BSTS,ERROR,NMID36
  1.  . S NMID36=$O(^BSTS(9002318.1,"B",36,"")) Q:NMID36=""
  1.  . S BSTS(9002318.1,NMID36_",",.1)=DT
  1.  . D FILE^DIE("","BSTS","ERROR")
  1.  ;
  1.  F NMID=32777,32779,32780 D
  1.  . ;
  1.  . S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) Q:NMIEN=""
  1.  . ;
  1.  . ;Update current version
  1.  . ;
  1.  . ;Get current version from codeset multiple
  1.  . S NVIEN=$O(^BSTS(9002318.1,NMIEN,1,"A"),-1)
  1.  . S NVLCL="" I +NVIEN>0 D
  1.  .. NEW DA,IENS
  1.  .. S DA(1)=NMIEN,DA=+NVIEN,IENS=$$IENS^DILF(.DA)
  1.  .. S NVLCL=$$GET1^DIQ(9002318.11,IENS,".01","I")
  1.  . ;
  1.  . ;Now save CURRENT VERSION
  1.  . I NVLCL]"" D
  1.  .. NEW BSTS,ERROR
  1.  .. S BSTS(9002318.1,NMIEN_",",.04)=NVLCL
  1.  .. D FILE^DIE("","BSTS","ERROR")
  1.  ;
  1.  ;BSTS*2.0*1;Move call to BSTSVOF1
  1.  D UIFS^BSTSVOF1(.ZTQUEUED)
  1.  ;
  1.  ;Proc VUID and NDC
  1.  S STS=$$NVLKP^BSTSVOFL(MFAIL,FWAIT)
  1.  ;
  1.  ;Log updates
  1.  F CDST=32777,32779,32780 D
  1.  . NEW CVRSN,NM
  1.  . ;
  1.  . S NM=$O(^BSTS(9002318.1,"B",CDST,"")) Q:NM=""
  1.  . ;
  1.  . ;Get current version
  1.  . S CVRSN=$$GET1^DIQ(9002318.1,NM_",",.04,"I")
  1.  . ;
  1.  . ;Make a log entry
  1.  . D LOG^BSTSAPIL("UPDE",CDST,"CURRENT",CVRSN)
  1.  ;
  1.  ;Make a log entry
  1.  D LOG^BSTSAPIL("UPDE",36,"SUBSET","")
  1.  ;
  1.  ;Reset Monitoring GBL
  1. XACODE 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
  1.  L -^BSTS(9002318.1,0)
  1.  ;
  1.  Q
  1.  ;
  1. A9CHK(NMID,BKGND) ;EP - Check for '36' auto-codable ICD-9s
  1.  ;
  1.  ;ICD9 updates no longer supported
  1.  Q
  1.  ;
  1. A9CODE ;EP - Update SNOMED '36' auto-codable ICD-9 mappings
  1.  ;
  1.  ;ICD9 updates no longer supported
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  Q