TIUMAP2 ; ISL/JER - TIU/VHA Enterprise Document Type Ontology Mapper ;10/20/06 09:28
;;1.0;TEXT INTEGRATION UTILITIES;**211**;Jun 20, 1997;Build 26
STRIP(TEXT) ; Remove punctuation & excess white space
N TIUTI,TIUX
; Strip punctuation
S TEXT=$TR(TEXT,".,!?/|{}[];:=+*^%$#@~`""><"," ")
; Remove TABS
F TIUTI=1:1:$L(TEXT) S:$A(TEXT,TIUTI)=9 TEXT=$E(TEXT,1,(TIUTI-1))_" "_$E(TEXT,(TIUTI+1),$L(TEXT))
; Remove multiple white space
S TIUX="" F TIUTI=1:1:$L(TEXT," ") S:$A($P(TEXT," ",TIUTI))>0 TIUX=TIUX_$S(TIUTI=1:"",1:" ")_$P(TEXT," ",TIUTI)
S TEXT=TIUX S:$P(TEXT," ")']"" TEXT=$P(TEXT," ",2,$L(TEXT," "))
Q TEXT
PAGE(TIULOCAL) ; Handle pagination
N TIUY S TIUY=1
Q:$Y'>(IOSL-4) TIUY
S TIUY=+$$READ^TIUU("E") S:+$G(DIRUT) TIUOUT=1
I TIUY W @IOF W:$G(TIULOCAL)]"" "Remember, your LOCAL title is: ",$G(TIULOCAL)
Q TIUY
INACT(TIUDA) ; Inactivate LOCAL title TIUDA
N DA,DR,DIE,TIUFPRIV S TIUFPRIV=1
W !!,"Inactivating ",$P($G(^TIU(8925.1,TIUDA,0)),U)
S DA=TIUDA,DR=".07///INACTIVE",DIE=8925.1 D ^DIE W ".",!
Q
DIRECT(TIUDA) ; Direct Title Mapping action
N RESULT,TIUCONT,TIULOCAL,TIUY
I '+$G(TIUDA) W !,"You must specify a local title." Q
S TIUCONT=1,TIULOCAL=$P($G(^TIU(8925.1,TIUDA,0)),U)
W !!,"Direct Mapping to Enterprise Standard Title..."
W !,"Your LOCAL Title is: ",TIULOCAL,!!," NOTE: Only ACTIVE Titles may be selected...",!
; Bid for LOCK
L +^TIU(8925.1,TIUDA,15):1
E D Q
. W !,$C(7),"Another user is mapping this title...",!
. W:$$READ^TIUU("E") "" S:+$G(DIRUT) TIUOUT=1
; First, check whether the LOCAL Title is already mapped
I +$G(^TIU(8925.1,+TIUDA,15)) D Q:RESULT<0!+$G(DIRUT)
. N TIUY S TIUY=0
. W !?5,"The LOCAL Title: ",TIULOCAL,!?7,"is already mapped to",!,"VHA Enterprise Title: ",$$LOINCNM^TIUMAP(+$G(^(15))),!
. S TIUY=$$READ^TIUU("YA","Do you want to RE-MAP it? ","NO")
. I +TIUY'>0 W $C(7),!,"... OK, No Harm Done!",! S RESULT=-1 H 2
. E S RESULT=1 W !
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^TIUMAP1("",.DIC) I +TIUY>0 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 !
. D:+TIUCONT'>0 LOG^TIUMAP1(TIULOCAL,TIUDA)
. S:+$G(DIRUT) TIUOUT=1
Q:+TIUY'>0!+$G(DIRUT)
S RESULT=+TIUY,RESULT(1)=TIUY_U_TIULOCAL
D CONFIRM^TIUMAP1(.RESULT,"Yes")
I +RESULT'>0!+$G(DIRUT) D LOG^TIUMAP1(TIULOCAL,TIUDA) Q
D POINT^TIUMAP(TIUDA,.RESULT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUMAP2 2616 printed Apr 09, 2024@21:48:28 Page 2
TIUMAP2 ; ISL/JER - TIU/VHA Enterprise Document Type Ontology Mapper ;10/20/06 09:28
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**211**;Jun 20, 1997;Build 26
STRIP(TEXT) ; Remove punctuation & excess white space
+1 NEW TIUTI,TIUX
+2 ; Strip punctuation
+3 SET TEXT=$TRANSLATE(TEXT,".,!?/|{}[];:=+*^%$#@~`""><"," ")
+4 ; Remove TABS
+5 FOR TIUTI=1:1:$LENGTH(TEXT)
if $ASCII(TEXT,TIUTI)=9
SET TEXT=$EXTRACT(TEXT,1,(TIUTI-1))_" "_$EXTRACT(TEXT,(TIUTI+1),$LENGTH(TEXT))
+6 ; Remove multiple white space
+7 SET TIUX=""
FOR TIUTI=1:1:$LENGTH(TEXT," ")
if $ASCII($PIECE(TEXT," ",TIUTI))>0
SET TIUX=TIUX_$SELECT(TIUTI=1:"",1:" ")_$PIECE(TEXT," ",TIUTI)
+8 SET TEXT=TIUX
if $PIECE(TEXT," ")']""
SET TEXT=$PIECE(TEXT," ",2,$LENGTH(TEXT," "))
+9 QUIT TEXT
PAGE(TIULOCAL) ; Handle pagination
+1 NEW TIUY
SET TIUY=1
+2 if $Y'>(IOSL-4)
QUIT TIUY
+3 SET TIUY=+$$READ^TIUU("E")
if +$GET(DIRUT)
SET TIUOUT=1
+4 IF TIUY
WRITE @IOF
if $GET(TIULOCAL)]""
WRITE "Remember, your LOCAL title is: ",$GET(TIULOCAL)
+5 QUIT TIUY
INACT(TIUDA) ; Inactivate LOCAL title TIUDA
+1 NEW DA,DR,DIE,TIUFPRIV
SET TIUFPRIV=1
+2 WRITE !!,"Inactivating ",$PIECE($GET(^TIU(8925.1,TIUDA,0)),U)
+3 SET DA=TIUDA
SET DR=".07///INACTIVE"
SET DIE=8925.1
DO ^DIE
WRITE ".",!
+4 QUIT
DIRECT(TIUDA) ; Direct Title Mapping action
+1 NEW RESULT,TIUCONT,TIULOCAL,TIUY
+2 IF '+$GET(TIUDA)
WRITE !,"You must specify a local title."
QUIT
+3 SET TIUCONT=1
SET TIULOCAL=$PIECE($GET(^TIU(8925.1,TIUDA,0)),U)
+4 WRITE !!,"Direct Mapping to Enterprise Standard Title..."
+5 WRITE !,"Your LOCAL Title is: ",TIULOCAL,!!," NOTE: Only ACTIVE Titles may be selected...",!
+6 ; Bid for LOCK
+7 LOCK +^TIU(8925.1,TIUDA,15):1
+8 IF '$TEST
Begin DoDot:1
+9 WRITE !,$CHAR(7),"Another user is mapping this title...",!
+10 if $$READ^TIUU("E")
WRITE ""
if +$GET(DIRUT)
SET TIUOUT=1
End DoDot:1
QUIT
+11 ; First, check whether the LOCAL Title is already mapped
+12 IF +$GET(^TIU(8925.1,+TIUDA,15))
Begin DoDot:1
+13 NEW TIUY
SET TIUY=0
+14 WRITE !?5,"The LOCAL Title: ",TIULOCAL,!?7,"is already mapped to",!,"VHA Enterprise Title: ",$$LOINCNM^TIUMAP(+$GET(^(15))),!
+15 SET TIUY=$$READ^TIUU("YA","Do you want to RE-MAP it? ","NO")
+16 IF +TIUY'>0
WRITE $CHAR(7),!,"... OK, No Harm Done!",!
SET RESULT=-1
HANG 2
+17 IF '$TEST
SET RESULT=1
WRITE !
End DoDot:1
if RESULT<0!+$GET(DIRUT)
QUIT
+18 FOR
Begin DoDot:1
+19 NEW DIC
SET DIC=8926.1
SET DIC(0)="AEMQ"
SET DIC("A")="Select VHA ENTERPRISE STANDARD TITLE: "
+20 SET DIC("S")="I '$$SCREEN^XTID(8926.1,"""",+Y_"","")"
+21 SET TIUY=$$ASK^TIUMAP1("",.DIC)
IF +TIUY>0
SET TIUCONT=0
QUIT
+22 WRITE !!,"You didn't select a VHA Enterprise Standard Title...",!
+23 SET TIUCONT=$$READ^TIUU("Y","... Try to map "_TIULOCAL_" again","NO")
WRITE !
+24 if +TIUCONT'>0
DO LOG^TIUMAP1(TIULOCAL,TIUDA)
+25 if +$GET(DIRUT)
SET TIUOUT=1
End DoDot:1
if +TIUCONT'>0
QUIT
+26 if +TIUY'>0!+$GET(DIRUT)
QUIT
+27 SET RESULT=+TIUY
SET RESULT(1)=TIUY_U_TIULOCAL
+28 DO CONFIRM^TIUMAP1(.RESULT,"Yes")
+29 IF +RESULT'>0!+$GET(DIRUT)
DO LOG^TIUMAP1(TIULOCAL,TIUDA)
QUIT
+30 DO POINT^TIUMAP(TIUDA,.RESULT)
+31 QUIT
