- TIUMAP1 ; ISL/JER - TIU/VHA Enterprise Document Type Ontology Mapper ;10/24/06 09:01
- ;;1.0;TEXT INTEGRATION UTILITIES;**211**;Jun 20, 1997;Build 26
- PARSE(RESULT,TIUNM) ; Attempt to map each word to one of the LOINC axes - build parse tree
- N TIUI,TIUPTREE,TIUWORD,TIULOCAL,TIUY S TIULOCAL=TIUNM,TIUY=0
- S TIUPTREE=$NA(^TMP("TIUMAP",$J)) K @TIUPTREE
- ; Test whether each word maps to a Subject Matter Domain
- 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)
- Q:+$G(DIRUT)
- ; Test whether each REMAINING word maps to a Role
- 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)
- Q:+$G(DIRUT)
- ; Test whether each REMAINING word maps to a Setting
- 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)
- Q:+$G(DIRUT)
- ; Test whether each REMAINING word maps to a Service
- 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)
- Q:+$G(DIRUT)
- ; Test whether each REMAINING word maps to a Document Type
- 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)
- Q:+$G(DIRUT)
- I $D(@TIUPTREE) D
- . N SMD,ROLE,SET,SVC,DTYP,SCRN,DIC,X S SCRN="I ",X=""
- . S SMD=$G(@TIUPTREE@("SubjectMatterDomain"))
- . S ROLE=$G(@TIUPTREE@("Role"))
- . S SET=$G(@TIUPTREE@("Setting"))
- . S SVC=$G(@TIUPTREE@("Service"))
- . S DTYP=$G(@TIUPTREE@("DocumentType"))
- . I DTYP="" S DTYP=+$O(^TIU(8926.6,"B","NOTE",0))_U_"NOTE"
- . I W !,"No Document Type found...Setting Document Type to 'NOTE.'",!
- . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Now, we'll query the VHA Enterprise Standard Titles for an entry with:",!
- . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?12,"LOCAL Title: ",TIULOCAL
- . I +SMD D
- . . S SCRN=SCRN_"$P(^(0),U,4)="_+SMD
- . . S:X="" X=$P(SMD,U,2)
- . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?2,"Subject Matter Domain: ",$P(SMD,U,2)
- . I +ROLE D
- . . S SCRN=SCRN_$S(SCRN="I ":"",1:",")_"$P(^(0),U,5)="_+ROLE
- . . S:X="" X=$P(ROLE,U,2)
- . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?19,"Role: ",$P(ROLE,U,2)
- . I +SET D
- . . S SCRN=SCRN_$S(SCRN="I ":"",1:",")_"$P(^(0),U,6)="_+SET
- . . S:X="" X=$P(SET,U,2)
- . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?16,"Setting: ",$P(SET,U,2)
- . I +SVC D
- . . S SCRN=SCRN_$S(SCRN="I ":"",1:",")_"$P(^(0),U,7)="_+SVC
- . . S:X="" X=$P(SVC,U,2)
- . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?16,"Service: ",$P(SVC,U,2)
- . I +DTYP D
- . . S SCRN=SCRN_$S(SCRN="I ":"",1:",")_"$P(^(0),U,8)="_+DTYP
- . . S:X="" X=$P(DTYP,U,2)
- . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !?10,"Document Type: ",$P(DTYP,U,2)
- . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !!,"First, we'll try an EXCLUSIVE match (i.e., ALL conditions met):"
- . S DIC("S")=SCRN_",'$$SCREEN^XTID(8926.1,"""",+Y_"","")",DIC=8926.1
- . S TIUY=$$ASK(X,.DIC) Q:+$G(DIRUT)
- . I +TIUY'>0,($L(SCRN,"$P")>2) D Q:+$G(DIRUT)
- . . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !!,"Since that failed, we'll try an INCLUSIVE match (i.e., ANY conditions met):"
- . . S SCRN=$$ANDTOOR(SCRN)
- . . S DIC("S")=SCRN_",'$$SCREEN^XTID(8926.1,"""",+Y_"","")",DIC=8926.1
- . . S TIUY=$$ASK(X,.DIC)
- I +TIUY'>0 D Q:+$G(DIRUT)
- . N TIUCONT S TIUCONT=1
- . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !!,$$EXPLAT," Let's try a manual look-up..."
- . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Again, your LOCAL Title is: ",TIULOCAL,!!," NOTE: Only ACTIVE Titles may be selected...",!
- . F D Q:+TIUCONT'>0
- . . N DIC S DIC=8926.1,DIC(0)="AEMQ",DIC("A")="Select VHA ENTERPRISE STANDARD TITLE: "
- . . S DIC("S")="I '$$SCREEN^XTID(8926.1,"""",+Y_"","")"
- . . S TIUY=$$ASK("",.DIC) I +TIUY>0 S TIUCONT=0 Q
- . . I '$$PAGE^TIUMAP2(TIULOCAL) S TIUCONT=0 Q
- . . W !!,"You didn't select a VHA Enterprise Standard Title...",!
- . . S TIUCONT=$$READ^TIUU("Y","... Try to map "_TIULOCAL_" again","NO") W !
- . . S:+$G(DIRUT) TIUOUT=1
- Q:+TIUY'>0!+$G(DIRUT)
- S RESULT=+TIUY,RESULT(1)=TIUY_U_TIULOCAL
- Q
- LOG(TIULOCAL,DA) ; Log a mapping failure
- N DIE,DR
- W !!,"Recording the unmapped LOCAL Title: ",TIULOCAL,!
- S ^XTMP("TIUMAP","FAIL",TIULOCAL,DA)=""
- S DIE=8925.1,DR="1502////^S X="_$$NOW^XLFDT_";1503////^S X="_DUZ D ^DIE
- ; Drop LOCK
- L -^TIU(8925.1,DA,15):1
- Q
- EXPLAT() ; Random selector of explatives
- N EXP S EXP="AUGH!;OUCH!;YUCK!;BLECH!;OY VEY!;UFF DAH!"
- Q $P(EXP,";",$R(6)+1)
- ANDTOOR(SCRN) ; Replaces AND operators with OR
- F Q:'$F(SCRN,",$P") S $E(SCRN,$F(SCRN,",$P")-3)="!"
- Q SCRN
- SMD(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a SMD?
- N TIUY S TIUY=0
- Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a Subject Matter Domain? "
- S TIUY=$$ASK(TIUWORD,8926.2) I +$G(DIRUT) Q
- ; First, inquire to the SMD file (#8926.2)
- I +TIUY>0 S @RESULT@("SubjectMatterDomain")=TIUY D PLUCK(.TIUNM,TIUWORD,TIUI) I 1
- ; That failing, try the SMD Synonyms File (#8926.72)
- E D Q:+$G(DIRUT)
- . W "No."
- . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a SYNONYM for a Subject Matter Domain? "
- . S TIUY=$$ASK(TIUWORD,8926.72) Q:+$G(DIRUT)
- . I +TIUY>0 D
- . . S TIUY=+$P($G(^TIU(8926.72,+TIUY,0)),U,2)
- . . S TIUY=TIUY_U_$P($G(^TIU(8926.2,+TIUY,0)),U)
- . . S @RESULT@("SubjectMatterDomain")=TIUY
- . . D PLUCK(.TIUNM,TIUWORD,TIUI)
- I +TIUY'>0 W "No.",!
- Q
- ROLE(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a ROLE?
- N TIUY S TIUY=0
- Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a LOINC Role? "
- ; First, inquire to the ROLE file (#8926.3)
- S TIUY=$$ASK(TIUWORD,8926.3) Q:+$G(DIRUT)
- I +TIUY>0 S @RESULT@("Role")=TIUY D PLUCK(.TIUNM,TIUWORD,TIUI) I 1
- ; That failing, try the Role Synonyms File (#8926.73)
- E D Q:+$G(DIRUT)
- . W "No."
- . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a SYNONYM for a LOINC Role? "
- . S TIUY=$$ASK(TIUWORD,8926.73) Q:+$G(DIRUT)
- . I +TIUY>0 D
- . . S TIUY=+$P($G(^TIU(8926.73,+TIUY,0)),U,2)
- . . S TIUY=TIUY_U_$P($G(^TIU(8926.3,+TIUY,0)),U)
- . . S @RESULT@("Role")=TIUY
- . . D PLUCK(.TIUNM,TIUWORD,TIUI)
- I +TIUY'>0 W "No.",!
- Q
- SET(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a SETTING?
- N TIUY S TIUY=0
- Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a Setting? "
- ; First, inquire to the Setting file (#8926.4)
- S TIUY=$$ASK(TIUWORD,8926.4) Q:+$G(DIRUT)
- I +TIUY>0 S @RESULT@("Setting")=TIUY D PLUCK(.TIUNM,TIUWORD,TIUI) I 1
- ; That failing, try the Setting Synonyms File (#8926.74)
- E D Q:+$G(DIRUT)
- . W "No."
- . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a SYNONYM for a Setting? "
- . S TIUY=$$ASK(TIUWORD,8926.74) Q:+$G(DIRUT)
- . I +TIUY>0 D
- . . S TIUY=+$P($G(^TIU(8926.74,+TIUY,0)),U,2)
- . . S TIUY=TIUY_U_$P($G(^TIU(8926.4,+TIUY,0)),U)
- . . S @RESULT@("Setting")=TIUY
- . . D PLUCK(.TIUNM,TIUWORD,TIUI)
- I +TIUY'>0 W "No.",!
- Q
- SVC(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a SERVICE?
- N TIUY S TIUY=0
- Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a Service? "
- ; First, inquire to the Service file (#8926.5)
- S TIUY=$$ASK(TIUWORD,8926.5) Q:+$G(DIRUT)
- I +TIUY>0 S @RESULT@("Service")=TIUY D PLUCK(.TIUNM,TIUWORD,TIUI) I 1
- ; That failing, try the Role Synonyms File (#8926.75)
- E D Q:+$G(DIRUT)
- . W "No."
- . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a SYNONYM for a Service? "
- . S TIUY=$$ASK(TIUWORD,8926.75) Q:+$G(DIRUT)
- . I +TIUY>0 D
- . . S TIUY=+$P($G(^TIU(8926.75,+TIUY,0)),U,2)
- . . S TIUY=TIUY_U_$P($G(^TIU(8926.5,+TIUY,0)),U)
- . . S @RESULT@("Service")=TIUY
- . . D PLUCK(.TIUNM,TIUWORD,TIUI)
- I +TIUY'>0 W "No.",!
- Q
- DTYP(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a DOCUMENT TYPE?
- N TIUY S TIUY=0
- Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a Document Type? "
- ; First, inquire to the Document Type file (#8926.6)
- S TIUY=$$ASK(TIUWORD,8926.6) Q:+$G(DIRUT)
- I +TIUY>0 S @RESULT@("DocumentType")=TIUY D PLUCK(.TIUNM,TIUWORD,TIUI) I 1
- ; That failing, try the Role Synonyms File (#8926.76)
- E D Q:+$G(DIRUT)
- . W "No."
- . Q:'$$PAGE^TIUMAP2(TIULOCAL) W !,"Is """,TIUWORD,""" a SYNONYM for a Document Type? "
- . S TIUY=$$ASK(TIUWORD,8926.76) Q:+$G(DIRUT)
- . I +TIUY>0 D
- . . S TIUY=+$P($G(^TIU(8926.76,+TIUY,0)),U,2)
- . . S TIUY=TIUY_U_$P($G(^TIU(8926.6,+TIUY,0)),U)
- . . S @RESULT@("DocumentType")=TIUY
- . . D PLUCK(.TIUNM,TIUWORD,TIUI)
- I +TIUY'>0 W "No.",!
- Q
- PLUCK(TIUNM,TIUWORD,TIUI) ; Pluck word from name
- N TIUOUT S TIUOUT=$P(TIUNM," ",TIUI) Q:TIUOUT'=TIUWORD
- 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," "))))
- Q
- CONFIRM(RESULT,DEFAULT) ; Show selected title to user, ask to confirm
- N TIUY,DUOUT,DTOUT,DIRUT S TIUY=0
- W !?5,"Ready to map LOCAL Title: ",$P(RESULT(1),U,3)," to",!,"VHA Enterprise Standard Title: ",$P(RESULT(1),U,2),"."
- S TIUY=$$READ^TIUU("YA"," ... OK? ",DEFAULT)
- I +TIUY'>0 S RESULT=0 K RESULT(1)
- Q
- ASK(X,DIC) ; Call DIC to perform look-up
- N Y,TIUY,TIUSYN,TIUSNM S TIUY=0,TIUSNM=""
- 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:"")
- 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)
- S:'$D(DIC(0)) DIC(0)="EM"
- S:TIUSYN&(DIC(0)'["Z") DIC(0)=DIC(0)_"Z"
- D ^DIC I $D(DTOUT)!$D(DUOUT) S DIRUT=1 S:X="^^" DIROUT=1
- I +Y>0 D
- . W !?4,"I found a match of: ",$P(Y,U,2)
- . I +TIUSYN,$D(Y(0)) W !?(22-$L(TIUSNM)),TIUSNM,": ",$P($G(^TIU(TIUSYN,+$P(Y(0),U,2),0)),U)
- . S TIUY=$$READ^TIUU("YA"," ... OK? ","Yes") W !
- . S:+TIUY'>0 Y=-1
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUMAP1 9729 printed Feb 19, 2025@00:09 Page 2
- 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
- PARSE(RESULT,TIUNM) ; Attempt to map each word to one of the LOINC axes - build parse tree
- +1 NEW TIUI,TIUPTREE,TIUWORD,TIULOCAL,TIUY
- SET TIULOCAL=TIUNM
- SET TIUY=0
- +2 SET TIUPTREE=$NAME(^TMP("TIUMAP",$JOB))
- KILL @TIUPTREE
- +3 ; Test whether each word maps to a Subject Matter Domain
- +4 FOR TIUI=1:1:$LENGTH(TIUNM," ")
- SET TIUWORD=$PIECE(TIUNM," ",TIUI)
- if TIUWORD']""
- QUIT
- DO SMD(TIUPTREE,TIUWORD,.TIUNM,TIUI)
- if +$GET(@TIUPTREE@("SubjectMatterDomain"))!+$GET(DIRUT)
- QUIT
- +5 if +$GET(DIRUT)
- QUIT
- +6 ; Test whether each REMAINING word maps to a Role
- +7 FOR TIUI=1:1:$LENGTH(TIUNM," ")
- SET TIUWORD=$PIECE(TIUNM," ",TIUI)
- if TIUWORD']""
- QUIT
- DO ROLE(TIUPTREE,TIUWORD,.TIUNM,TIUI)
- if +$GET(@TIUPTREE@("Role"))!+$GET(DIRUT)
- QUIT
- +8 if +$GET(DIRUT)
- QUIT
- +9 ; Test whether each REMAINING word maps to a Setting
- +10 FOR TIUI=1:1:$LENGTH(TIUNM," ")
- SET TIUWORD=$PIECE(TIUNM," ",TIUI)
- if TIUWORD']""
- QUIT
- DO SET(TIUPTREE,TIUWORD,.TIUNM,TIUI)
- if +$GET(@TIUPTREE@("Setting"))!+$GET(DIRUT)
- QUIT
- +11 if +$GET(DIRUT)
- QUIT
- +12 ; Test whether each REMAINING word maps to a Service
- +13 FOR TIUI=1:1:$LENGTH(TIUNM," ")
- SET TIUWORD=$PIECE(TIUNM," ",TIUI)
- if TIUWORD']""
- QUIT
- DO SVC(TIUPTREE,TIUWORD,.TIUNM,TIUI)
- if +$GET(@TIUPTREE@("Service"))!+$GET(DIRUT)
- QUIT
- +14 if +$GET(DIRUT)
- QUIT
- +15 ; Test whether each REMAINING word maps to a Document Type
- +16 FOR TIUI=1:1:$LENGTH(TIUNM," ")
- SET TIUWORD=$PIECE(TIUNM," ",TIUI)
- if TIUWORD']""
- QUIT
- DO DTYP(TIUPTREE,TIUWORD,.TIUNM,TIUI)
- if +$GET(@TIUPTREE@("DocumentType"))!+$GET(DIRUT)
- QUIT
- +17 if +$GET(DIRUT)
- QUIT
- +18 IF $DATA(@TIUPTREE)
- Begin DoDot:1
- +19 NEW SMD,ROLE,SET,SVC,DTYP,SCRN,DIC,X
- SET SCRN="I "
- SET X=""
- +20 SET SMD=$GET(@TIUPTREE@("SubjectMatterDomain"))
- +21 SET ROLE=$GET(@TIUPTREE@("Role"))
- +22 SET SET=$GET(@TIUPTREE@("Setting"))
- +23 SET SVC=$GET(@TIUPTREE@("Service"))
- +24 SET DTYP=$GET(@TIUPTREE@("DocumentType"))
- +25 IF DTYP=""
- SET DTYP=+$ORDER(^TIU(8926.6,"B","NOTE",0))_U_"NOTE"
- +26 IF $TEST
- WRITE !,"No Document Type found...Setting Document Type to 'NOTE.'",!
- +27 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Now, we'll query the VHA Enterprise Standard Titles for an entry with:",!
- +28 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !?12,"LOCAL Title: ",TIULOCAL
- +29 IF +SMD
- Begin DoDot:2
- +30 SET SCRN=SCRN_"$P(^(0),U,4)="_+SMD
- +31 if X=""
- SET X=$PIECE(SMD,U,2)
- +32 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !?2,"Subject Matter Domain: ",$PIECE(SMD,U,2)
- End DoDot:2
- +33 IF +ROLE
- Begin DoDot:2
- +34 SET SCRN=SCRN_$SELECT(SCRN="I ":"",1:",")_"$P(^(0),U,5)="_+ROLE
- +35 if X=""
- SET X=$PIECE(ROLE,U,2)
- +36 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !?19,"Role: ",$PIECE(ROLE,U,2)
- End DoDot:2
- +37 IF +SET
- Begin DoDot:2
- +38 SET SCRN=SCRN_$SELECT(SCRN="I ":"",1:",")_"$P(^(0),U,6)="_+SET
- +39 if X=""
- SET X=$PIECE(SET,U,2)
- +40 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !?16,"Setting: ",$PIECE(SET,U,2)
- End DoDot:2
- +41 IF +SVC
- Begin DoDot:2
- +42 SET SCRN=SCRN_$SELECT(SCRN="I ":"",1:",")_"$P(^(0),U,7)="_+SVC
- +43 if X=""
- SET X=$PIECE(SVC,U,2)
- +44 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !?16,"Service: ",$PIECE(SVC,U,2)
- End DoDot:2
- +45 IF +DTYP
- Begin DoDot:2
- +46 SET SCRN=SCRN_$SELECT(SCRN="I ":"",1:",")_"$P(^(0),U,8)="_+DTYP
- +47 if X=""
- SET X=$PIECE(DTYP,U,2)
- +48 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !?10,"Document Type: ",$PIECE(DTYP,U,2)
- End DoDot:2
- +49 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !!,"First, we'll try an EXCLUSIVE match (i.e., ALL conditions met):"
- +50 SET DIC("S")=SCRN_",'$$SCREEN^XTID(8926.1,"""",+Y_"","")"
- SET DIC=8926.1
- +51 SET TIUY=$$ASK(X,.DIC)
- if +$GET(DIRUT)
- QUIT
- +52 IF +TIUY'>0
- IF ($LENGTH(SCRN,"$P")>2)
- Begin DoDot:2
- +53 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !!,"Since that failed, we'll try an INCLUSIVE match (i.e., ANY conditions met):"
- +54 SET SCRN=$$ANDTOOR(SCRN)
- +55 SET DIC("S")=SCRN_",'$$SCREEN^XTID(8926.1,"""",+Y_"","")"
- SET DIC=8926.1
- +56 SET TIUY=$$ASK(X,.DIC)
- End DoDot:2
- if +$GET(DIRUT)
- QUIT
- End DoDot:1
- +57 IF +TIUY'>0
- Begin DoDot:1
- +58 NEW TIUCONT
- SET TIUCONT=1
- +59 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !!,$$EXPLAT," Let's try a manual look-up..."
- +60 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Again, your LOCAL Title is: ",TIULOCAL,!!," NOTE: Only ACTIVE Titles may be selected...",!
- +61 FOR
- Begin DoDot:2
- +62 NEW DIC
- SET DIC=8926.1
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select VHA ENTERPRISE STANDARD TITLE: "
- +63 SET DIC("S")="I '$$SCREEN^XTID(8926.1,"""",+Y_"","")"
- +64 SET TIUY=$$ASK("",.DIC)
- IF +TIUY>0
- SET TIUCONT=0
- QUIT
- +65 IF '$$PAGE^TIUMAP2(TIULOCAL)
- SET TIUCONT=0
- QUIT
- +66 WRITE !!,"You didn't select a VHA Enterprise Standard Title...",!
- +67 SET TIUCONT=$$READ^TIUU("Y","... Try to map "_TIULOCAL_" again","NO")
- WRITE !
- +68 if +$GET(DIRUT)
- SET TIUOUT=1
- End DoDot:2
- if +TIUCONT'>0
- QUIT
- End DoDot:1
- if +$GET(DIRUT)
- QUIT
- +69 if +TIUY'>0!+$GET(DIRUT)
- QUIT
- +70 SET RESULT=+TIUY
- SET RESULT(1)=TIUY_U_TIULOCAL
- +71 QUIT
- LOG(TIULOCAL,DA) ; Log a mapping failure
- +1 NEW DIE,DR
- +2 WRITE !!,"Recording the unmapped LOCAL Title: ",TIULOCAL,!
- +3 SET ^XTMP("TIUMAP","FAIL",TIULOCAL,DA)=""
- +4 SET DIE=8925.1
- SET DR="1502////^S X="_$$NOW^XLFDT_";1503////^S X="_DUZ
- DO ^DIE
- +5 ; Drop LOCK
- +6 LOCK -^TIU(8925.1,DA,15):1
- +7 QUIT
- EXPLAT() ; Random selector of explatives
- +1 NEW EXP
- SET EXP="AUGH!;OUCH!;YUCK!;BLECH!;OY VEY!;UFF DAH!"
- +2 QUIT $PIECE(EXP,";",$RANDOM(6)+1)
- ANDTOOR(SCRN) ; Replaces AND operators with OR
- +1 FOR
- if '$FIND(SCRN,",$P")
- QUIT
- SET $EXTRACT(SCRN,$FIND(SCRN,",$P")-3)="!"
- +2 QUIT SCRN
- SMD(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a SMD?
- +1 NEW TIUY
- SET TIUY=0
- +2 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Is """,TIUWORD,""" a Subject Matter Domain? "
- +3 SET TIUY=$$ASK(TIUWORD,8926.2)
- IF +$GET(DIRUT)
- QUIT
- +4 ; First, inquire to the SMD file (#8926.2)
- +5 IF +TIUY>0
- SET @RESULT@("SubjectMatterDomain")=TIUY
- DO PLUCK(.TIUNM,TIUWORD,TIUI)
- IF 1
- +6 ; That failing, try the SMD Synonyms File (#8926.72)
- +7 IF '$TEST
- Begin DoDot:1
- +8 WRITE "No."
- +9 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Is """,TIUWORD,""" a SYNONYM for a Subject Matter Domain? "
- +10 SET TIUY=$$ASK(TIUWORD,8926.72)
- if +$GET(DIRUT)
- QUIT
- +11 IF +TIUY>0
- Begin DoDot:2
- +12 SET TIUY=+$PIECE($GET(^TIU(8926.72,+TIUY,0)),U,2)
- +13 SET TIUY=TIUY_U_$PIECE($GET(^TIU(8926.2,+TIUY,0)),U)
- +14 SET @RESULT@("SubjectMatterDomain")=TIUY
- +15 DO PLUCK(.TIUNM,TIUWORD,TIUI)
- End DoDot:2
- End DoDot:1
- if +$GET(DIRUT)
- QUIT
- +16 IF +TIUY'>0
- WRITE "No.",!
- +17 QUIT
- ROLE(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a ROLE?
- +1 NEW TIUY
- SET TIUY=0
- +2 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Is """,TIUWORD,""" a LOINC Role? "
- +3 ; First, inquire to the ROLE file (#8926.3)
- +4 SET TIUY=$$ASK(TIUWORD,8926.3)
- if +$GET(DIRUT)
- QUIT
- +5 IF +TIUY>0
- SET @RESULT@("Role")=TIUY
- DO PLUCK(.TIUNM,TIUWORD,TIUI)
- IF 1
- +6 ; That failing, try the Role Synonyms File (#8926.73)
- +7 IF '$TEST
- Begin DoDot:1
- +8 WRITE "No."
- +9 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Is """,TIUWORD,""" a SYNONYM for a LOINC Role? "
- +10 SET TIUY=$$ASK(TIUWORD,8926.73)
- if +$GET(DIRUT)
- QUIT
- +11 IF +TIUY>0
- Begin DoDot:2
- +12 SET TIUY=+$PIECE($GET(^TIU(8926.73,+TIUY,0)),U,2)
- +13 SET TIUY=TIUY_U_$PIECE($GET(^TIU(8926.3,+TIUY,0)),U)
- +14 SET @RESULT@("Role")=TIUY
- +15 DO PLUCK(.TIUNM,TIUWORD,TIUI)
- End DoDot:2
- End DoDot:1
- if +$GET(DIRUT)
- QUIT
- +16 IF +TIUY'>0
- WRITE "No.",!
- +17 QUIT
- SET(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a SETTING?
- +1 NEW TIUY
- SET TIUY=0
- +2 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Is """,TIUWORD,""" a Setting? "
- +3 ; First, inquire to the Setting file (#8926.4)
- +4 SET TIUY=$$ASK(TIUWORD,8926.4)
- if +$GET(DIRUT)
- QUIT
- +5 IF +TIUY>0
- SET @RESULT@("Setting")=TIUY
- DO PLUCK(.TIUNM,TIUWORD,TIUI)
- IF 1
- +6 ; That failing, try the Setting Synonyms File (#8926.74)
- +7 IF '$TEST
- Begin DoDot:1
- +8 WRITE "No."
- +9 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Is """,TIUWORD,""" a SYNONYM for a Setting? "
- +10 SET TIUY=$$ASK(TIUWORD,8926.74)
- if +$GET(DIRUT)
- QUIT
- +11 IF +TIUY>0
- Begin DoDot:2
- +12 SET TIUY=+$PIECE($GET(^TIU(8926.74,+TIUY,0)),U,2)
- +13 SET TIUY=TIUY_U_$PIECE($GET(^TIU(8926.4,+TIUY,0)),U)
- +14 SET @RESULT@("Setting")=TIUY
- +15 DO PLUCK(.TIUNM,TIUWORD,TIUI)
- End DoDot:2
- End DoDot:1
- if +$GET(DIRUT)
- QUIT
- +16 IF +TIUY'>0
- WRITE "No.",!
- +17 QUIT
- SVC(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a SERVICE?
- +1 NEW TIUY
- SET TIUY=0
- +2 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Is """,TIUWORD,""" a Service? "
- +3 ; First, inquire to the Service file (#8926.5)
- +4 SET TIUY=$$ASK(TIUWORD,8926.5)
- if +$GET(DIRUT)
- QUIT
- +5 IF +TIUY>0
- SET @RESULT@("Service")=TIUY
- DO PLUCK(.TIUNM,TIUWORD,TIUI)
- IF 1
- +6 ; That failing, try the Role Synonyms File (#8926.75)
- +7 IF '$TEST
- Begin DoDot:1
- +8 WRITE "No."
- +9 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Is """,TIUWORD,""" a SYNONYM for a Service? "
- +10 SET TIUY=$$ASK(TIUWORD,8926.75)
- if +$GET(DIRUT)
- QUIT
- +11 IF +TIUY>0
- Begin DoDot:2
- +12 SET TIUY=+$PIECE($GET(^TIU(8926.75,+TIUY,0)),U,2)
- +13 SET TIUY=TIUY_U_$PIECE($GET(^TIU(8926.5,+TIUY,0)),U)
- +14 SET @RESULT@("Service")=TIUY
- +15 DO PLUCK(.TIUNM,TIUWORD,TIUI)
- End DoDot:2
- End DoDot:1
- if +$GET(DIRUT)
- QUIT
- +16 IF +TIUY'>0
- WRITE "No.",!
- +17 QUIT
- DTYP(RESULT,TIUWORD,TIUNM,TIUI) ; Is word a DOCUMENT TYPE?
- +1 NEW TIUY
- SET TIUY=0
- +2 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Is """,TIUWORD,""" a Document Type? "
- +3 ; First, inquire to the Document Type file (#8926.6)
- +4 SET TIUY=$$ASK(TIUWORD,8926.6)
- if +$GET(DIRUT)
- QUIT
- +5 IF +TIUY>0
- SET @RESULT@("DocumentType")=TIUY
- DO PLUCK(.TIUNM,TIUWORD,TIUI)
- IF 1
- +6 ; That failing, try the Role Synonyms File (#8926.76)
- +7 IF '$TEST
- Begin DoDot:1
- +8 WRITE "No."
- +9 if '$$PAGE^TIUMAP2(TIULOCAL)
- QUIT
- WRITE !,"Is """,TIUWORD,""" a SYNONYM for a Document Type? "
- +10 SET TIUY=$$ASK(TIUWORD,8926.76)
- if +$GET(DIRUT)
- QUIT
- +11 IF +TIUY>0
- Begin DoDot:2
- +12 SET TIUY=+$PIECE($GET(^TIU(8926.76,+TIUY,0)),U,2)
- +13 SET TIUY=TIUY_U_$PIECE($GET(^TIU(8926.6,+TIUY,0)),U)
- +14 SET @RESULT@("DocumentType")=TIUY
- +15 DO PLUCK(.TIUNM,TIUWORD,TIUI)
- End DoDot:2
- End DoDot:1
- if +$GET(DIRUT)
- QUIT
- +16 IF +TIUY'>0
- WRITE "No.",!
- +17 QUIT
- PLUCK(TIUNM,TIUWORD,TIUI) ; Pluck word from name
- +1 NEW TIUOUT
- SET TIUOUT=$PIECE(TIUNM," ",TIUI)
- if TIUOUT'=TIUWORD
- QUIT
- +2 SET TIUNM=$SELECT(TIUI=1:$PIECE(TIUNM," ",2,$LENGTH(TIUNM," ")),1:$PIECE(TIUNM," ",1,(TIUI-1))_$SELECT(TIUI=$LENGTH(TIUNM," "):"",1:" "_$PIECE(TIUNM," ",(TIUI+1),$LENGTH(TIUNM," "))))
- +3 QUIT
- CONFIRM(RESULT,DEFAULT) ; Show selected title to user, ask to confirm
- +1 NEW TIUY,DUOUT,DTOUT,DIRUT
- SET TIUY=0
- +2 WRITE !?5,"Ready to map LOCAL Title: ",$PIECE(RESULT(1),U,3)," to",!,"VHA Enterprise Standard Title: ",$PIECE(RESULT(1),U,2),"."
- +3 SET TIUY=$$READ^TIUU("YA"," ... OK? ",DEFAULT)
- +4 IF +TIUY'>0
- SET RESULT=0
- KILL RESULT(1)
- +5 QUIT
- ASK(X,DIC) ; Call DIC to perform look-up
- +1 NEW Y,TIUY,TIUSYN,TIUSNM
- SET TIUY=0
- SET TIUSNM=""
- +2 SET TIUSNM=$SELECT(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:"")
- +3 SET TIUSYN=$SELECT(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)
- +4 if '$DATA(DIC(0))
- SET DIC(0)="EM"
- +5 if TIUSYN&(DIC(0)'["Z")
- SET DIC(0)=DIC(0)_"Z"
- +6 DO ^DIC
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET DIRUT=1
- if X="^^"
- SET DIROUT=1
- +7 IF +Y>0
- Begin DoDot:1
- +8 WRITE !?4,"I found a match of: ",$PIECE(Y,U,2)
- +9 IF +TIUSYN
- IF $DATA(Y(0))
- WRITE !?(22-$LENGTH(TIUSNM)),TIUSNM,": ",$PIECE($GET(^TIU(TIUSYN,+$PIECE(Y(0),U,2),0)),U)
- +10 SET TIUY=$$READ^TIUU("YA"," ... OK? ","Yes")
- WRITE !
- +11 if +TIUY'>0
- SET Y=-1
- End DoDot:1
- +12 QUIT Y