TIUMAPR.m

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 ---TIUMAPR   1503     printed  Apr 09, 2024@21:43:40                                                                                                                                                                                                     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