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

PXRMTECK.m

Go to the documentation of this file. 
  1. PXRMTECK ; SLC/PKR - Check expanded taxonomies. ;02/25/2009
  1.  ;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
  1.  ;
  1.  ;====================================================
  1. ALL ;Check all expansions.
  1.  N IEN,IO,NAME,POP,TEXT
  1.  W !,"Verify all taxonomy expansions."
  1.  D ^%ZIS
  1.  I POP Q
  1.  U IO
  1.  W !,"Checking all taxonomy expansions."
  1.  S NAME=""
  1.  F  S NAME=$O(^PXD(811.2,"B",NAME)) Q:NAME=""  D
  1.  . S IEN=$O(^PXD(811.2,"B",NAME,""))
  1.  . D CHECK(IEN)
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1.  ;====================================================
  1. CHECK(IEN) ;Check an expansion.
  1.  ;Save existing expansion.
  1.  N CODE,EXPOK,HIGH,IND,LOW,NAME,TEMP,TYPE
  1.  S NAME=$P(^PXD(811.2,IEN,0),U,1)
  1.  W !!,"Taxonomy: ",NAME," (IEN=",IEN,")"
  1.  I '$D(^PXD(811.3,IEN)) W !,"Expansion does not exist." Q
  1.  K ^TMP($J,"CUREXP"),^TMP($J,"NEWEXP")
  1.  I $D(^PXD(811.3,IEN,80,"ICD9P")) M ^TMP($J,"CUREXP","ICD 9")=^PXD(811.3,IEN,80,"ICD9P")
  1.  I $D(^PXD(811.3,IEN,80.1,"ICD0P")) M ^TMP($J,"CUREXP","ICD 0")=^PXD(811.3,IEN,80.1,"ICD0P")
  1.  I $D(^PXD(811.3,IEN,81,"ICPTP")) M ^TMP($J,"CUREXP","CPT")=^PXD(811.3,IEN,81,"ICPTP")
  1.  ;Rexpand
  1.  S IND=0
  1.  F  S IND=+$O(^PXD(811.2,IEN,80.1,IND)) Q:IND=0  D
  1.  . S TEMP=^PXD(811.2,IEN,80.1,IND,0)
  1.  . S LOW=$P(TEMP,U,1)
  1.  . S HIGH=$P(TEMP,U,2)
  1.  . I HIGH="" S HIGH=LOW
  1.  . D ICD0(IEN,LOW,HIGH,"NEWEXP")
  1.  ;
  1.  S IND=0
  1.  F  S IND=+$O(^PXD(811.2,IEN,80,IND)) Q:IND=0  D
  1.  . S TEMP=^PXD(811.2,IEN,80,IND,0)
  1.  . S LOW=$P(TEMP,U,1)
  1.  . S HIGH=$P(TEMP,U,2)
  1.  . I HIGH="" S HIGH=LOW
  1.  . D ICD9(IEN,LOW,HIGH,"NEWEXP")
  1.  ;
  1.  S IND=0
  1.  F  S IND=+$O(^PXD(811.2,IEN,81,IND)) Q:IND=0  D
  1.  . S TEMP=^PXD(811.2,IEN,81,IND,0)
  1.  . S LOW=$P(TEMP,U,1)
  1.  . S HIGH=$P(TEMP,U,2)
  1.  . I HIGH="" S HIGH=LOW
  1.  . D ICPT(IEN,LOW,HIGH,"NEWEXP")
  1.  ;Do the comparsions.
  1.  S EXPOK=1
  1.  W !,"Expansion was last built on ",$$FMTE^XLFDT($P(^PXD(811.3,IEN,0),U,2),"5Z")
  1.  F TYPE="ICD 9","ICD 0","CPT" D
  1.  . S CODE=""
  1.  . F  S CODE=$O(^TMP($J,"NEWEXP",TYPE,CODE)) Q:CODE=""  D
  1.  .. I $D(^TMP($J,"CUREXP",TYPE,CODE)) K ^TMP($J,"CUREXP",TYPE,CODE),^TMP($J,"NEWEXP",TYPE,CODE)
  1.  I $D(^TMP($J,"NEWEXP")) D
  1.  . S EXPOK=0
  1.  . W !!,"The following codes are missing from the expansion:"
  1.  . D OUTPUT("NEWEXP")
  1.  I $D(^TMP($J,"CUREXP")) D
  1.  . S EXPOK=0
  1.  . W !!,"The following codes are in the expansion and they should not be:"
  1.  . D OUTPUT("CUREXP")
  1.  I EXPOK W !,"The expansion is correct."
  1.  K ^TMP($J,"CUREXP"),^TMP($J,"NEWEXP")
  1.  Q
  1.  ;
  1.  ;====================================================
  1. ICD0(TAXIEN,LOW,HIGH,SUB) ;Build the list of internal entries for ICD0
  1.  ;(File 80.1). Use of ICDAPIU: DBIA #3991
  1.  N CODE,IEN,TEMP
  1.  S CODE=LOW
  1.  F  Q:(CODE]HIGH)!(CODE="")  D
  1.  . S TEMP=$$STATCHK^ICDAPIU(CODE,"")
  1.  . S IEN=$P(TEMP,U,2)
  1.  . I IEN'=-1,'$D(^TMP($J,SUB,"ICD 0",IEN)) D
  1.  .. S ^TMP($J,SUB,"ICD 0",IEN)=""
  1.  . S CODE=$$NEXT^ICDAPIU(CODE)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. ICD9(TAXIEN,LOW,HIGH,SUB) ;Build the list of internal entries for ICD9
  1.  ;(File 80). Use of ICDAPIU: DBIA #3991
  1.  N CODE,IEN,TEMP
  1.  S CODE=LOW
  1.  F  Q:(CODE]HIGH)!(CODE="")  D
  1.  . S TEMP=$$STATCHK^ICDAPIU(CODE,"")
  1.  . S IEN=$P(TEMP,U,2)
  1.  . I IEN'=-1,'$D(^TMP(SUB,"ICD 9",IEN)) D
  1.  .. S ^TMP($J,SUB,"ICD 9",IEN)=""
  1.  . S CODE=$$NEXT^ICDAPIU(CODE)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. ICPT(TAXIEN,LOW,HIGH,SUB) ;Build the list of internal entries
  1.  ;for ICPT (File 81). Use of ICDAPIU: DBIA #3991
  1.  N CODE,IEN,RADIEN,TEMP
  1.  S CODE=LOW
  1.  F  Q:(CODE]HIGH)!(CODE="")  D
  1.  . S TEMP=$$STATCHK^ICPTAPIU(CODE,"")
  1.  . S IEN=$P(TEMP,U,2)
  1.  . I IEN'=-1,'$D(^TMP($J,SUB,"CPT",IEN)) D
  1.  .. S ^TMP($J,SUB,"CPT",IEN)=""
  1.  . S CODE=$$NEXT^ICPTAPIU(CODE)
  1.  Q
  1.  ;
  1.  ;====================================================
  1. OUTPUT(SUB) ;Output codes that are left.
  1.  ;References to ICDCODE DBIA #3990.
  1.  ;References to ICPTCOD DBIA #1995.
  1.  N IEN,LIST,NUM,TEMP,TYPE
  1.  K LIST
  1.  S TYPE=""
  1.  F  S TYPE=$O(^TMP($J,SUB,TYPE)) Q:TYPE=""  D
  1.  . W !," ",TYPE," codes:"
  1.  . S IEN=0
  1.  . F  S IEN=$O(^TMP($J,SUB,TYPE,IEN)) Q:IEN=""  D
  1.  .. I TYPE="CPT" D
  1.  ... S CODE=$$CPT^ICPTCOD(IEN,DT)
  1.  ... S TEMP=$P(CODE,U,3)
  1.  .. I TYPE="ICD 0" D
  1.  ... S CODE=$$ICDOP^ICDCODE(IEN,DT)
  1.  ... S TEMP=$P(CODE,U,5)
  1.  .. I TYPE="ICD 9" D
  1.  ... S CODE=$$ICDDX^ICDCODE(IEN,DT)
  1.  ... S TEMP=$P(CODE,U,4)
  1.  .. S TEMP=$E(TEMP,1,30)
  1.  .. S LIST($P(CODE,U,2)_" ")=$$LJ^XLFSTR(TEMP,30)_" (IEN="_IEN_")"
  1.  . S CODE="",NUM=0
  1.  . F  S CODE=$O(LIST(CODE)) Q:CODE=""  D
  1.  .. S NUM=NUM+1
  1.  .. W !,$$RJ^XLFSTR(NUM,4)," ",$$LJ^XLFSTR(CODE,9),LIST(CODE)
  1.  Q
  1.  ;