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

TIUMAPR.m

Go to the documentation of this file.
  1. 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
  1. MAP ; Map one or more Local TIU Titles to VHA Enterprise Standard Titles
  1. N TIUDA,TIUDATA,TIUI,DIROUT,TIUDI,TIUOUT
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S TIUI=0
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . N VALMY,LINE,DIRUT
  1. . S TIUDATA=$G(^TMP("TIUMLISTIDX",$J,TIUI))
  1. . W !!,"Mapping Title #",TIUI
  1. . S TIUDA=+$P(TIUDATA,U,2)
  1. . D FULL^VALM1,MAP^TIUMAP(TIUDA,$P(TIUDATA,U,3))
  1. . D SETLSTEL^TIUMLIST(TIUDA,TIUI)
  1. . S LINE=+$O(@VALMAR@("PICK",TIUI,0))
  1. . D RESTORE^TIULM(LINE),CNTRL^VALM10(LINE,6,VALM("RM"),IOINHI,IOINORM)
  1. . D CNTRL^VALM10(LINE+1,6,VALM("RM"),IOINHI,IOINORM)
  1. W !,"Refreshing the list."
  1. ; Need to poke in update
  1. K VALMY S:'$D(VALMBCK) VALMBCK="R"
  1. Q
  1. DIRECT ; Direct mapping without assistance
  1. N TIUDA,TIUDATA,TIUI,DIROUT,TIUDI,TIUOUT
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S TIUI=0
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . N VALMY,LINE,DIRUT
  1. . S TIUDATA=$G(^TMP("TIUMLISTIDX",$J,TIUI))
  1. . W !!,"Mapping Title #",TIUI
  1. . S TIUDA=+$P(TIUDATA,U,2)
  1. . D FULL^VALM1,DIRECT^TIUMAP2(TIUDA)
  1. . D SETLSTEL^TIUMLIST(TIUDA,TIUI)
  1. . S LINE=+$O(@VALMAR@("PICK",TIUI,0))
  1. . D RESTORE^TIULM(LINE),CNTRL^VALM10(LINE,6,VALM("RM"),IOINHI,IOINORM)
  1. . D CNTRL^VALM10(LINE+1,6,VALM("RM"),IOINHI,IOINORM)
  1. W !,"Refreshing the list."
  1. ; Need to poke in update
  1. K VALMY S:'$D(VALMBCK) VALMBCK="R"
  1. Q