TIUMAPR ; SLC/JER - Title Mapping Review Screen Actions ;7/6/06 12:20
;;1.0;TEXT INTEGRATION UTILITIES;**211**;Jun 20, 1997;Build 26
MAP ; Map one or more Local TIU Titles to VHA Enterprise Standard Titles
N TIUDA,TIUDATA,TIUI,DIROUT,TIUDI,TIUOUT
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N VALMY,LINE,DIRUT
. S TIUDATA=$G(^TMP("TIUMLISTIDX",$J,TIUI))
. W !!,"Mapping Title #",TIUI
. S TIUDA=+$P(TIUDATA,U,2)
. D FULL^VALM1,MAP^TIUMAP(TIUDA,$P(TIUDATA,U,3))
. D SETLSTEL^TIUMLIST(TIUDA,TIUI)
. S LINE=+$O(@VALMAR@("PICK",TIUI,0))
. D RESTORE^TIULM(LINE),CNTRL^VALM10(LINE,6,VALM("RM"),IOINHI,IOINORM)
. D CNTRL^VALM10(LINE+1,6,VALM("RM"),IOINHI,IOINORM)
W !,"Refreshing the list."
; Need to poke in update
K VALMY S:'$D(VALMBCK) VALMBCK="R"
Q
DIRECT ; Direct mapping without assistance
N TIUDA,TIUDATA,TIUI,DIROUT,TIUDI,TIUOUT
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N VALMY,LINE,DIRUT
. S TIUDATA=$G(^TMP("TIUMLISTIDX",$J,TIUI))
. W !!,"Mapping Title #",TIUI
. S TIUDA=+$P(TIUDATA,U,2)
. D FULL^VALM1,DIRECT^TIUMAP2(TIUDA)
. D SETLSTEL^TIUMLIST(TIUDA,TIUI)
. S LINE=+$O(@VALMAR@("PICK",TIUI,0))
. D RESTORE^TIULM(LINE),CNTRL^VALM10(LINE,6,VALM("RM"),IOINHI,IOINORM)
. D CNTRL^VALM10(LINE+1,6,VALM("RM"),IOINHI,IOINORM)
W !,"Refreshing the list."
; Need to poke in update
K VALMY S:'$D(VALMBCK) VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUMAPR 1503 printed Oct 16, 2024@18:43:10 Page 2
TIUMAPR ; SLC/JER - Title Mapping Review Screen Actions ;7/6/06 12:20
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**211**;Jun 20, 1997;Build 26
MAP ; Map one or more Local TIU Titles to VHA Enterprise Standard Titles
+1 NEW TIUDA,TIUDATA,TIUI,DIROUT,TIUDI,TIUOUT
+2 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+3 SET TIUI=0
+4 FOR
SET TIUI=$ORDER(VALMY(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+5 NEW VALMY,LINE,DIRUT
+6 SET TIUDATA=$GET(^TMP("TIUMLISTIDX",$JOB,TIUI))
+7 WRITE !!,"Mapping Title #",TIUI
+8 SET TIUDA=+$PIECE(TIUDATA,U,2)
+9 DO FULL^VALM1
DO MAP^TIUMAP(TIUDA,$PIECE(TIUDATA,U,3))
+10 DO SETLSTEL^TIUMLIST(TIUDA,TIUI)
+11 SET LINE=+$ORDER(@VALMAR@("PICK",TIUI,0))
+12 DO RESTORE^TIULM(LINE)
DO CNTRL^VALM10(LINE,6,VALM("RM"),IOINHI,IOINORM)
+13 DO CNTRL^VALM10(LINE+1,6,VALM("RM"),IOINHI,IOINORM)
End DoDot:1
if $DATA(DIROUT)
QUIT
+14 WRITE !,"Refreshing the list."
+15 ; Need to poke in update
+16 KILL VALMY
if '$DATA(VALMBCK)
SET VALMBCK="R"
+17 QUIT
DIRECT ; Direct mapping without assistance
+1 NEW TIUDA,TIUDATA,TIUI,DIROUT,TIUDI,TIUOUT
+2 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+3 SET TIUI=0
+4 FOR
SET TIUI=$ORDER(VALMY(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+5 NEW VALMY,LINE,DIRUT
+6 SET TIUDATA=$GET(^TMP("TIUMLISTIDX",$JOB,TIUI))
+7 WRITE !!,"Mapping Title #",TIUI
+8 SET TIUDA=+$PIECE(TIUDATA,U,2)
+9 DO FULL^VALM1
DO DIRECT^TIUMAP2(TIUDA)
+10 DO SETLSTEL^TIUMLIST(TIUDA,TIUI)
+11 SET LINE=+$ORDER(@VALMAR@("PICK",TIUI,0))
+12 DO RESTORE^TIULM(LINE)
DO CNTRL^VALM10(LINE,6,VALM("RM"),IOINHI,IOINORM)
+13 DO CNTRL^VALM10(LINE+1,6,VALM("RM"),IOINHI,IOINORM)
End DoDot:1
if $DATA(DIROUT)
QUIT
+14 WRITE !,"Refreshing the list."
+15 ; Need to poke in update
+16 KILL VALMY
if '$DATA(VALMBCK)
SET VALMBCK="R"
+17 QUIT
