| 1 | TIUMAP ; 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
|
|---|
| 3 | MAIN ; 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
|
|---|
| 45 | PROGRESS(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
|
|---|
| 50 | STOPS ; 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
|
|---|
| 70 | PAD(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
|
|---|
| 76 | LOOP ; 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
|
|---|
| 99 | SINGLES ; 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
|
|---|
| 110 | LTTL() ; 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
|
|---|
| 116 | ACTCNT() ; 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
|
|---|
| 120 | MAPTCNT() ; 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
|
|---|
| 127 | ACTIVE(TIUDA) ; Is a given title active?
|
|---|
| 128 | Q $P($G(^TIU(8925.1,TIUDA,0)),U,7)=11
|
|---|
| 129 | MAP(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
|
|---|
| 166 | LOINCNM(TIULDA) ; Resolve name of VHA Enterprise Title
|
|---|
| 167 | Q $P($G(^TIU(8926.1,+TIULDA,0)),U)
|
|---|
| 168 | POINT(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
|
|---|
