source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUMAP.m@ 1765

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

initial load of FOIAVistA 6/30/08 version

File size: 8.2 KB
Line 
1TIUMAP ; ISL/JER - TIU/VHA Enterprise Document Type Ontology Mapper ; 04/18/07
2 ;;1.0;TEXT INTEGRATION UTILITIES;**211,225**;Jun 20, 1997;Build 13
3MAIN ; Main subroutine
4 N TIUOK,TIUMODE,TIULUSE,TIUHOUR,TIUNOW,TIUZR,TIUTOD,TIUBACK,TIUACT,TIUMAPT
5 N SALUT,GREET,PROGRESS,DIRUT,DUOUT,DTOUT,TIUOUT S TIUOUT=0
6 S ^XTMP("TIUMAP",0)=$$FMADD^XLFDT(DT,730)_U_DT,TIUNOW=$$NOW^XLFDT
7 S TIUHOUR=$E($P(TIUNOW,".",2),1,2)
8 S TIUTOD=$S(TIUHOUR'<17:"EVENING",TIUHOUR'<12:"AFTERNOON",1:"MORNING")
9 S TIUZR=$$NAME^TIULS($$PERSNAME^TIULC1(DUZ),"FIRST")
10 S TIULUSE=+$G(^XTMP("TIUMAP","USER",DUZ))
11 S TIUMAPT=+$$MAPTCNT,TIUACT=+$$ACTCNT
12 S PROGRESS(0)="So far, "_TIUMAPT_" of "_TIUACT_" Active Titles have been mapped!"
13 S PROGRESS(1)=$$PROGRESS(TIUMAPT,TIUACT)
14 S SALUT="Good "_TIUTOD_" "_TIUZR_"!"
15 S GREET=$S(+TIULUSE:"And WELCOME BACK for ANOTHER ride on the MTA!!!",1:"And WELCOME to your FIRST RIDE on the MTA!!!")
16 W @IOF,!!?9,"****************************************************************"
17 W !?9,"*",$$PAD(SALUT,"L"),SALUT,$$PAD(SALUT,"R"),"*"
18 W !?9,"*",$$PAD(GREET,"L"),GREET,$$PAD(GREET,"R"),"*"
19 I '+TIULUSE D
20 . W !?9,"* *"
21 . W !?9,"* This option will help you map your LOCAL TIU Titles to the *"
22 . W !?9,"* VHA Enterprise Document Type Ontology which VA is helping to *"
23 . W !?9,"* Develop as an International Normative Standard supporting *"
24 . W !?9,"* interchange of Clinical Documents. *"
25 I +TIUMAPT>0 D
26 . W !?9,"* *"
27 . W !?9,"*",$$PAD(PROGRESS(0),"L"),PROGRESS(0),$$PAD(PROGRESS(0),"R"),"*"
28 . W !?9,"*",$$PAD(PROGRESS(1),"L"),PROGRESS(1),$$PAD(PROGRESS(1),"R"),"*"
29 W !?9,"* *"
30 W !?9,"* In preparation for migration to the HDR, ALL LOCAL titles *"
31 W !?9,"* MUST be mapped to Standard Titles BEFORE transmittal of TIU *"
32 W !?9,"* Documents to the HDR can begin. *"
33 W !?9,"* *"
34 W !?9,"* You may quit mapping titles at any time, and continue your *"
35 W !?9,"* work from the last successfully mapped title. The only *"
36 W !?9,"* catch is that any ACTIVE LOCAL Titles that are not mapped *"
37 W !?9,"* when transmission to the HDR is initiated will be *"
38 W !?9,"* INACTIVATED, so please finish this process expeditiously... *"
39 W !?9,"****************************************************************",!
40 S TIUOK=$$READ^TIUU("Y"," ... Are you READY to map","NO") Q:$D(DIRUT)
41 I +TIUOK'>0 W !!?9,$C(7),"... Very well, no damage done!" Q
42 S ^XTMP("TIUMAP","USER",DUZ)=TIUNOW
43 D LOOP
44 Q
45PROGRESS(MAPPED,ACTIVE) ; Figure out progress
46 N TIUI,TIUY,BR,BRSIZE S TIUY="You're at Kendall Square Station..."
47 S BRSIZE=ACTIVE/17,BR=MAPPED\BRSIZE+1
48 S TIUY=$P($T(STOPS+BR),";",3)
49 Q TIUY
50STOPS ; Get the stops
51 ;;You're at Kendall Square Station...Hand in your dime!
52 ;;You're at Charles Circle/MGH...
53 ;;You're at Park Street Station, changing for Jamaica Plain...
54 ;;You're at Boyleston Street Station...
55 ;;You're at Arlington Station...
56 ;;You're at Copley Station...
57 ;;You're at Prudential Station...
58 ;;You're at Symphony Station...
59 ;;You're at Northeastern University Station...
60 ;;You're at Museum of Fine Arts Station...
61 ;;You're at Longwood Medical Area Station...
62 ;;You're at Brigham Circle Station...
63 ;;You're at Fenwood Street Station...
64 ;;You're at Mission Park Station...
65 ;;You're at Riverway Station...
66 ;;You're at Back of the Hill Station...
67 ;;You're at Heath Street Station..."One more nickel."
68 ;;Wuzzat? NO NICKEL?! Then you'll NEVER return! Ah-HA-Ha-ha!!!
69 Q
70PAD(MESSAGE,SIDE) ; Compute pad for message
71 N LEN,PAD
72 S LEN=(64-$L(MESSAGE))\2
73 I $L(MESSAGE)#2,SIDE="R" S LEN=LEN+1
74 S $P(PAD," ",LEN)=""
75 Q PAD
76LOOP ; Loop sequentially through titles
77 N TIUDA,TIUOUT W @IOF
78 S TIUDA=+$G(^XTMP("TIUMAP","CHKPNT"))
79 F S TIUDA=$O(^TIU(8925.1,"AT","DOC",TIUDA)) Q:TIUDA'>0 D Q:+$G(DIROUT)!+$G(TIUOUT)
80 . N TIUD0,TIUNM,TIUTYP,DIRUT
81 . Q:+$G(^TIU(8925.1,TIUDA,15)) ; If already mapped, continue to next
82 . S TIUD0=$G(^TIU(8925.1,TIUDA,0)),TIUTYP=$P(TIUD0,U,4)
83 . ; Don't process non-title type document definitions
84 . Q:TIUTYP'="DOC"
85 . Q:+$P(TIUD0,U,7)'=11 ; Only require mapping of ACTIVE local titles
86 . S TIUNM=$$STRIP^TIUMAP2($P(TIUD0,U))
87 . L +^TIU(8925.1,TIUDA,15):1
88 . E Q ; If lock request fails, continue to next title
89 . W !,"For the LOCAL Title: ",TIUNM,!
90 . D MAP(TIUDA,TIUNM)
91 . L -^TIU(8925.1,TIUDA,15):1 ; Decrement lock
92 . Q:+$G(TIUOUT)
93 . I +$G(DIRUT) D Q
94 . . N DIRUT
95 . . W:$$READ^TIUU("E") "" S:+$G(DIRUT) TIUOUT=1
96 . S ^XTMP("TIUMAP","CHKPNT")=TIUDA
97 . S ^XTMP("TIUMAP","MAPCNT")=+$G(^XTMP("TIUMAP","MAPCNT"))+1
98 Q
99SINGLES ; Map specific INDIVIDUAL titles
100 N TIUDA,TIUOUT W @IOF
101 F S TIUDA=+$$LTTL D Q:TIUDA'>0!+$G(DIROUT)!+$G(TIUOUT)
102 . N TIUD0,TIUNM,TIUTYP,DIRUT
103 . S TIUD0=$G(^TIU(8925.1,TIUDA,0)),TIUTYP=$P(TIUD0,U,4)
104 . ; Don't process non-title type document definitions
105 . Q:TIUTYP'="DOC"
106 . S TIUNM=$$STRIP^TIUMAP2($P(TIUD0,U))
107 . Q:'$$PAGE^TIUMAP2(TIUNM) W !!,"For the LOCAL Title: ",TIUNM,!
108 . D MAP(TIUDA,TIUNM) Q:+$G(DIRUT)
109 Q
110LTTL() ; Call DIC to look-up title
111 N TIUDA,TIUNM,DIC,X,Y,DTOUT,DUOUT
112 S DIC=8925.1,DIC(0)="AEMQ",DIC("A")="Select TITLE: "
113 S DIC("S")="I $P(^(0),U,4)=""DOC"",($P(^(0),U,7)=11)"
114 D ^DIC K DIC("S") I $D(DTOUT)!$D(DUOUT) S DIRUT=1 S:X="^^" DIROUT=1
115 Q Y
116ACTCNT() ; Get count of active titles
117 N TIUI,TIUY,TIUT S (TIUI,TIUT,TIUY)=0
118 F S TIUI=$O(^TIU(8925.1,"AT","DOC",TIUI)) Q:+TIUI'>0 S TIUT=TIUT+1 I $$ACTIVE(TIUI) S TIUY=TIUY+1
119 Q TIUY_U_TIUT
120MAPTCNT() ; Get count of mapped titles
121 N TIUI,TIUY S (TIUI,TIUY)=0
122 F S TIUI=$O(^TIU(8925.1,"ALOINC",TIUI)) Q:+TIUI'>0 D
123 . N TIUJ S TIUJ=0
124 . F S TIUJ=$O(^TIU(8925.1,"ALOINC",TIUI,TIUJ)) Q:+TIUJ'>0 I $$ACTIVE(TIUJ) S TIUY=TIUY+1
125 I (+$G(^XTMP("TIUMAP","MAPCNT"))>0),(^("MAPCNT")'=TIUY) S ^("MAPCNT")=TIUY
126 Q TIUY
127ACTIVE(TIUDA) ; Is a given title active?
128 Q $P($G(^TIU(8925.1,TIUDA,0)),U,7)=11
129MAP(TIUDA,TIUNM) ; Map each LOCAL Title
130 N RESULT S RESULT=0
131 Q:'$$PAGE^TIUMAP2(TIUNM) W !,"Attempting to map ",TIUNM,!?2,"to a VHA Enterprise Standard Title...",!
132 ; Bid for LOCK
133 L +^TIU(8925.1,TIUDA,15):1
134 E D Q
135 . W !,$C(7),"Another user is mapping this title...",!
136 . W:$$READ^TIUU("E") "" S:+$G(DIRUT) TIUOUT=1
137 ; First, check whether the LOCAL Title is already mapped
138 I +$G(^TIU(8925.1,+TIUDA,15)) D Q:RESULT<0!+$G(DIRUT)
139 . N TIUY S TIUY=0
140 . W !?5,"The LOCAL Title: ",TIUNM,!?7,"is already mapped to",!,"VHA Enterprise Title: ",$$LOINCNM(+$G(^TIU(8925.1,+TIUDA,15))),!
141 . S TIUY=$$READ^TIUU("YA","Do you want to RE-MAP it? ","NO")
142 . I +TIUY'>0 W $C(7),!,"... OK, No Harm Done!",! S RESULT=-1
143 . E W !
144 ; Next, check for an exact match
145 S RESULT=+$O(^TIU(8926.1,"B",TIUNM,RESULT))
146 I RESULT D Q:+RESULT'>0!+$G(DIRUT) I 1
147 . Q:'$$PAGE^TIUMAP2(TIUNM) W !,"Found Exact Match with VHA Enterprise Standard Title: ",TIUNM,"."
148 . I $$SCREEN^XTID(8926.1,"",+RESULT_",") D Q:'+RESULT
149 . . N TIUACT
150 . . W !,"The corresponding VHA Enterprise Standard Title is INACTIVE."
151 . . W !,"You'll need to map ",TIUNM," manually to a different title,",!," or inactivate the local title.",!
152 . . S RESULT=0
153 . . S TIUACT=$$READ^TIUU("SA^M:map;I:inactivate","Select action: ","map") I +$G(DIRUT) S TIUOUT=1 Q
154 . . I $P(TIUACT,U)="I" D INACT^TIUMAP2(TIUDA) Q
155 . . I $P(TIUACT,U)="M" W !!,"Attempting to map ",TIUNM," to a different title...",! D PARSE^TIUMAP1(.RESULT,TIUNM)
156 . S RESULT(1)=RESULT_U_$P($G(^TIU(8926.1,+RESULT,0)),U)_U_TIUNM
157 . D CONFIRM^TIUMAP1(.RESULT,"Yes")
158 . I +RESULT'>0!+$G(DIRUT) D LOG^TIUMAP1(TIUNM,TIUDA)
159 ; Otherwise, parse the title, attempting to map each word
160 E D Q:+RESULT'>0!+$G(DIRUT)!+$G(TIUOUT)
161 . D PARSE^TIUMAP1(.RESULT,TIUNM)
162 . I RESULT>0,'+$G(DIRUT) D CONFIRM^TIUMAP1(.RESULT,"Yes")
163 . I +RESULT'>0!+$G(DIRUT) D LOG^TIUMAP1(TIUNM,TIUDA)
164 D POINT(TIUDA,.RESULT)
165 Q
166LOINCNM(TIULDA) ; Resolve name of VHA Enterprise Title
167 Q $P($G(^TIU(8926.1,+TIULDA,0)),U)
168POINT(DA,RESULT) ; Point the LOCAL Title entry in file #8925.1 at the VHA Enterprise Title
169 N DIE,DR S DIE="^TIU(8925.1,",DR="1501////^S X="_+RESULT_";1502////^S X="_$$NOW^XLFDT_";1503////^S X="_DUZ
170 D ^DIE W !?13,"Done.",!
171 ; Drop LOCK
172 L -^TIU(8925.1,DA,15):1
173 I $P($G(RESULT(1)),U,3)]"" K ^XTMP("TIUMAP","FAIL",$P($G(RESULT(1)),U,3),DA)
174 Q
Note: See TracBrowser for help on using the repository browser.