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

BLRKIDS2.m

Go to the documentation of this file. 
  1. BLRKIDS2 ; IHS/OIT/MKK - IHS Lab KIDS utilities, part 2 ; 20-May-2016 07:03 ; MKK
  1.  ;;5.2;LR;**1035,1039**;Nov 1, 1997;Build 38
  1.  ;
  1. EEP ; EP - Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1.  ;
  1. BOKAY(MSG,TAB)       ; EP -- Write out Blank line, then "OKAY" message
  1.  ;    MSG = Message String
  1.  ;    TAB = Indent Amount
  1.  ;
  1.  D BMES^XPDUTL($J("",+$G(TAB))_MSG_" OK.")
  1.  Q
  1.  ;
  1.  ;
  1. ENVHEADR(CP,RPMSVER,RPMS) ; EP -- Environment Header
  1.  ;       CP = Patch Number to be installed
  1.  ;  RPMSVER = RPMS Version of Module (e.g.: for Lab, it's 5.2)
  1.  ;     RPMS = RPMS Module (i.e., LA, LR, etc.)
  1.  ;
  1.  NEW STARS,STR,TIMESTR
  1.  S STARS=$TR($J("",IOM)," ","*")
  1.  ;
  1.  S STR="@Checking@Environment@for@Patch@"
  1.  S STR=STR_CP_"@of@Version@"
  1.  S STR=STR_RPMSVER_"@of@"
  1.  S STR=STR_$TR(RPMS," ","@")_".@"
  1.  ;
  1.  S TIMESTR=$TR($$CJ^XLFSTR("At "_$$UP^XLFSTR($$HTE^XLFDT($H,"5MPZ")),$L(STR))," ","@")
  1.  ;
  1.  D ^XBCLS
  1.  W STARS,!
  1.  W $TR($$CJ^XLFSTR(STR,IOM)," @","* "),!
  1.  W $TR($$CJ^XLFSTR(TIMESTR,IOM)," @","* "),!
  1.  W STARS,!
  1.  Q
  1.  ;
  1. ENVIVARS(CP,BLRVERN) ; EP - Setup the Environment variables
  1.  ;       CP = Patch Number to be installed
  1.  ;  BLRVERN = Current Routine Name
  1.  ;
  1.  S TODAY=$$DT^XLFDT
  1.  S WOTCNT=$$WOTCNT(BLRVERN)
  1.  S ROWSTARS=$TR($J("",65)," ","*")     ; Row of asterisks
  1.  ;
  1.  S ^XTMP(BLRVERN,0)=$$HTFM^XLFDT(+$H+90)_"^"_$$DT^XLFDT_"^IHS Lab Patch "_CPSTR
  1.  M ^XTMP(BLRVERN,TODAY,WOTCNT,"DUZ")=DUZ
  1.  S ^XTMP(BLRVERN,TODAY,WOTCNT,"BEGIN")=$$NOW^XLFDT
  1.  ;
  1.  S XUMF=1
  1.  ;
  1.  I $G(XPDNM)="" D SORRY(CP,"XPDNM not defined or 0.")  Q "Q"
  1.  ;
  1.  S RPMS=$P(XPDNM,"*",1)      ; RPMS Module
  1.  S RPMSVER=$P(XPDNM,"*",2)   ; RPMS Version
  1.  ;
  1.  I +$G(DUZ)<1 D SORRY(CP,"DUZ UNDEFINED OR 0.")  Q "Q"
  1.  I $$GET1^DIQ(200,DUZ,"NAME")="" D SORRY(CP,"Installer cannot be identified!")  Q "Q"
  1.  ;
  1.  S XPDNOQUE=1        ; No Queuing Allowed
  1.  ;
  1.  ; The following line prevents the "Disable Options..." and "Move
  1.  ; Routines..." questions from being asked during the install.
  1.  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0,XPDDIQ(X,"B")="NO"
  1.  ;
  1.  S XPDABORT=0        ; KIDS install Flag
  1.  ;
  1.  D HOME^%ZIS         ; Reset/Initialize IO variables
  1.  D DTNOLF^DICRW      ; Set DT variable without a Line Feed
  1.  ;
  1.  Q "OK"
  1.  ;
  1.  ;
  1. BLANK ; EP - Blank Line using XPDUTL
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. NLBLANK ; EP - Newline, then Blank Line using XPDUTL
  1.  D BMES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. TABLINE(LINE,TAB) ; EP - Use XPDUTL to display line, tabbed over TAB spaces.  Default 5 spaces.
  1.  S TAB=$G(TAB,5)
  1.  D MES^XPDUTL($J("",TAB)_LINE)
  1.  Q
  1.  ;
  1. NTABLINE(LINE,TAB) ; EP - Newline, then use XPDUTL to display line, tabbed over TAB spaces.  Default 5 spaces.
  1.  S TAB=$G(TAB,5)
  1.  D BMES^XPDUTL($J("",TAB)_LINE)
  1.  Q
  1.  ;
  1. MESCNTR(STR) ; EP - Center a line and use XPDUTL to display it
  1.  D MES^XPDUTL($$CJ^XLFSTR(STR,IOM))
  1.  Q
  1.  ;
  1. NMESCNTR(STR) ; EP - Newline, then Center a line and use XPDUTL to display it
  1.  D MES^XPDUTL($$CJ^XLFSTR(STR,IOM))
  1.  Q
  1.  ;
  1.  ;
  1. WOTCNT(BLRVERN) ; EP - Counter for ^XTMP
  1.  ;     BLRVERN = Current Routine Name
  1.  ;
  1.  NEW CNT,TODAY
  1.  ;
  1.  S TODAY=$$DT^XLFDT
  1.  ;
  1.  S CNT=1+$G(^XTMP(BLRVERN,0,TODAY))
  1.  S ^XTMP(BLRVERN,0,TODAY)=CNT
  1.  Q $TR($J(CNT,3)," ","0")
  1.  ;
  1.  ;
  1. NOSNAPS(QUIET) ; EP - Make certain TAKE SNAPSHOTS field in BLR MASTER CONTROL file is OFF
  1.  ;      QUIET = Boolean.  If YES (1), then do NOT print any information.
  1.  ;                        If NO (0), then do print information.
  1.  NEW CNT,DESC,FDA,IEN
  1.  ;
  1.  S (CNT,IEN)=0
  1.  F  S IEN=$O(^BLRSITE(IEN))  Q:IEN<1  D
  1.  . Q:+$$GET1^DIQ(9009029,IEN,"TAKE SNAPSHOTS","I")<1
  1.  . ;
  1.  . S CNT=CNT+1,CNT(IEN)=""
  1.  . K FDA
  1.  . S FDA(9009029,IEN_",",1)=0
  1.  . D FILE^DIE(,"FDA","ERRS")
  1.  ;
  1.  Q:CNT<1   ; If no update, just return
  1.  Q:+$G(QUIET)      ; If QUIET is true, just return
  1.  ;
  1.  D BMES^XPDUTL("File 9009029 'TAKE SNAPSHOTS' Field Set to OFF for the following:")
  1.  S IEN=0
  1.  F  S IEN=$O(CNT(IEN))  Q:IEN<1  D TABMENU^BLRKIDSU($$GET1^DIQ(9009029,IEN,.01),5)
  1.  D BMES^XPDUTL
  1.  Q
  1.  ;
  1.  ; Generic "Find RPMS Module's Version and (perhaps) Patch number"
  1.  ; The MODULE variable MUST be the PREFIX name from the PACKAGE file (9.4).
  1. NEEDIT(CP,MODULE,VERSION,PATCH,ERRARRAY)      ; EP
  1.  ;           CP = Patch Number to be installed
  1.  ;       MODULE = RPMS Module (i.e., LA, LR, etc.)
  1.  ;      VERSION = RPMS Version of Module (e.g.: for Lab, it's 5.2)
  1.  ;        PATCH = Patch Number to Check
  1.  ;     ERRARRAY = Error Array.  Pass by Reference.
  1.  ;
  1.  NEW NAME                    ; NAME of PACKAGE
  1.  NEW PTR                     ; PoinTeR to PACKAGE file
  1.  NEW HEREYAGO,STR1,STR2      ; Scratch variables/arrays
  1.  NEW SYSVER,SYSPATCH         ; System Version & System Patch variables
  1.  NEW NAMEVER,NAMESYS
  1.  ;
  1.  D FIND^DIC(9.4,"",,,MODULE,,"C",,,"HEREYAGO")
  1.  S PTR=$G(HEREYAGO("DILIST",2,1))
  1.  S NAME=$G(HEREYAGO("DILIST",1,1))
  1.  ;
  1.  S SYSVER=+$$VERSION^XPDUTL(MODULE)    ; Get Current Version #
  1.  ;
  1.  S NAMEVER=NAME_" "_VERSION,NAMESYS=NAME_" "_SYSVER
  1.  ;
  1.  ; If Current Version < Needed Version, write message and quit
  1.  I SYSVER<VERSION D  Q
  1.  . S ERRARRAY(MODULE,NAME,VERSION)=SYSVER_"^VERSION"
  1.  . D:SYSVER>0 NEEDMSG("Need "_NAMEVER_" & "_NAMESYS_" found!")
  1.  . D:SYSVER<1 NEEDMSG("Need "_MODULE_" & "_MODULE_" Not Installed!")
  1.  ;
  1.  ; If System Version > Needed Version, write message and quit
  1.  I VERSION<SYSVER D OKAY^BLRKIDSU("Need "_NAMEVER_" & "_NAMESYS_" found.",5)  Q
  1.  ;
  1.  I $G(PATCH)="" D  Q   ; If no Patch check, write message and quit
  1.  . D OKAY^BLRKIDSU(NAMEVER_" found.",5)
  1.  ;
  1.  S SYSPATCH=$$PATCH^XPDUTL(MODULE_"*"_VERSION_"*"_PATCH)
  1.  I SYSPATCH'=1 D  Q
  1.  . S ERRARRAY(MODULE,NAME,VERSION)=$G(PATCH)_"^PATCH"
  1.  . D NEEDMSG(NAMEVER_" ("_MODULE_") & Patch "_PATCH_" WAS NOT installed!")
  1.  ;
  1.  D OKAY^BLRKIDSU(NAMEVER_" Patch "_PATCH_" found.",5)
  1.  ;
  1.  Q
  1.  ;
  1. PASSMESG(WOT) ; EP -- Splash message
  1.  ;       WOT = String to display    
  1.  ;
  1.  NEW CRTLINE,MAXIT,AROUND
  1.  ;
  1.  F CRTLINE=1:1:20 W $J("",80),!
  1.  D EN^XBVIDEO("HOM")
  1.  S MAXIT="@"
  1.  F J=1:1:$L(WOT) S MAXIT=MAXIT_$E(WOT,J,J)_"@"
  1.  S AROUND=$TR($J("",8+$L(MAXIT))," ","@")
  1.  S MAXIT="@@!!"_$TR(MAXIT," ","@")_"!!@@"
  1.  ;
  1.  W !!
  1.  W $TR($J("",IOM)," ","*"),!
  1.  W $TR($J("",IOM)," ","*"),!
  1.  W $TR($$CJ^XLFSTR(AROUND,IOM)," @","* "),!
  1.  W $TR($$CJ^XLFSTR(MAXIT,IOM)," @","* "),!
  1.  W $TR($$CJ^XLFSTR(AROUND,IOM)," @","* "),!
  1.  W $TR($J("",IOM)," ","*"),!
  1.  W $TR($J("",IOM)," ","*"),!
  1.  Q
  1.  ;
  1. NEEDMSG(MESSAGE) ; EP
  1.  ;      MESSAGE = String to display    
  1.  ;
  1.  NEW STR1,STR2
  1.  ;
  1.  S STR1=MESSAGE
  1.  I $L(STR1)<58 D SORRY(CP,STR1)  Q
  1.  ;
  1.  S STR1=$P(MESSAGE,"&")_" &"
  1.  S STR2=$$TRIM^XLFSTR($P(MESSAGE,"&",2),"L"," ")
  1.  D SORRY(CP,STR1,,STR2)
  1.  Q
  1.  ;
  1.  ; Error Message routine.
  1. SORRY(CP,MSG,MODE,MSG2)    ; EP
  1.  ;       CP = Patch Number to be installed
  1.  ;      MSG = String to display
  1.  ;     MODE = Type of message.  FATAL or WARNING.
  1.  ;     MSG2 = Additional Line of Message. (If Needed.)
  1.  ;
  1.  NEW MESSAGE,ROWSTARS
  1.  ;
  1.  S ROWSTARS=$TR($J("",65)," ","*")     ; Row of asterisks
  1.  ;
  1.  S MODE=$G(MODE,"FATAL")
  1.  ;
  1.  I $G(MODE)="FATAL" D
  1.  . S MESSAGE="Install Aborting due to the following Systems Environment issue:"
  1.  . S XPDABORT=1    ; Fatal Error Flag Set
  1.  ;
  1.  I $G(MODE)["NONFATAL" S MESSAGE="*** WARNING *** WARNING *** WARNING ***"
  1.  ;
  1.  K DIFQ
  1.  ;
  1.  ; STR Array will be used to write to the screen, send E-Mail & Alert
  1.  NEW STR,LINECNT,MODESTR
  1.  S LINECNT=1
  1.  D ADDLINE(.LINECNT)
  1.  D ADDLINE(.LINECNT,ROWSTARS)
  1.  D ADDLINE(.LINECNT)
  1.  D ADDLINE(.LINECNT,"Site: "_$$LOC^XBFUNC,"YES")
  1.  D ADDLINE(.LINECNT)
  1.  D ADDLINE(.LINECNT,MESSAGE,"YES")
  1.  D ADDLINE(.LINECNT)
  1.  D BANNERL(.LINECNT,MSG)
  1.  D:$D(MSG2) BANNERL(.LINECNT,MSG2)
  1.  D ADDLINE(.LINECNT)
  1.  ;
  1.  I $G(MODE)["NONFATAL" D ADDLINE(.LINECNT,MESSAGE,"YES")
  1.  ;
  1.  I $G(MODE)="FATAL" D
  1.  . D ADDLINE(.LINECNT,"Please print/capture this screen and","YES")
  1.  . D ADDLINE(.LINECNT,"notify the Support Center at","YES")
  1.  . D ADDLINE(.LINECNT)
  1.  . D ADDLINE(.LINECNT,"1-888-830-7280.","YES")
  1.  . D ADDLINE(.LINECNT)
  1.   ;
  1.  D ADDLINE(.LINECNT,ROWSTARS)
  1.  D ADDLINE(.LINECNT)
  1.  ;
  1.  D BMES^XPDUTL(.STR)
  1.  ;
  1.  I $G(DEBUG)="YES" Q
  1.  ;
  1.  D MAILALMI^BLRUTIL3("IHS Lab Patch "_CP_" Install "_MODE_" Error",.STR,"Laboratory Patch "_CP)
  1.  Q
  1.  ;
  1. ADDLINE(LC,ASTR,CENTER) ; EP -- Add a line to the STR array; CENTER if requested
  1.  ;      LC = Line Counter.  Pass by Reference.
  1.  ;    ASTR = String to Add to STR array
  1.  ;  CENTER = Boolean.  If YES, then Center ASTR, else don't.
  1.  ; 
  1.  I $G(ASTR)="" S ASTR=" "
  1.  S STR(LC)=$S($G(CENTER)="YES":$$CJ^XLFSTR(ASTR,65),1:$G(ASTR))
  1.  S LC=LC+1
  1.  Q
  1.  ;
  1. BANNERL(LC,ASTR) ; EP -- Stores "Banner" Line in STR array
  1.  ;      LC = Line Counter.  Pass by Reference.
  1.  ;    ASTR = String to Add to STR array
  1.  ;
  1.  S STR(LC)=$$MKBANNRL(ASTR)
  1.  S LC=LC+1
  1.  Q
  1.  ;
  1. MKBANNRL(ASTR) ; EP - MaKe the BANNeR Line
  1.  ;       ASTR = String to Manipulate
  1.  ;
  1.  NEW HALFLEN,J,RM,STRLEN,TMPSTR
  1.  ;
  1.  S RM=65      ; Right Margin
  1.  ;
  1.  S HALFLEN=(RM\2)-(($L(ASTR)+2)\2)
  1.  S TMPSTR=$TR($J("",HALFLEN)," ",">")
  1.  S TMPSTR=TMPSTR_" "_ASTR_" "
  1.  S STRLEN=$L(TMPSTR)
  1.  F J=STRLEN:1:(RM-1) S TMPSTR=TMPSTR_"<"
  1.  Q TMPSTR
  1.  ;
  1. SORRYEND(WOTERR,CP) ; EP -- ALL the errors detected during the environment check.
  1.  ;       WOTERR = Error Array.  Pass by Reference.
  1.  ;           CP = Patch Number to be installed
  1.  ;
  1.  NEW STR,MODULE,NAME,VERSION,PATCH,LINECNT,TMP
  1.  ;
  1.  D SORRYHED
  1.  ;
  1.  S (MODULE,NAME,VERSION)=""
  1.  F  S MODULE=$O(WOTERR(MODULE))  Q:MODULE=""  D
  1.  . F  S NAME=$O(WOTERR(MODULE,NAME))  Q:NAME=""  D
  1.  .. F  S VERSION=$O(WOTERR(MODULE,NAME,VERSION))  Q:VERSION=""  D ADDMESG
  1.  ;
  1.  D SORRYFIN
  1.  ;
  1.  D BMES^XPDUTL(.STR)
  1.  ;
  1.  Q
  1.  ;
  1. SORRYHED ; EP -- "Header" of Final Fatal Message
  1.  S LINECNT=1
  1.  D ADDLINE(.LINECNT)
  1.  D ADDLINE(.LINECNT,ROWSTARS)
  1.  D ADDLINE(.LINECNT)
  1.  D ADDLINE(.LINECNT,"Systems Environment Error Detected","YES")
  1.  D ADDLINE(.LINECNT,"KIDS build will be deleted","YES")
  1.  D ADDLINE(.LINECNT)
  1.  D ADDLINE(.LINECNT,"Modules with Version or Patch errors","YES")
  1.  D ADDLINE(.LINECNT)
  1.  Q
  1.  ;
  1. ADDMESG ; EP
  1.  NEW WOT,WOTWRONG
  1.  ;
  1.  D ADDLINE(.LINECNT,NAME_" ("_MODULE_")","YES")
  1.  ;
  1.  S WOT=$G(WOTERR(MODULE,NAME,VERSION))
  1.  S TMP="Version:"_VERSION
  1.  S WOTWRONG=$P(WOT,"^",2)
  1.  ;
  1.  I WOTWRONG="VERSION" D
  1.  . S TMP="Needed Version:"_VERSION
  1.  . S TMP=TMP_"  Found Version:"_$P(WOT,"^")
  1.  ;
  1.  I WOTWRONG="PATCH" D
  1.  . S TMP=TMP_"  Needed Patch:"_$P(WOT,"^")
  1.  ;
  1.  I WOTWRONG'="PATCH"&(WOTWRONG'="VERSION") D
  1.  . D ADDLINE(.LINECNT,TMP,"YES")
  1.  . S TMP=WOT
  1.  ;
  1.  D ADDLINE(.LINECNT,TMP,"YES")
  1.  D ADDLINE(.LINECNT)
  1.  Q
  1.  ;
  1. SORRYFIN ; EP -- "Fin" of Final Fatal Message
  1.  D ADDLINE(.LINECNT,"Re-Installation will be necessary.","YES")
  1.  D ADDLINE(.LINECNT)
  1.  D ADDLINE(.LINECNT,"If assistance is needed, please call","YES")
  1.  D ADDLINE(.LINECNT,"1-888-830-7280.","YES")
  1.  D ADDLINE(.LINECNT)
  1.  D ADDLINE(.LINECNT,ROWSTARS)
  1.  D ADDLINE(.LINECNT)
  1.  Q
  1.  ;
  1.  ;
  1. DEBUG(PATCH,ROUTINE) ; EP - Debug Environment/Backup/Post Install sections of ROUTINE
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,PATCH,ROUTINE,U,XPARSYS,XQXFLG)
  1.  ;
  1.  ; ROUTINE **MUST** have the following line Labels:
  1.  ;     ENVICHEK - Environment Checking Section
  1.  ;       BACKUP - Backup Section
  1.  ;         POST - Post Install Section
  1.  ;
  1.  S (CP,PATCHNUM)=$P(PATCH,"*",3)
  1.  S CPSTR=PATCH
  1.  S BLRVERN=ROUTINE
  1.  S DEBUG=1      ; ROUTINE must handle DEBUG = 1
  1.  S XPDNM=PATCH
  1.  S XPDENV=0
  1.  S ROWPLUS=$TR($J("",IOM)," ","+")
  1.  ;
  1.  D ^XBCLS,PASSMESG^BLRKIDS2("DEBUG: ENVCHK Check")
  1.  ;
  1.  D @("ENVICHEK^"_ROUTINE)
  1.  ;
  1.  W !!,"DEBUG: ENVCHK^",ROUTINE," Completed."
  1.  W !!,ROWPLUS
  1.  D PRESSKEY^BLRGMENU
  1.  ;
  1.  D ^XBCLS,PASSMESG^BLRKIDS2("DEBUG: BACKUP Check.")
  1.  D @("BACKUP^"_ROUTINE)
  1.  W !!,"DEBUG: BACKUP^",ROUTINE," Completed."
  1.  W !!,ROWPLUS
  1.  D PRESSKEY^BLRGMENU
  1.  ;
  1.  D ^XBCLS,PASSMESG^BLRKIDS2("DEBUG: POST Check")
  1.  D @("POST^"_ROUTINE)
  1.  W !!,"DEBUG: POST^",ROUTINE," Completed."
  1.  W !!,ROWPLUS
  1.  D PRESSKEY^BLRGMENU
  1.  ;
  1.  D ^XBCLS,PASSMESG^BLRKIDS2("DEBUG: COMPLETED")
  1.  D PRESSKEY^BLRGMENU
  1.  Q
  1.  ;
  1. ADDOPTS(TOMENU,OPTION,SYNONYM,TAB) ; EP - Add new OPTION to TOMENU with SYNONYM synonym
  1.  Q:$$DEONARDY(TOMENU,OPTION,SYNONYM)
  1.  ;
  1.  ; Add it
  1.  ; S TAB=$J(" ",$G(TAB,5))
  1.  S TAB=$G(TAB,$J("",5))      ; IHS/MSC/MKK - LR*5.2*1039
  1.  S X="Adding '"_OPTION_"' option"
  1.  S:$D(SYNONYM) X=X_" with "_SYNONYM_" synonym"
  1.  S X=X_" to "_TOMENU_"."
  1.  D BMES^XPDUTL(X)
  1.  S X=$$ADD^XPDMENU(TOMENU,OPTION,SYNONYM)
  1.  ; D:X=1 BMES^XPDUTL(TAB_"'"_OPTION_"' added to "_TOMENU_". OK.")
  1.  D:X=1 MES^XPDUTL(TAB_"'"_OPTION_"' added to "_TOMENU_". OK.")  ; IHS/MSC/MKK - LR*5.2*1039
  1.  I X'=1 D
  1.  . ; D BMES^XPDUTL(TAB_"Error in adding '"_OPTION_"' option to "_TOMENU_".")
  1.  . D MES^XPDUTL(TAB_"Error in adding '"_OPTION_"' option to "_TOMENU_".")      ; IHS/MSC/MKK - LR*5.2*1039
  1.  . D MES^XPDUTL(TAB_TAB_"Error Message: "_$$UP^XLFSTR($P(X,"^",2)))
  1.  ;
  1.  ; D MES^XPDUTL("")     ; IHS/MSC/MKK - LR*5.2*1039
  1.  Q
  1.  ;
  1. DEONARDY(TOMENU,OPTION,SYNONYM) ; EP - Checks Options
  1.  ; Returns 1 if TOMENU doesn't exist OR
  1.  ;           if OPTION doesn't exist OR
  1.  ;           if OPTION already on TOMENU with SYNONYM
  1.  ;
  1.  NEW OPTIEN,SYNIEN,TOIEN
  1.  S TOIEN=$$LKOPT^XPDMENU(TOMENU)
  1.  Q:TOIEN<1 1       ; Return 1 if TOMENU doesn't exist
  1.  ;
  1.  S OPTIEN=$$LKOPT^XPDMENU(OPTION)
  1.  Q:OPTIEN<1 1      ; Return 1 if OPTION doesn't exist
  1.  ;
  1.  S SYNIEN=+$O(^DIC(19,TOIEN,10,"C",$G(SYNONYM),0))
  1.  ; Q $S($G(^DIC(19,TOIEN,10,SYNIEN,0))=OPTIEN:1,1:0)
  1.  ; Return 1 if SYNONYM already on option
  1.  Q $S(+$G(^DIC(19,TOIEN,10,SYNIEN,0))=OPTIEN:1,1:0)   ; IHS/MSC/MKK - LR*5.2*1039
  1.  ;
  1.  ;
  1. INACTOPT(SEED,OUTMSG,EXCPTION) ; EP - Inactivate/Activate options.
  1.  ; If the OUTMSG variable is NOT NULL, then the the OUT^XPDMENU routine
  1.  ; will put the string into the OUT OF ORDER MESSAGE field of the options.
  1.  ;
  1.  ; If the OUTMSG variable is NULL, then the OUT^XPDMENU routine will 
  1.  ; remove any text from the OUT OF ORDER field of the options.
  1.  ;
  1.  NEW OPTION,SEEDLEN
  1.  ;
  1.  S OPTION=SEED,SEEDLEN=$L(SEED)
  1.  F  S OPTION=$O(^DIC(19,"B",OPTION))  Q:OPTION=""!($E(OPTION,1,SEEDLEN)'=SEED)  D
  1.  . Q:OPTION=$G(EXCPTION)     ; Exception: Do not modify this option.
  1.  . Q:$D(EXCPTION(OPTION))    ; If EXCPTION is an array, Do not modify if option is in the array. 
  1.  . ;
  1.  . D OUT^XPDMENU(OPTION,$G(OUTMSG))
  1.  Q