source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUMAP2.m@ 901

Last change on this file since 901 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1TIUMAP2 ; ISL/JER - TIU/VHA Enterprise Document Type Ontology Mapper ;10/20/06 09:28
2 ;;1.0;TEXT INTEGRATION UTILITIES;**211**;Jun 20, 1997;Build 26
3STRIP(TEXT) ; Remove punctuation & excess white space
4 N TIUTI,TIUX
5 ; Strip punctuation
6 S TEXT=$TR(TEXT,".,!?/|{}[];:=+*^%$#@~`""><"," ")
7 ; Remove TABS
8 F TIUTI=1:1:$L(TEXT) S:$A(TEXT,TIUTI)=9 TEXT=$E(TEXT,1,(TIUTI-1))_" "_$E(TEXT,(TIUTI+1),$L(TEXT))
9 ; Remove multiple white space
10 S TIUX="" F TIUTI=1:1:$L(TEXT," ") S:$A($P(TEXT," ",TIUTI))>0 TIUX=TIUX_$S(TIUTI=1:"",1:" ")_$P(TEXT," ",TIUTI)
11 S TEXT=TIUX S:$P(TEXT," ")']"" TEXT=$P(TEXT," ",2,$L(TEXT," "))
12 Q TEXT
13PAGE(TIULOCAL) ; Handle pagination
14 N TIUY S TIUY=1
15 Q:$Y'>(IOSL-4) TIUY
16 S TIUY=+$$READ^TIUU("E") S:+$G(DIRUT) TIUOUT=1
17 I TIUY W @IOF W:$G(TIULOCAL)]"" "Remember, your LOCAL title is: ",$G(TIULOCAL)
18 Q TIUY
19INACT(TIUDA) ; Inactivate LOCAL title TIUDA
20 N DA,DR,DIE,TIUFPRIV S TIUFPRIV=1
21 W !!,"Inactivating ",$P($G(^TIU(8925.1,TIUDA,0)),U)
22 S DA=TIUDA,DR=".07///INACTIVE",DIE=8925.1 D ^DIE W ".",!
23 Q
24DIRECT(TIUDA) ; Direct Title Mapping action
25 N RESULT,TIUCONT,TIULOCAL,TIUY
26 I '+$G(TIUDA) W !,"You must specify a local title." Q
27 S TIUCONT=1,TIULOCAL=$P($G(^TIU(8925.1,TIUDA,0)),U)
28 W !!,"Direct Mapping to Enterprise Standard Title..."
29 W !,"Your LOCAL Title is: ",TIULOCAL,!!," NOTE: Only ACTIVE Titles may be selected...",!
30 ; Bid for LOCK
31 L +^TIU(8925.1,TIUDA,15):1
32 E D Q
33 . W !,$C(7),"Another user is mapping this title...",!
34 . W:$$READ^TIUU("E") "" S:+$G(DIRUT) TIUOUT=1
35 ; First, check whether the LOCAL Title is already mapped
36 I +$G(^TIU(8925.1,+TIUDA,15)) D Q:RESULT<0!+$G(DIRUT)
37 . N TIUY S TIUY=0
38 . W !?5,"The LOCAL Title: ",TIULOCAL,!?7,"is already mapped to",!,"VHA Enterprise Title: ",$$LOINCNM^TIUMAP(+$G(^(15))),!
39 . S TIUY=$$READ^TIUU("YA","Do you want to RE-MAP it? ","NO")
40 . I +TIUY'>0 W $C(7),!,"... OK, No Harm Done!",! S RESULT=-1 H 2
41 . E S RESULT=1 W !
42 F D Q:+TIUCONT'>0
43 . N DIC S DIC=8926.1,DIC(0)="AEMQ",DIC("A")="Select VHA ENTERPRISE STANDARD TITLE: "
44 . S DIC("S")="I '$$SCREEN^XTID(8926.1,"""",+Y_"","")"
45 . S TIUY=$$ASK^TIUMAP1("",.DIC) I +TIUY>0 S TIUCONT=0 Q
46 . W !!,"You didn't select a VHA Enterprise Standard Title...",!
47 . S TIUCONT=$$READ^TIUU("Y","... Try to map "_TIULOCAL_" again","NO") W !
48 . D:+TIUCONT'>0 LOG^TIUMAP1(TIULOCAL,TIUDA)
49 . S:+$G(DIRUT) TIUOUT=1
50 Q:+TIUY'>0!+$G(DIRUT)
51 S RESULT=+TIUY,RESULT(1)=TIUY_U_TIULOCAL
52 D CONFIRM^TIUMAP1(.RESULT,"Yes")
53 I +RESULT'>0!+$G(DIRUT) D LOG^TIUMAP1(TIULOCAL,TIUDA) Q
54 D POINT^TIUMAP(TIUDA,.RESULT)
55 Q
Note: See TracBrowser for help on using the repository browser.