Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUMAP

TIUMAP.m

Go to the documentation of this file.
  1. TIUMAP ; ISL/JER - TIU/VHA Enterprise Document Type Ontology Mapper ; 04/18/07
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**211,225**;Jun 20, 1997;Build 13
  1. MAIN ; Main subroutine
  1. N TIUOK,TIUMODE,TIULUSE,TIUHOUR,TIUNOW,TIUZR,TIUTOD,TIUBACK,TIUACT,TIUMAPT
  1. N SALUT,GREET,PROGRESS,DIRUT,DUOUT,DTOUT,TIUOUT S TIUOUT=0
  1. S ^XTMP("TIUMAP",0)=$$FMADD^XLFDT(DT,730)_U_DT,TIUNOW=$$NOW^XLFDT
  1. S TIUHOUR=$E($P(TIUNOW,".",2),1,2)
  1. S TIUTOD=$S(TIUHOUR'<17:"EVENING",TIUHOUR'<12:"AFTERNOON",1:"MORNING")
  1. S TIUZR=$$NAME^TIULS($$PERSNAME^TIULC1(DUZ),"FIRST")
  1. S TIULUSE=+$G(^XTMP("TIUMAP","USER",DUZ))
  1. S TIUMAPT=+$$MAPTCNT,TIUACT=+$$ACTCNT
  1. S PROGRESS(0)="So far, "_TIUMAPT_" of "_TIUACT_" Active Titles have been mapped!"
  1. S PROGRESS(1)=$$PROGRESS(TIUMAPT,TIUACT)
  1. S SALUT="Good "_TIUTOD_" "_TIUZR_"!"
  1. S GREET=$S(+TIULUSE:"And WELCOME BACK for ANOTHER ride on the MTA!!!",1:"And WELCOME to your FIRST RIDE on the MTA!!!")
  1. W @IOF,!!?9,"****************************************************************"
  1. W !?9,"*",$$PAD(SALUT,"L"),SALUT,$$PAD(SALUT,"R"),"*"
  1. W !?9,"*",$$PAD(GREET,"L"),GREET,$$PAD(GREET,"R"),"*"
  1. I '+TIULUSE D
  1. . W !?9,"* *"
  1. . W !?9,"* This option will help you map your LOCAL TIU Titles to the *"
  1. . W !?9,"* VHA Enterprise Document Type Ontology which VA is helping to *"
  1. . W !?9,"* Develop as an International Normative Standard supporting *"
  1. . W !?9,"* interchange of Clinical Documents. *"
  1. I +TIUMAPT>0 D
  1. . W !?9,"* *"
  1. . W !?9,"*",$$PAD(PROGRESS(0),"L"),PROGRESS(0),$$PAD(PROGRESS(0),"R"),"*"
  1. . W !?9,"*",$$PAD(PROGRESS(1),"L"),PROGRESS(1),$$PAD(PROGRESS(1),"R"),"*"
  1. W !?9,"* *"
  1. W !?9,"* In preparation for migration to the HDR, ALL LOCAL titles *"
  1. W !?9,"* MUST be mapped to Standard Titles BEFORE transmittal of TIU *"
  1. W !?9,"* Documents to the HDR can begin. *"
  1. W !?9,"* *"
  1. W !?9,"* You may quit mapping titles at any time, and continue your *"
  1. W !?9,"* work from the last successfully mapped title. The only *"
  1. W !?9,"* catch is that any ACTIVE LOCAL Titles that are not mapped *"
  1. W !?9,"* when transmission to the HDR is initiated will be *"
  1. W !?9,"* INACTIVATED, so please finish this process expeditiously... *"
  1. W !?9,"****************************************************************",!
  1. S TIUOK=$$READ^TIUU("Y"," ... Are you READY to map","NO") Q:$D(DIRUT)
  1. I +TIUOK'>0 W !!?9,$C(7),"... Very well, no damage done!" Q
  1. S ^XTMP("TIUMAP","USER",DUZ)=TIUNOW
  1. D LOOP
  1. Q
  1. PROGRESS(MAPPED,ACTIVE) ; Figure out progress
  1. N TIUI,TIUY,BR,BRSIZE S TIUY="You're at Kendall Square Station..."
  1. S BRSIZE=ACTIVE/17,BR=MAPPED\BRSIZE+1
  1. S TIUY=$P($T(STOPS+BR),";",3)
  1. Q TIUY
  1. STOPS ; Get the stops
  1. ;;You're at Kendall Square Station...Hand in your dime!
  1. ;;You're at Charles Circle/MGH...
  1. ;;You're at Park Street Station, changing for Jamaica Plain...
  1. ;;You're at Boyleston Street Station...
  1. ;;You're at Arlington Station...
  1. ;;You're at Copley Station...
  1. ;;You're at Prudential Station...
  1. ;;You're at Symphony Station...
  1. ;;You're at Northeastern University Station...
  1. ;;You're at Museum of Fine Arts Station...
  1. ;;You're at Longwood Medical Area Station...
  1. ;;You're at Brigham Circle Station...
  1. ;;You're at Fenwood Street Station...
  1. ;;You're at Mission Park Station...
  1. ;;You're at Riverway Station...
  1. ;;You're at Back of the Hill Station...
  1. ;;You're at Heath Street Station..."One more nickel."
  1. ;;Wuzzat? NO NICKEL?! Then you'll NEVER return! Ah-HA-Ha-ha!!!
  1. Q
  1. PAD(MESSAGE,SIDE) ; Compute pad for message
  1. N LEN,PAD
  1. S LEN=(64-$L(MESSAGE))\2
  1. I $L(MESSAGE)#2,SIDE="R" S LEN=LEN+1
  1. S $P(PAD," ",LEN)=""
  1. Q PAD
  1. LOOP ; Loop sequentially through titles
  1. N TIUDA,TIUOUT W @IOF
  1. S TIUDA=+$G(^XTMP("TIUMAP","CHKPNT"))
  1. F S TIUDA=$O(^TIU(8925.1,"AT","DOC",TIUDA)) Q:TIUDA'>0 D Q:+$G(DIROUT)!+$G(TIUOUT)
  1. . N TIUD0,TIUNM,TIUTYP,DIRUT
  1. . Q:+$G(^TIU(8925.1,TIUDA,15)) ; If already mapped, continue to next
  1. . S TIUD0=$G(^TIU(8925.1,TIUDA,0)),TIUTYP=$P(TIUD0,U,4)
  1. . ; Don't process non-title type document definitions
  1. . Q:TIUTYP'="DOC"
  1. . Q:+$P(TIUD0,U,7)'=11 ; Only require mapping of ACTIVE local titles
  1. . S TIUNM=$$STRIP^TIUMAP2($P(TIUD0,U))
  1. . L +^TIU(8925.1,TIUDA,15):1
  1. . E Q ; If lock request fails, continue to next title
  1. . W !,"For the LOCAL Title: ",TIUNM,!
  1. . D MAP(TIUDA,TIUNM)
  1. . L -^TIU(8925.1,TIUDA,15):1 ; Decrement lock
  1. . Q:+$G(TIUOUT)
  1. . I +$G(DIRUT) D Q
  1. . . N DIRUT
  1. . . W:$$READ^TIUU("E") "" S:+$G(DIRUT) TIUOUT=1
  1. . S ^XTMP("TIUMAP","CHKPNT")=TIUDA
  1. . S ^XTMP("TIUMAP","MAPCNT")=+$G(^XTMP("TIUMAP","MAPCNT"))+1
  1. Q
  1. SINGLES ; Map specific INDIVIDUAL titles
  1. N TIUDA,TIUOUT W @IOF
  1. F S TIUDA=+$$LTTL D Q:TIUDA'>0!+$G(DIROUT)!+$G(TIUOUT)
  1. . N TIUD0,TIUNM,TIUTYP,DIRUT
  1. . S TIUD0=$G(^TIU(8925.1,TIUDA,0)),TIUTYP=$P(TIUD0,U,4)
  1. . ; Don't process non-title type document definitions
  1. . Q:TIUTYP'="DOC"
  1. . S TIUNM=$$STRIP^TIUMAP2($P(TIUD0,U))
  1. . Q:'$$PAGE^TIUMAP2(TIUNM) W !!,"For the LOCAL Title: ",TIUNM,!
  1. . D MAP(TIUDA,TIUNM) Q:+$G(DIRUT)
  1. Q
  1. LTTL() ; Call DIC to look-up title
  1. N TIUDA,TIUNM,DIC,X,Y,DTOUT,DUOUT
  1. S DIC=8925.1,DIC(0)="AEMQ",DIC("A")="Select TITLE: "
  1. S DIC("S")="I $P(^(0),U,4)=""DOC"",($P(^(0),U,7)=11)"
  1. D ^DIC K DIC("S") I $D(DTOUT)!$D(DUOUT) S DIRUT=1 S:X="^^" DIROUT=1
  1. Q Y
  1. ACTCNT() ; Get count of active titles
  1. N TIUI,TIUY,TIUT S (TIUI,TIUT,TIUY)=0
  1. F S TIUI=$O(^TIU(8925.1,"AT","DOC",TIUI)) Q:+TIUI'>0 S TIUT=TIUT+1 I $$ACTIVE(TIUI) S TIUY=TIUY+1
  1. Q TIUY_U_TIUT
  1. MAPTCNT() ; Get count of mapped titles
  1. N TIUI,TIUY S (TIUI,TIUY)=0
  1. F S TIUI=$O(^TIU(8925.1,"ALOINC",TIUI)) Q:+TIUI'>0 D
  1. . N TIUJ S TIUJ=0
  1. . F S TIUJ=$O(^TIU(8925.1,"ALOINC",TIUI,TIUJ)) Q:+TIUJ'>0 I $$ACTIVE(TIUJ) S TIUY=TIUY+1
  1. I (+$G(^XTMP("TIUMAP","MAPCNT"))>0),(^("MAPCNT")'=TIUY) S ^("MAPCNT")=TIUY
  1. Q TIUY
  1. ACTIVE(TIUDA) ; Is a given title active?
  1. Q $P($G(^TIU(8925.1,TIUDA,0)),U,7)=11
  1. MAP(TIUDA,TIUNM) ; Map each LOCAL Title
  1. N RESULT S RESULT=0
  1. Q:'$$PAGE^TIUMAP2(TIUNM) W !,"Attempting to map ",TIUNM,!?2,"to a VHA Enterprise Standard Title...",!
  1. ; Bid for LOCK
  1. L +^TIU(8925.1,TIUDA,15):1
  1. E D Q
  1. . W !,$C(7),"Another user is mapping this title...",!
  1. . W:$$READ^TIUU("E") "" S:+$G(DIRUT) TIUOUT=1
  1. ; First, check whether the LOCAL Title is already mapped
  1. I +$G(^TIU(8925.1,+TIUDA,15)) D Q:RESULT<0!+$G(DIRUT)
  1. . N TIUY S TIUY=0
  1. . W !?5,"The LOCAL Title: ",TIUNM,!?7,"is already mapped to",!,"VHA Enterprise Title: ",$$LOINCNM(+$G(^TIU(8925.1,+TIUDA,15))),!
  1. . S TIUY=$$READ^TIUU("YA","Do you want to RE-MAP it? ","NO")
  1. . I +TIUY'>0 W $C(7),!,"... OK, No Harm Done!",! S RESULT=-1
  1. . E W !
  1. ; Next, check for an exact match
  1. S RESULT=+$O(^TIU(8926.1,"B",TIUNM,RESULT))
  1. I RESULT D Q:+RESULT'>0!+$G(DIRUT) I 1
  1. . Q:'$$PAGE^TIUMAP2(TIUNM) W !,"Found Exact Match with VHA Enterprise Standard Title: ",TIUNM,"."
  1. . I $$SCREEN^XTID(8926.1,"",+RESULT_",") D Q:'+RESULT
  1. . . N TIUACT
  1. . . W !,"The corresponding VHA Enterprise Standard Title is INACTIVE."
  1. . . W !,"You'll need to map ",TIUNM," manually to a different title,",!," or inactivate the local title.",!
  1. . . S RESULT=0
  1. . . S TIUACT=$$READ^TIUU("SA^M:map;I:inactivate","Select action: ","map") I +$G(DIRUT) S TIUOUT=1 Q
  1. . . I $P(TIUACT,U)="I" D INACT^TIUMAP2(TIUDA) Q
  1. . . I $P(TIUACT,U)="M" W !!,"Attempting to map ",TIUNM," to a different title...",! D PARSE^TIUMAP1(.RESULT,TIUNM)
  1. . S RESULT(1)=RESULT_U_$P($G(^TIU(8926.1,+RESULT,0)),U)_U_TIUNM
  1. . D CONFIRM^TIUMAP1(.RESULT,"Yes")
  1. . I +RESULT'>0!+$G(DIRUT) D LOG^TIUMAP1(TIUNM,TIUDA)
  1. ; Otherwise, parse the title, attempting to map each word
  1. E D Q:+RESULT'>0!+$G(DIRUT)!+$G(TIUOUT)
  1. . D PARSE^TIUMAP1(.RESULT,TIUNM)
  1. . I RESULT>0,'+$G(DIRUT) D CONFIRM^TIUMAP1(.RESULT,"Yes")
  1. . I +RESULT'>0!+$G(DIRUT) D LOG^TIUMAP1(TIUNM,TIUDA)
  1. D POINT(TIUDA,.RESULT)
  1. Q
  1. LOINCNM(TIULDA) ; Resolve name of VHA Enterprise Title
  1. Q $P($G(^TIU(8926.1,+TIULDA,0)),U)
  1. POINT(DA,RESULT) ; Point the LOCAL Title entry in file #8925.1 at the VHA Enterprise Title
  1. N DIE,DR S DIE="^TIU(8925.1,",DR="1501////^S X="_+RESULT_";1502////^S X="_$$NOW^XLFDT_";1503////^S X="_DUZ
  1. D ^DIE W !?13,"Done.",!
  1. ; Drop LOCK
  1. L -^TIU(8925.1,DA,15):1
  1. I $P($G(RESULT(1)),U,3)]"" K ^XTMP("TIUMAP","FAIL",$P($G(RESULT(1)),U,3),DA)
  1. Q