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

LRSCTX.m

Go to the documentation of this file. 
  1. LRSCTX ;DALOI/FHS/JDB - FIND TERM OR ADD TO FILE ;04/10/12  15:41
  1.  ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. EN(LRFILE,LRTXT,LRSCT,LRHL7,LRERROR,CHECK) ;
  1.  ; Main entry point for LRSCTX.
  1.  ; Returns a matching entry for LRTXT in LRFILE or creates a new entry in LRFILE for LRTXT.
  1.  ; Called by OBX^LA7VIN7
  1.  ;
  1.  ; Inputs
  1.  ;   LRFILE: File # to search (61, 61.2, 62)
  1.  ;    LRTXT: Text to find
  1.  ;    LRSCT: <opt> SNOMED CT code
  1.  ;    LRHL7: <byref><opt> HL7 info array
  1.  ;           ("R4")=File #4 IEN
  1.  ;           ("R6247")=File #62.47 IEN
  1.  ;           ("FSEC")=HL7 Field separator and Encoding characters
  1.  ;           ("MSH",3)=Sending Application
  1.  ;           ("MSH",4)=Sending Facility
  1.  ;           ("MSH",5)=Receiving Application
  1.  ;           ("MSH",6)=Receiving Facility
  1.  ;           ("MSH",11)=Message ID
  1.  ;           ("OBX",3)=OBX-3 (raw)
  1.  ;           ("OBX",5)=OBX-5 (raw)
  1.  ;  LRERROR:<byref>  See Outputs
  1.  ;    CHECK:<opt> 1=Check for match, dont add
  1.  ;
  1.  ; Outputs  (record # plus info)
  1.  ;    problem: 0^error msg  -OR-  IEN or "IEN^1" (^1=new entry flag)
  1.  ;  LRERROR array contains any error message associated.
  1.  ;
  1.  N DATA,DIERR,I,LR6247,LRDATA,LRFIEN,LRFSEC,LRLEXSCT,LRMSG,LRX,SCTP,NTEXT,X,Y
  1.  N NODE,DIERR
  1.  S LRFILE=$G(LRFILE)
  1.  S LRTXT=$G(LRTXT)
  1.  S LRSCT=$G(LRSCT)
  1.  S CHECK=$G(CHECK)
  1.  S LRFSEC=$G(LRHL7("FSEC"))
  1.  S LR6247=$G(LRHL7("R6247"))
  1.  I LRFILE'?1(1"61",1"61.2",1"62") Q "0^Unknown file #"_LRFILE
  1.  ;
  1.  S LRFIEN=0 ;IEN of matching/new file's entry
  1.  ;
  1.  ; If SCT code, use LEX data if valid SCT code
  1.  I LRSCT'="" S LRFIEN=$$CHKSCT(LRFILE,LRSCT,.LRHL7,1)
  1.  ;
  1.  I LRFIEN Q LRFIEN
  1.  I $TR(LRTXT," ","")="" Q "0^Text is empty"
  1.  ;
  1.  ; Didnt find a valid SCT code/text match so keep searching
  1.  ; Search for the text passed in
  1.  K NTEXT
  1.  S LRFIEN=$$FIND(LRTXT,LRFILE,.NTEXT)
  1.  I LRFIEN Q LRFIEN
  1.  ;
  1.  ; Check SCT database for a text match
  1.  S LRX=$$TXT4CS^LRSCT($$TRIM^XLFSTR(LRTXT),"SCT",.DATA)
  1.  ; Use SCT code from synonym only if just one SCT matches
  1.  I LRX="1" D
  1.  . N SCT
  1.  . S SCT=$O(DATA(0))
  1.  . Q:SCT=""
  1.  . S X=$$CODE^LRSCT(SCT,"SCT")
  1.  . Q:X'>0  ;valid SCT?
  1.  . ; find IEN of associated SCT code in target file
  1.  . S LRFIEN=$$SCT2IEN^LA7VHLU6(SCT,LRTXT,"",LRFILE,"","")
  1.  . Q:LRFIEN
  1.  . ; do a file search for this SCT
  1.  . S LRFIEN=$$CHKSCT(LRFILE,SCT,.LRHL7,1)
  1.  . Q:LRFIEN
  1.  . ; file error
  1.  . I 'LRFIEN S X=$P(LRFIEN,"^",2) I X'="" S LRFIEN="O^"_X Q
  1.  . K NTEXT
  1.  . ; Search for the text passed in (trimmed)
  1.  . S LRFIEN=$$FIND($$TRIM^XLFSTR(LRTXT),LRFILE,.NTEXT)
  1.  ;
  1.  ; No matches so need to add new entry
  1.  I 'LRFIEN,'CHECK D
  1.  . N LRIN
  1.  . K LRERROR
  1.  . S LRIN(.01)=$$TRIM^XLFSTR(LRTXT)
  1.  . ; new term so set as "refer to ETS"
  1.  . S LRIN(21)="REFERRED"
  1.  . S LRFIEN=$$FILE^LRSCTX1(LRFILE,.LRIN,.LRERROR,.LRHL7)
  1.  . I LRFIEN S LRFIEN=LRFIEN_"^1" ;new entry created
  1.  . I 'LRFIEN S X=$P($G(LRERROR),"^",2) I X'="" S LRFIEN="0^"_X
  1.  ;
  1.  Q LRFIEN
  1.  ;
  1.  ;
  1. CHKSCT(LRFILE,LRSCT,HLINFO,ADD,INACTIVE) ;
  1.  ; Private helper method
  1.  ; Checks for an SCT match.  If no existing LRFILE entry is found using the LEX data, a new entry in LRFILE will be created automatically.
  1.  ; Inputs
  1.  ;    LRFILE: File number to search/add entry to (61, 61.2, 62)
  1.  ;     LRSCT: SCT Code to use for search
  1.  ;    HLINFO:<byref> (from EN^LRSCTX)
  1.  ;       ADD:<opt> dflt=0  0=dont add new entry  1=add new entry
  1.  ;  INACTIVE: <opt>0 or 1 <dflt=0>  1=use SCT even if inactive
  1.  ; Outputs
  1.  ;  The IEN of the entry found or created.
  1.  ;  If a file error occurred, output=0 and the second "^" piece  contains error info.  ie  "0^Unknown file #"
  1.  ;
  1.  N DATA,I,LRERROR,LRFIEN,LRLEXSCT,LRIN,NODE,NTEXT,SCTP,X,Y
  1.  S LRFILE=$G(LRFILE),LRSCT=$G(LRSCT),INACTIVE=$G(INACTIVE,0),ADD=$G(ADD,0)
  1.  S LRFIEN=0
  1.  ;
  1.  ; SCT code in target file?
  1.  I LRFILE,LRSCT'="" S LRFIEN=$$SCT2IEN^LA7VHLU6(LRSCT,"","",LRFILE,"","")
  1.  ;
  1.  ; Get SCT info from LEX
  1.  I 'LRFIEN D
  1.  . N DATA,LR6247,SCTHIER
  1.  . S LRLEXSCT=$$CODE^LRSCT(LRSCT,"SCT","","DATA")
  1.  . Q:LRLEXSCT=-1
  1.  . I 'INACTIVE Q:LRLEXSCT'>0  ; dont use if invalid SCT code
  1.  . I INACTIVE I LRLEXSCT'>0!(LRLEXSCT'=-2) Q
  1.  . S SCTHIER=$P($G(DATA(0)),"^",2)
  1.  . ; check for targ file matches on SCT main, preferred, & synonyms
  1.  . S X=$G(DATA("F"))
  1.  . I X'="" S LRFIEN=$$FIND(X,LRFILE,.NTEXT)
  1.  . Q:LRFIEN
  1.  . S (X,SCTP)=$G(DATA("P"))
  1.  . S:SCTP="" SCTP=DATA("F")
  1.  . I X'="" S LRFIEN=$$FIND(X,LRFILE,.NTEXT)
  1.  . Q:LRFIEN
  1.  . ; re-sort "S"YNonym array from longest $L to shortest this results in using abbreviations as last resort
  1.  . K Y
  1.  . S I=0
  1.  . F  S I=$O(DATA("S",I)) Q:'I  D  ;
  1.  . . S X=DATA("S",I)
  1.  . . S Y(65536-$L(X),I)=X
  1.  . I $D(Y) K DATA("S") M DATA("S")=Y K Y
  1.  . ;
  1.  . S NODE="DATA(""S"")"
  1.  . F  S NODE=$Q(@NODE) Q:NODE=""  Q:$QS(NODE,1)'="S"  D  Q:LRFIEN  ;
  1.  . . S X=@NODE
  1.  . . I X'="" S LRFIEN=$$FIND(X,LRFILE,.NTEXT)
  1.  . ;
  1.  . Q:LRFIEN
  1.  . I 'ADD S LRFIEN="0^Function CHKSCT auto-add disabled" Q
  1.  . ;
  1.  . ; add new entry into target file using LEX info and stop
  1.  . K LRIN
  1.  . S LRIN(.01)=$$DELHIER^LRSCT(SCTP) ; SCT Preferred term
  1.  . I LRLEXSCT D  ; only set SCT info if valid SCT code
  1.  . . S LRIN(20)=LRSCT
  1.  . . S LRIN(21)="PREFERRED TERM"
  1.  . . S X=SCTHIER
  1.  . . I X'="" S X="SCT "_X
  1.  . . I $D(^LAB(64.061,"C",$$UP^XLFSTR(X))) D  ;
  1.  . . . S LRIN(22)=X
  1.  . . ;
  1.  . ;
  1.  . S LR6247=$G(HLINFO("R6247"))
  1.  . S LRFIEN=$$FILE^LRSCTX1(LRFILE,.LRIN,.LRERROR,.HLINFO)
  1.  . I LRFIEN S LRFIEN=LRFIEN_"^1" ; indicates new entry
  1.  . I 'LRFIEN S LRFIEN="0^"_$P($G(LRERROR),"^",2)
  1.  ;
  1.  Q LRFIEN
  1.  ;
  1.  ;
  1. FIND(LRTXT,LRFILE,NTEXT) ;
  1.  ; Private helper method
  1.  ; Tries to find a matching text entry in the file specified.
  1.  ; Inputs
  1.  ;   LRTXT: Text of term
  1.  ;  LRFILE: File # to use
  1.  ;   NTEXT:<byref> See Outputs
  1.  ; Outputs
  1.  ;   0 if no match, else the IEN of the matching record.
  1.  ;   NTEXT: New text to use for .01 field
  1.  ;
  1.  ; Converts  ^  to  ~
  1.  ; Looks for exact match in LRFILE on B & C xrefs.
  1.  ; $$TRIMs LRTXT then looks for any match in xref B & xref C
  1.  ; Passes an array of possible matches to $$FIND
  1.  ; Strips off any SCT hierarchy text and tries again
  1.  ; If no match returns 0
  1.  ;
  1.  N LRNIEN,DIERR,LRDATA,LRMSG,TXT2,X
  1.  S LRTXT=$G(LRTXT)
  1.  S LRFILE=$G(LRFILE)
  1.  S LRNIEN=0
  1.  S LRTXT=$TR(LRTXT,"^","~") ;also in FILE method
  1.  ;exact text match?
  1.  S LRNIEN=$$FIND1^DIC(LRFILE,,"OX",LRTXT,"B^C",,"LRMSG")
  1.  I LRNIEN Q LRNIEN
  1.  ;
  1.  ; check B index first
  1.  K LRDATA,LRMSG,DIERR
  1.  D FIND^DIC(LRFILE,,"@;.01;20","M",$$TRIM^XLFSTR(LRTXT),,"B",,,"LRDATA","LRMSG")
  1.  S LRNIEN=$$MATCH(LRTXT,.LRDATA)
  1.  ;
  1.  ; check C index (synonym)
  1.  I 'LRNIEN D  ;
  1.  . K LRDATA,LRMSG,DIERR
  1.  . D FIND^DIC(LRFILE,,"@;.01;20","M",$$TRIM^XLFSTR(LRTXT),,"C",,,"LRDATA","LRMSG")
  1.  . Q:'$D(LRDATA("DILIST",2))
  1.  . S LRNIEN=$$MATCH(LRTXT,.LRDATA)
  1.  ;
  1.  ; strip SCT top level name off and try again ie: this is text (body structure)
  1.  S X=$$TRIM^XLFSTR(LRTXT)
  1.  ; last char = ) and also contains a (
  1.  I 'LRNIEN I $E(X,$L(X),$L(X))=")" I X["(" D  ;
  1.  . S TXT2=$$DELHIER^LRSCT(X)
  1.  . Q:X=TXT2
  1.  . K LRDATA,LRMSG,DIERR
  1.  . D FIND^DIC(LRFILE,,"@;.01;20","M",TXT2,,"B",,,"LRDATA","LRMSG")
  1.  . S LRNIEN=$$MATCH(TXT2,.LRDATA)
  1.  . I LRNIEN D  Q  ;
  1.  . . S NTEXT=TXT2
  1.  . ;
  1.  . Q:LRNIEN
  1.  . ; check C index (synonym)
  1.  . K LRDATA,LRMSG,DIERR
  1.  . D FIND^DIC(LRFILE,,"@;.01;20","M",TXT2,,"C",,,"LRDATA","LRMSG")
  1.  . I $D(LRDATA("DILIST",2)) D  ;
  1.  . . S LRNIEN=$$MATCH(TXT2,.LRDATA)
  1.  . . I LRNIEN S NTEXT=TXT2
  1.  . ;
  1.  ;
  1.  Q LRNIEN
  1.  ;
  1.  ;
  1. MATCH(TEXT,DATA) ;
  1.  ; Private helper method
  1.  ; Scan the DATA array for an entry that matches TEXT.
  1.  ; Inputs
  1.  ;  TEXT: The .01 text to match on
  1.  ;  DATA: <byref> a DILIST array from FIND^DIC
  1.  ; Outputs
  1.  ;  0 = no match  or  the IEN of the matching record.
  1.  ;
  1.  ; Note: $$TRIMS and $$UPs for text comparisons.
  1.  ; 1) Looks for entries in DATA that have an SCT code. If TEXT matches .01 text use that entry.
  1.  ; 2) If no entries with SCT code match, check rest of DATA array.
  1.  ;
  1.  N I,LRIEN,REC,NM,SCT,TXT2
  1.  S TEXT=$G(TEXT)
  1.  S TXT2=$$TRIM^XLFSTR($$UP^XLFSTR(TEXT))
  1.  S LRIEN=0
  1.  ; find one with an SCT code first
  1.  S I=0
  1.  F  S I=$O(DATA("DILIST","ID",I)) Q:'I  D  Q:LRIEN  ;
  1.  . S SCT=DATA("DILIST","ID",I,20)
  1.  . Q:SCT=""
  1.  . ; Should it only be a valid SCT code? does name match?
  1.  . S REC=DATA("DILIST",2,I)
  1.  . S NM=DATA("DILIST","ID",I,.01)
  1.  . Q:$$TRIM^XLFSTR($$UP^XLFSTR(NM))'=TXT2
  1.  . S LRIEN=REC
  1.  ;
  1.  I LRIEN Q LRIEN
  1.  S I=0
  1.  F  S I=$O(DATA("DILIST",2,I)) Q:'I  D  Q:LRIEN  ;
  1.  . S REC=DATA("DILIST",2,I)
  1.  . S NM=DATA("DILIST","ID",I,.01)
  1.  . Q:$$TRIM^XLFSTR($$UP^XLFSTR(NM))'=TXT2
  1.  . S LRIEN=REC
  1.  Q LRIEN