- 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 Feb 19, 2025@00:09:02 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