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

ATXTXCHK.m

Go to the documentation of this file. 
  1. ATXTXCHK ; IHS/OHPRD/TMJ - CHECK CODE AGAINST TAXONOMY ; 
  1.  ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
  1.  ;
  1.  ; This routine checks to see if a specific code is in a specific
  1.  ; taxonomy.
  1.  ;
  1.  ; If the taxonomy entry says the taxonomy is a 'range' of codes, the
  1.  ; lookup is on the AA xref of the 2101 multiple.  Otherwise, the
  1.  ; lookup is on the B xref of the 2101 multiple.  See .16 RANGE field.
  1.  ;
  1.  ; There are many ways the AA xref can be messed up.  It is only set if
  1.  ; a range of codes is specified and it has a " " appended if
  1.  ; non-canonic is set.  It is not set if the high value of the range is
  1.  ; not entered.  If the taxonomy is created with range or non-canonic
  1.  ; set one way, then changed later you may have AA entries missing,
  1.  ; some canonic, and some non-canonic.
  1.  ;
  1.  ; There needs to be a routine that checks the validity of the entries
  1.  ; in the taxonomy file.
  1.  ;
  1.  ; ** I hope the taxonomy dictionary prevents overlapping ranges **
  1.  ; ** I checked.  It does not. It also doesn't prevent the high  **
  1.  ; ** code from being lower than the low code.                   **
  1.  ;
  1. TXC(ATXCIEN,ATXTIEN,TEST) ;EP-EXTRN FUNC/see if code is in taxonomy
  1.  ; input variables: ATXCIEN=code ien, ATXTIEN=taxonomy ien
  1.  ;                  TEST causes code and hits to be displayed
  1.  ; returns 1 if in taxonomy, otherwise returns 0
  1.  ;
  1.  NEW ATXBEG,ATXEND,ATXFILE,ATXGBL,ATXMIXED,ATXMODE,ATXQ,ATXQV,X,Y
  1.  S (ATXQ,ATXQV)=0
  1.  G:'$G(ATXCIEN) TXCX
  1.  G:'$G(ATXTIEN) TXCX
  1.  D GETCODE ;                                 get code
  1.  G:ATXQ TXCX ;                               can't find code
  1.  D CHKTAX ;                                  check taxonomy
  1.  ; if taxonomy single values instead of code ranges do test & exit
  1.  I 'ATXRANGE S:$D(^ATXAX(ATXTIEN,21,"B",ATXCODE)) ATXQV=1 D  G TXCX
  1.  . Q:'ATXQV  ;                               no hit
  1.  . W:$G(TEST) "  SINGLE VALUES HIT ",!
  1.  . Q
  1.  D SRCHTAX ;                                 search taxonomy for code
  1. TXCX ;
  1.  Q ATXQV
  1.  ;
  1. GETCODE ; GET CODE TO CHECK
  1.  S ATXQ=1
  1.  S ATXFILE=$P($G(^ATXAX(ATXTIEN,0)),U,15) ;  get reference file
  1.  Q:ATXFILE=""  ;                              quit if no file
  1.  S ATXGBL=$$ROOT^DILFD(ATXFILE) ;            get gbl root to file
  1.  Q:ATXGBL=""  ;                               corrupt data dictionary
  1.  S ATXGBL=ATXGBL_ATXCIEN_"," ;               set gbl to entry in file
  1.  S @("ATXCODE=$P($G("_ATXGBL_"0)),U)") ;     get code
  1.  Q:ATXCODE=""  ;                              quit if can't find code
  1.  W:$G(TEST) !,"CODE=""",ATXCODE,""""
  1.  S ATXQ=0
  1.  Q
  1.  ;
  1. CHKTAX ; CHECK TAXONOMY ENTRY
  1.  S ATXRANGE=$P(^ATXAX(ATXTIEN,0),U,16) ;     single value or range
  1.  Q:'ATXRANGE  ;                               quit if not range
  1.  ;
  1.  ; When we talk about xref being canonic or non-canonic we are talking
  1.  ; about the AA xref in the taxonomy 2101 multiple.  This has nothing
  1.  ; to do with the file from which the code was retrieved.  Treat as
  1.  ; non-canonic if the dictionary says it is, the xref really is, or
  1.  ; if the passed code is.
  1.  ;
  1.  S ATXNONC=$P(^ATXAX(ATXTIEN,0),U,13) ;      is xref non-canonic?
  1.  S:ATXCODE'=+ATXCODE ATXNONC=1 ;             code non-canonic, force it
  1.  I 'ATXNONC D  ;                             confirm canonic
  1.  . S X=$O(^ATXAX(ATXTIEN,21,"AA","~"),-1),X=$S(X'=+X:1,1:0)
  1.  . S:X ATXNONC=1 ;                           go with what really is
  1.  . Q
  1.  ; see if xref is both canonic and non-canonic (i.e., mixed).
  1.  S X=$O(^ATXAX(ATXTIEN,21,"AA","~"),-1),X=$S(X'=+X:1,1:0)
  1.  S Y=$O(^ATXAX(ATXTIEN,21,"AA","")),Y=$S(Y=+Y:1,1:0)
  1.  S ATXMIXED=((X+Y)-1) ;                      1=mixed mode xref
  1.  Q
  1.  ;
  1. SRCHTAX ; SEARCH TAXONOMY FOR CODE
  1.  I ATXMIXED D  Q  ;                          mixed mode xref
  1.  . D NONCANON
  1.  . Q:ATXQV
  1.  . D CANONIC
  1.  . Q
  1.  I ATXNONC D NONCANON Q  ;                   non-canonic xref
  1.  D CANONIC ;                                 canonic xref
  1.  Q
  1.  ;
  1. NONCANON ; NON CANONIC XREF OR CODE
  1.  S X=ATXCODE
  1.  S:$E(X,$L(X))'=" " X=X_" " ;                add " " force non-canonic
  1.  S ATXNXT=$O(^ATXAX(ATXTIEN,21,"AA",X),-1) ; right before code
  1.  I ATXNXT]"",ATXNXT'=+ATXNXT S ATXNXT=$O(^ATXAX(ATXTIEN,21,"AA",ATXNXT),-1) ;1 more back to insure $O from atxnxt will not move past atxcode
  1.  F  S ATXNXT=$O(^ATXAX(ATXTIEN,21,"AA",ATXNXT)) Q:ATXNXT=""  D EQUALIZE(1) Q:ATXBEG]ATXCMPC  D  Q:ATXQV
  1.  . S ATXEND=$O(^ATXAX(ATXTIEN,21,"AA",ATXNXT,""))
  1.  . S:ATXEND="" ATXEND=ATXBEG ;               must be single code
  1.  .;actually if no end code no "AA" xref is created (design flaw?)
  1.  . D EQUALIZE(2) ;                           equalize lengths
  1.  . Q:ATXCMPC]ATXEND  ;                       higher than end of range
  1.  . S ATXQV=1 ;                               found code in taxonomy
  1.  . W:$G(TEST) "  NON-CANONIC HIT: RANGE=""",$TR(ATXBEG," ","_"),"""-""",$TR(ATXEND," ","_"),"""",!
  1.  . Q
  1.  Q
  1.  ;
  1. EQUALIZE(F) ; EQUALIZE LENGTH AND FORCE LAST CHAR TO " "
  1.  NEW A,B,C,X,Y
  1.  S X=$S(F=1:ATXNXT,1:ATXEND)
  1.  S:$E(X,$L(X))="." X=$E(X,1,($L(X)-1)) ;     strip off trailing period
  1.  S X=X_$S($E(X,$L(X))'=" ":" ",1:"")
  1.  S Y=ATXCODE
  1.  S:$E(Y,$L(Y))="." Y=$E(Y,1,($L(Y)-1)) ;     strip off trailing period
  1.  S Y=Y_$S($E(Y,$L(Y))'=" ":" ",1:"")
  1.  S A=$L(X),B=$L(Y)
  1.  I A'=B D  ;                                 pad short var with blanks
  1.  . S $P(C," ",$S(A>B:A-B,1:B-A))=" "
  1.  . I A>B S Y=Y_C I 1
  1.  . E  S X=X_C
  1.  . Q
  1.  S @($S(F=1:"ATXBEG",1:"ATXEND")_"=X,ATXCMPC=Y")
  1.  Q
  1.  ;
  1. CANONIC ; CANONIC XREF AND CODE
  1.  Q:ATXCODE'=+ATXCODE  ;                      code is not canonic
  1.  S X=ATXCODE
  1.  S ATXNXT=$O(^ATXAX(ATXTIEN,21,"AA",X),-1) ; right before code
  1.  S:ATXNXT]"" ATXNXT=$O(^ATXAX(ATXTIEN,21,"AA",ATXNXT),-1) ;1 more back
  1.  F  S ATXNXT=$O(^ATXAX(ATXTIEN,21,"AA",ATXNXT)) Q:ATXNXT=""  Q:ATXNXT>ATXCODE  S ATXBEG=ATXNXT D  Q:ATXQV
  1.  . S ATXEND=$O(^ATXAX(ATXTIEN,21,"AA",ATXNXT,""))
  1.  . S:ATXEND="" ATXEND=ATXBEG ;               must be single code
  1.  .;actually if no end code no "AA" xref is created (design flaw?)
  1.  . Q:ATXCODE>ATXEND  ;                       higher than end of range
  1.  . S ATXQV=1 ;                               found code in taxonomy
  1.  . W:$G(TEST) "  CANONIC HIT: RANGE=""",ATXBEG,"""-""",ATXEND,"""",!
  1.  . Q
  1.  Q