- 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 Feb 19, 2025@00:09:01 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