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

TIUMAP1.m

Go to the documentation of this file.
  1. TIUMAP1 ; ISL/JER - TIU/VHA Enterprise Document Type Ontology Mapper ;10/24/06 09:01
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**211**;Jun 20, 1997;Build 26
  1. PARSE(RESULT,TIUNM) ; Attempt to map each word to one of the LOINC axes - build parse tree
  1. N TIUI,TIUPTREE,TIUWORD,TIULOCAL,TIUY S TIULOCAL=TIUNM,TIUY=0
  1. S TIUPTREE=$NA(^TMP("TIUMAP",$J)) K @TIUPTREE
  1. ; Test whether each word maps to a Subject Matter Domain
  1. F TIUI=1:1:$L(TIUNM," ") S TIUWORD=$P(TIUNM," ",TIUI) Q:TIUWORD']"" D SMD(TIUPTREE,TIUWORD,.TIUNM,TIUI) Q:+$G(@TIUPTREE@("SubjectMatterDomain"))!+$G(DIRUT)
  1. Q:+$G(DIRUT)
  1. ; Test whether each REMAINING word maps to a Role
  1. F TIUI=1:1:$L(TIUNM," ") S TIUWORD=$P(TIUNM," ",TIUI) Q:TIUWORD']"" D ROLE(TIUPTREE,TIUWORD,.TIUNM,TIUI) Q:+$G(@TIUPTREE@("Role"))!+$G(DIRUT)
  1. Q:+$G(DIRUT)
  1. ; Test whether each REMAINING word maps to a Setting
  1. F TIUI=1:1:$L(TIUNM," ") S TIUWORD=$P(TIUNM," ",TIUI) Q:TIUWORD']"" D SET(TIUPTREE,TIUWORD,.TIUNM,TIUI) Q:+$G(@TIUPTREE@("Setting"))!+$G(DIRUT)
  1. Q:+$G(DIRUT)
  1. ; Test whether each REMAINING word maps to a Service
  1. F TIUI=1:1:$L(TIUNM," ") S TIUWORD=$P(TIUNM," ",TIUI) Q:TIUWORD']"" D SVC(TIUPTREE,TIUWORD,.TIUNM,TIUI) Q:+$G(@TIUPTREE@("Service"))!+$G(DIRUT)
  1. Q:+$G(DIRUT)
  1. ; Test whether each REMAINING word maps to a Document Type
  1. F TIUI=1:1:$L(TIUNM," ") S TIUWORD=$P(TIUNM," ",TIUI) Q:TIUWORD']"" D DTYP(TIUPTREE,TIUWORD,.TIUNM,TIUI) Q:+$G(@TIUPTREE@("DocumentType"))!+$G(DIRUT)
  1. Q:+$G(DIRUT)
  1. I $D(@TIUPTREE) D
  1. . N SMD,ROLE,SET,SVC,DTYP,SCRN,DIC,X S SCRN="I ",X=""
  1. . S SMD=$G(@TIUPTREE@("SubjectMatterDomain"))
  1. . S ROLE=$G(@TIUPTREE@("Role"))
  1. . S SET=$G(@TIUPTREE@("Setting"))
  1. . S SVC=$G(@TIUPTREE@("Service"))
  1. . S DTYP=$G(@TIUPTREE@("DocumentType"))
  1. . I DTYP="" S DTYP=+$O(^TIU(8926.6,"B","NOTE",0))_U_"NOTE"
  1. . I W !,"No Document Type found...Setting Document Type to 'NOTE.'",!
  1. . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Now, we'll query the VHA Enterprise Standard Titles for an entry with:",!
  1. . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?12,"LOCAL Title: ",TIULOCAL
  1. . I +SMD D
  1. . . S SCRN=SCRN_"$P(^(0),U,4)="_+SMD
  1. . . S:X="" X=$P(SMD,U,2)
  1. . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?2,"Subject Matter Domain: ",$P(SMD,U,2)
  1. . I +ROLE D
  1. . . S SCRN=SCRN_$S(SCRN="I ":"",1:",")_"$P(^(0),U,5)="_+ROLE
  1. . . S:X="" X=$P(ROLE,U,2)
  1. . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?19,"Role: ",$P(ROLE,U,2)
  1. . I +SET D
  1. . . S SCRN=SCRN_$S(SCRN="I ":"",1:",")_"$P(^(0),U,6)="_+SET
  1. . . S:X="" X=$P(SET,U,2)
  1. . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?16,"Setting: ",$P(SET,U,2)
  1. . I +SVC D
  1. . . S SCRN=SCRN_$S(SCRN="I ":"",1:",")_"$P(^(0),U,7)="_+SVC
  1. . . S:X="" X=$P(SVC,U,2)
  1. . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?16,"Service: ",$P(SVC,U,2)
  1. . I +DTYP D
  1. . . S SCRN=SCRN_$S(SCRN="I ":"",1:",")_"$P(^(0),U,8)="_+DTYP
  1. . . S:X="" X=$P(DTYP,U,2)
  1. . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?10,"Document Type: ",$P(DTYP,U,2)
  1. . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !!,"First, we'll try an EXCLUSIVE match (i.e., ALL conditions met):"
  1. . S DIC("S")=SCRN_",'$$SCREEN^XTID(8926.1,"""",+Y_"","")",DIC=8926.1
  1. . S TIUY=$$ASK(X,.DIC) Q:+$G(DIRUT)
  1. . I +TIUY'>0,($L(SCRN,"$P")>2) D Q:+$G(DIRUT)
  1. . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !!,"Since that failed, we'll try an INCLUSIVE match (i.e., ANY conditions met):"
  1. . . S SCRN=$$ANDTOOR(SCRN)
  1. . . S DIC("S")=SCRN_",'$$SCREEN^XTID(8926.1,"""",+Y_"","")",DIC=8926.1
  1. . . S TIUY=$$ASK(X,.DIC)
  1. I +TIUY'>0 D Q:+$G(DIRUT)
  1. . N TIUCONT S TIUCONT=1
  1. . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !!,$$EXPLAT," Let's try a manual look-up..."
  1. . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Again, your LOCAL Title is: ",TIULOCAL,!!," NOTE: Only ACTIVE Titles may be selected...",!
  1. . F D Q:+TIUCONT'>0
  1. . . N DIC S DIC=8926.1,DIC(0)="AEMQ",DIC("A")="Select VHA ENTERPRISE STANDARD TITLE: "
  1. . . S DIC("S")="I '$$SCREEN^XTID(8926.1,"""",+Y_"","")"
  1. . . S TIUY=$$ASK("",.DIC) I +TIUY>0 S TIUCONT=0 Q
  1. . . I '$$PAGE^TIUMAP2(TIULOCAL) S TIUCONT=0 Q
  1. . . W !!,"You didn't select a VHA Enterprise Standard Title...",!
  1. . . S TIUCONT=$$READ^TIUU("Y","... Try to map "_TIULOCAL_" again","NO") W !
  1. . . S:+$G(DIRUT) TIUOUT=1
  1. Q:+TIUY'>0!+$G(DIRUT)
  1. S RESULT=+TIUY,RESULT(1)=TIUY_U_TIULOCAL
  1. Q
  1. LOG(TIULOCAL,DA) ; Log a mapping failure
  1. N DIE,DR
  1. W !!,"Recording the unmapped LOCAL Title: ",TIULOCAL,!
  1. S ^XTMP("TIUMAP","FAIL",TIULOCAL,DA)=""
  1. S DIE=8925.1,DR="1502////^S X="_$$NOW^XLFDT_";1503////^S X="_DUZ D ^DIE
  1. ; Drop LOCK
  1. L -^TIU(8925.1,DA,15):1
  1. Q
  1. EXPLAT() ; Random selector of explatives
  1. N EXP S EXP="AUGH!;OUCH!;YUCK!;BLECH!;OY VEY!;UFF DAH!"
  1. Q $P(EXP,";",$R(6)+1)
  1. ANDTOOR(SCRN) ; Replaces AND operators with OR
  1. F Q:'$F(SCRN,",$P") S $E(SCRN,$F(SCRN,",$P")-3)="!"
  1. Q SCRN
  1. SMD(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a SMD?
  1. N TIUY S TIUY=0
  1. Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a Subject Matter Domain? "
  1. S TIUY=$$ASK(TIUWORD,8926.2) I +$G(DIRUT) Q
  1. ; First, inquire to the SMD file (#8926.2)
  1. I +TIUY>0 S @RESULT@("SubjectMatterDomain")=TIUY D PLUCK(.TIUNM,TIUWORD,TIUI) I 1
  1. ; That failing, try the SMD Synonyms File (#8926.72)
  1. E D Q:+$G(DIRUT)
  1. . W "No."
  1. . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a SYNONYM for a Subject Matter Domain? "
  1. . S TIUY=$$ASK(TIUWORD,8926.72) Q:+$G(DIRUT)
  1. . I +TIUY>0 D
  1. . . S TIUY=+$P($G(^TIU(8926.72,+TIUY,0)),U,2)
  1. . . S TIUY=TIUY_U_$P($G(^TIU(8926.2,+TIUY,0)),U)
  1. . . S @RESULT@("SubjectMatterDomain")=TIUY
  1. . . D PLUCK(.TIUNM,TIUWORD,TIUI)
  1. I +TIUY'>0 W "No.",!
  1. Q
  1. ROLE(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a ROLE?
  1. N TIUY S TIUY=0
  1. Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a LOINC Role? "
  1. ; First, inquire to the ROLE file (#8926.3)
  1. S TIUY=$$ASK(TIUWORD,8926.3) Q:+$G(DIRUT)
  1. I +TIUY>0 S @RESULT@("Role")=TIUY D PLUCK(.TIUNM,TIUWORD,TIUI) I 1
  1. ; That failing, try the Role Synonyms File (#8926.73)
  1. E D Q:+$G(DIRUT)
  1. . W "No."
  1. . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a SYNONYM for a LOINC Role? "
  1. . S TIUY=$$ASK(TIUWORD,8926.73) Q:+$G(DIRUT)
  1. . I +TIUY>0 D
  1. . . S TIUY=+$P($G(^TIU(8926.73,+TIUY,0)),U,2)
  1. . . S TIUY=TIUY_U_$P($G(^TIU(8926.3,+TIUY,0)),U)
  1. . . S @RESULT@("Role")=TIUY
  1. . . D PLUCK(.TIUNM,TIUWORD,TIUI)
  1. I +TIUY'>0 W "No.",!
  1. Q
  1. SET(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a SETTING?
  1. N TIUY S TIUY=0
  1. Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a Setting? "
  1. ; First, inquire to the Setting file (#8926.4)
  1. S TIUY=$$ASK(TIUWORD,8926.4) Q:+$G(DIRUT)
  1. I +TIUY>0 S @RESULT@("Setting")=TIUY D PLUCK(.TIUNM,TIUWORD,TIUI) I 1
  1. ; That failing, try the Setting Synonyms File (#8926.74)
  1. E D Q:+$G(DIRUT)
  1. . W "No."
  1. . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a SYNONYM for a Setting? "
  1. . S TIUY=$$ASK(TIUWORD,8926.74) Q:+$G(DIRUT)
  1. . I +TIUY>0 D
  1. . . S TIUY=+$P($G(^TIU(8926.74,+TIUY,0)),U,2)
  1. . . S TIUY=TIUY_U_$P($G(^TIU(8926.4,+TIUY,0)),U)
  1. . . S @RESULT@("Setting")=TIUY
  1. . . D PLUCK(.TIUNM,TIUWORD,TIUI)
  1. I +TIUY'>0 W "No.",!
  1. Q
  1. SVC(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a SERVICE?
  1. N TIUY S TIUY=0
  1. Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a Service? "
  1. ; First, inquire to the Service file (#8926.5)
  1. S TIUY=$$ASK(TIUWORD,8926.5) Q:+$G(DIRUT)
  1. I +TIUY>0 S @RESULT@("Service")=TIUY D PLUCK(.TIUNM,TIUWORD,TIUI) I 1
  1. ; That failing, try the Role Synonyms File (#8926.75)
  1. E D Q:+$G(DIRUT)
  1. . W "No."
  1. . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a SYNONYM for a Service? "
  1. . S TIUY=$$ASK(TIUWORD,8926.75) Q:+$G(DIRUT)
  1. . I +TIUY>0 D
  1. . . S TIUY=+$P($G(^TIU(8926.75,+TIUY,0)),U,2)
  1. . . S TIUY=TIUY_U_$P($G(^TIU(8926.5,+TIUY,0)),U)
  1. . . S @RESULT@("Service")=TIUY
  1. . . D PLUCK(.TIUNM,TIUWORD,TIUI)
  1. I +TIUY'>0 W "No.",!
  1. Q
  1. DTYP(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a DOCUMENT TYPE?
  1. N TIUY S TIUY=0
  1. Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a Document Type? "
  1. ; First, inquire to the Document Type file (#8926.6)
  1. S TIUY=$$ASK(TIUWORD,8926.6) Q:+$G(DIRUT)
  1. I +TIUY>0 S @RESULT@("DocumentType")=TIUY D PLUCK(.TIUNM,TIUWORD,TIUI) I 1
  1. ; That failing, try the Role Synonyms File (#8926.76)
  1. E D Q:+$G(DIRUT)
  1. . W "No."
  1. . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a SYNONYM for a Document Type? "
  1. . S TIUY=$$ASK(TIUWORD,8926.76) Q:+$G(DIRUT)
  1. . I +TIUY>0 D
  1. . . S TIUY=+$P($G(^TIU(8926.76,+TIUY,0)),U,2)
  1. . . S TIUY=TIUY_U_$P($G(^TIU(8926.6,+TIUY,0)),U)
  1. . . S @RESULT@("DocumentType")=TIUY
  1. . . D PLUCK(.TIUNM,TIUWORD,TIUI)
  1. I +TIUY'>0 W "No.",!
  1. Q
  1. PLUCK(TIUNM,TIUWORD,TIUI) ; Pluck word from name
  1. N TIUOUT S TIUOUT=$P(TIUNM," ",TIUI) Q:TIUOUT'=TIUWORD
  1. S TIUNM=$S(TIUI=1:$P(TIUNM," ",2,$L(TIUNM," ")),1:$P(TIUNM," ",1,(TIUI-1))_$S(TIUI=$L(TIUNM," "):"",1:" "_$P(TIUNM," ",(TIUI+1),$L(TIUNM," "))))
  1. Q
  1. CONFIRM(RESULT,DEFAULT) ; Show selected title to user, ask to confirm
  1. N TIUY,DUOUT,DTOUT,DIRUT S TIUY=0
  1. W !?5,"Ready to map LOCAL Title: ",$P(RESULT(1),U,3)," to",!,"VHA Enterprise Standard Title: ",$P(RESULT(1),U,2),"."
  1. S TIUY=$$READ^TIUU("YA"," ... OK? ",DEFAULT)
  1. I +TIUY'>0 S RESULT=0 K RESULT(1)
  1. Q
  1. ASK(X,DIC) ; Call DIC to perform look-up
  1. N Y,TIUY,TIUSYN,TIUSNM S TIUY=0,TIUSNM=""
  1. S TIUSNM=$S(DIC=8926.72:"Subject Matter Domain",DIC=8926.73:"LOINC Role",DIC=8926.74:"Setting",DIC=8926.75:"Service",DIC=8926.76:"Document Type",1:"")
  1. S TIUSYN=$S(DIC=8926.72:8926.2,DIC=8926.73:8926.3,DIC=8926.74:8926.4,DIC=8926.75:8926.5,DIC=8926.76:8926.6,1:0)
  1. S:'$D(DIC(0)) DIC(0)="EM"
  1. S:TIUSYN&(DIC(0)'["Z") DIC(0)=DIC(0)_"Z"
  1. D ^DIC I $D(DTOUT)!$D(DUOUT) S DIRUT=1 S:X="^^" DIROUT=1
  1. I +Y>0 D
  1. . W !?4,"I found a match of: ",$P(Y,U,2)
  1. . I +TIUSYN,$D(Y(0)) W !?(22-$L(TIUSNM)),TIUSNM,": ",$P($G(^TIU(TIUSYN,+$P(Y(0),U,2),0)),U)
  1. . S TIUY=$$READ^TIUU("YA"," ... OK? ","Yes") W !
  1. . S:+TIUY'>0 Y=-1
  1. Q Y