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

BLRUTIL7.m

Go to the documentation of this file. 
  1. BLRUTIL7 ;IHS/MSC/MKK - MISC IHS LAB UTILITIES (Cont) ; 13-Oct-2017 14:04 ;  MKK
  1.  ;;5.2;IHS LABORATORY;**1035,1041**;NOV 01, 1997;Build 23
  1.  ;
  1. EEP ; Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1. OVERFLOW(TEST) ; EP - Send ALERT and E-MAIL to LMI Mail Group due to Max # BLR Errors in Error Trap
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,TEST,U,XPARSYS,XQXFLG)
  1.  S MESSAGE="RPMS Lab to PCC Linker **HALTED**"
  1.  S FROMWHOM="Lab to PCC Linker"
  1.  S TAB=$J("",2),LINE=0
  1.  ;
  1.  D AROUNDIT(.MSGARRAY,.LINE,"RPMS LAB TO PCC LINKER HALTED",55)
  1.  ;
  1.  D ADDLINE(.MSGARRAY,.LINE)
  1.  D ADDLINE(.MSGARRAY,.LINE,TAB_"The RPMS Lab to PCC Linker has been *HALTED* by too")
  1.  D ADDLINE(.MSGARRAY,.LINE,TAB_"many BLR errors in the Error Trap.")
  1.  D ADDLINE(.MSGARRAY,.LINE)
  1.  D ADDLINE(.MSGARRAY,.LINE,TAB_"No Lab Data will be sent to PCC until this has been")
  1.  D ADDLINE(.MSGARRAY,.LINE,TAB_"resolved.")
  1.  ;
  1.  ; If TEST, then just display information to the screen and Quit.
  1.  I +$G(TEST)  D ^XBCLS  W "SUBJECT:",MESSAGE,!,"FROMWHOM:",FROMWHOM,!  D EN^DDIOL(.MSGARRAY)  W !!  Q
  1.  ;
  1.  ; Send ALERT and MailMan Message to LMI Mail Group.
  1.  D MAILALMI^BLRUTIL3(MESSAGE,.MSGARRAY,FROMWHOM,1)
  1.  Q
  1.  ;
  1. AROUNDIT(MSGARRAY,LINE,STR,MAX) ; EP - Create a "Box" Message in an Array
  1.  NEW AROUND,GAPSTARS,J,MAXIT,ROWSTARS
  1.  S MAXIT="@"
  1.  F J=1:1:$L(STR) S MAXIT=MAXIT_$E(STR,J,J)_"@"
  1.  S AROUND=$TR($J("",8+$L(MAXIT))," ","@")
  1.  S MAXIT="@@!!"_$TR(MAXIT," ","@")_"!!@@"
  1.  I $L(MAXIT)'<(MAX-4) D
  1.  . S AROUND=$TR($J("",10+$L(STR))," ","@")
  1.  . S MAXIT="@@!!@"_$TR(STR," ","@")_"@!!@@"
  1.  ;
  1.  S MAX=$G(MAX,IOM)
  1.  S ROWSTARS=$TR($J("",MAX)," ","*")
  1.  S GAPSTARS=$TR($$CJ^XLFSTR(AROUND,MAX)," @","* ")
  1.  D ADDLINE(.MSGARRAY,.LINE,ROWSTARS)
  1.  D ADDLINE(.MSGARRAY,.LINE,ROWSTARS)
  1.  D ADDLINE(.MSGARRAY,.LINE,GAPSTARS)
  1.  D ADDLINE(.MSGARRAY,.LINE,$TR($$CJ^XLFSTR(MAXIT,MAX)," @","* "))
  1.  D ADDLINE(.MSGARRAY,.LINE,GAPSTARS)
  1.  D ADDLINE(.MSGARRAY,.LINE,ROWSTARS)
  1.  D ADDLINE(.MSGARRAY,.LINE,ROWSTARS)
  1.  Q
  1.  ;
  1. ADDLINE(MSGARRAY,LINE,STR) ; EP - Add a String to a line in an ARRAY
  1.  S STR=$G(STR,$J("",5))
  1.  S LINE=1+$G(LINE),MSGARRAY(LINE)=STR
  1.  Q
  1.  ;
  1. LONGALRT(ALRTSUBJ,NOUSER,ALERTMSG,SPECIFIC) ; EP - Alert that includes full message
  1.  NEW (ALERTMSG,ALRTSUBJ,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,NOUSER,SPECIFIC,U,XPARSYS,XQXFLG)
  1.  ;
  1.  S XQAID="BLR"
  1.  S XQAMSG=ALRTSUBJ
  1.  M XQATEXT=ALERTMSG
  1.  ;
  1.  ; If the SPECIFIC variable is set, send alert to ONLY that one user
  1.  S XQA($G(SPECIFIC,"G.LMI"))=""
  1.  ;
  1.  ; If User not part of LMI Mail Group, send them alert also, but
  1.  ; If-And-Only-If the NOUSER variable is null.
  1.  S:$G(NOUSER)=""&($$NINLMI^BLRUTIL3(DUZ)) XQA(DUZ)=""
  1.  ;
  1.  S X=$$SETUP1^XQALERT
  1.  K XQA,XQAMSG
  1.  Q:X
  1.  ;
  1.  NEW SUBSCRPT
  1.  S SUBSCRPT="BLRLINKU Alert^"_+$H_"^"_$J
  1.  S ^XTMP(SUBSCRPT,0)=$$FMADD^XLFDT($$DT^XLFDT,90)_"^"_$$DT^XLFDT_"^"_"Lab Package Alert."
  1.  S ^XTMP(SUBSCRPT,1)="Alert was not sent."
  1.  S ^XTMP(SUBSCRPT,2)="  Message that should have been sent follows:"
  1.  S ^XTMP(SUBSCRPT,3)="     SUBJ:"_ALRTSUBJ
  1.  I $L(ALERTMSG(1))<1  S ^XTMP(SUBSCRPT,4)="     MESSAGE:"_ALERTMSG,LINE=5
  1.  I $L($G(ALERTMSG(1))) D
  1.  . S ^XTMP(SUBSCRPT,4)="     MESSAGE:"_ALERTMSG(1)
  1.  . S ARRAYLNE=1,LINE=4
  1.  . F  S ARRAYLNE=$O(ALERTMSG(ARRAYLNE))  Q:ARRAYLNE<1  D
  1.  .. S ^XTMP(SUBSCRPT,ARRAYLNE)="             "_ALERTMSG(ARRAYLNE)
  1.  .. S LINE=LINE+1
  1.  ;
  1.  S ^XTMP(SUBSCRPT,LINE)="  ALERT Error Message Follows:"
  1.  S LINE=LINE+1
  1.  S ^XTMP(SUBSCRPT,LINE)="     "_XQALERR
  1.  Q
  1.  ;
  1.  ;
  1. OERRSTSC(ODT,SN) ; EP - Change OERR Status from PENDING to DISCOUNTINUED - ALL tests on the Order
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,ODT,SN,U,XPARSYS,XQXFLG)
  1.  S CONTROL="OC"
  1.  D NEW^LR7OB1(ODT,SN,CONTROL,,,1)
  1.  Q
  1.  ;
  1.  ;
  1. OERRSTSO(LRODT,LRSN,LROT) ; EP - Change OERR Status from PENDING to DISCOUNTINUED - Specific Test
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRODT,LROT,LRSN,U,XPARSYS,XQXFLG)
  1.  S LROTIEN=LROT_","_LRSN_","_LRODT
  1.  S ORIFN=$$GET1^DIQ(69.03,LROTIEN,6)
  1.  Q:$L(ORIFN)<1
  1.  ;
  1.  S F60IEN=$$GET1^DIQ(69.03,.01,LROTIEN,"I")
  1.  Q:$L(F60IEN)<1
  1.  ;
  1.  S II(F60IEN)="",LRSTATUS=1
  1.  S CONTROL="OC"
  1.  D NEW^LR7OB1(LRODT,LRSN,CONTROL,,.II,LRSTATUS)
  1.  Q
  1.  ;
  1. FORCEIT(LABEL,ARRY1,ARRY2,ARRY3) ; EP - Force the Audting of Varibles, even if TAKE SNAPSHOTS is set to OFF
  1.  ; Code cloned from ENTRYAUD^BLRUTIL
  1.  ;
  1.  ; D DISABLE^%NOJRN       ; Disable Journaling of ^BLRENTRY global
  1.  D:$G(^%ZOSF("OS"))["OpenM" DISABLE^%NOJRN       ; Disable Journaling of ^BLRENTRY global - IHS/MSC/MKK - LR*5.2*1041 - Cache/Ensemble only
  1.  ;
  1.  N ORIGX,ORIGY,%ORIG    ; Want to see what %, X & Y variables are
  1.  M ORIGX=X,ORIGY=Y
  1.  M:$D(%) %ORIG=%
  1.  NEW %
  1.  M:$D(%ORIG) %=%ORIG
  1.  ;
  1.  N X,Y,NOW,ENTRYNUM,STARTTIM,NOWTIM
  1.  S NOW=$$NOW^XLFDT
  1.  S ENTRYNUM=$G(^BLRENTRY)+1
  1.  S NOWTIM=$P($H,",",2)
  1.  S $P(^BLRENTRY,U)=ENTRYNUM
  1.  S ^BLRENTRY(DUZ,NOW,ENTRYNUM,LABEL)=""
  1.  ;
  1.  ; D CAPVARS^BLRUTIL("BLRVARS","^BLRENTRY(DUZ,NOW,ENTRYNUM,LABEL)")
  1.  ;
  1.  ; I $L($G(ARRY1)) D      ; Have an array that needs to be monitored; Merge it
  1.  ; . M ^BLRENTRY(DUZ,NOW,ENTRYNUM,LABEL,ARRY1)=@ARRY1
  1.  ;
  1.  ; I $L($G(ARRY2)) D      ; Have another array that needs to be monitored; Merge it
  1.  ; . M ^BLRENTRY(DUZ,NOW,ENTRYNUM,LABEL,ARRY2)=@ARRY2
  1.  ;
  1.  ; I $L($G(ARRY3)) D      ; Have another array that needs to be monitored; Merge it
  1.  ; . M ^BLRENTRY(DUZ,NOW,ENTRYNUM,LABEL,ARRY3)=@ARRY3
  1.  ;
  1.  ; M ^BLRENTRY(DUZ,NOW,ENTRYNUM,LABEL,"DUZ")=DUZ   ; Always merge in the DUZ array
  1.  ; I $D(ORIGX)>1 M ^BLRENTRY(DUZ,NOW,ENTRYNUM,LABEL,"ORIGX")=ORIGX
  1.  ; I $D(ORIGY)>1 M ^BLRENTRY(DUZ,NOW,ENTRYNUM,LABEL,"ORIGY")=ORIGY
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1041 - Use Kernel Call.  It handles ALL arrays automatically.
  1.  S X="^BLRENTRY("_DUZ_","_NOW_","_ENTRYNUM_","_$C(34)_LABEL_$C(34)_","
  1.  D DOLRO^%ZOSV
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1041 - Use Kernel Call
  1.  ;
  1.  D GETSTACK^BLRUTIL6    ; Merge in the $STACK
  1.  ;
  1.  ; D ENABLE^%NOJRN        ; Enable Journaling again
  1.  D:$G(^%ZOSF("OS"))["OpenM" ENABLE^%NOJRN   ; Enable Journaling again - IHS/MSC/MKK - LR*5.2*1041 - Cache/Ensemble only
  1.  Q
  1.  ;
  1.  ;
  1. REFLABT ; EP - REFerence LAB Tests
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D SETBLRVS("REFLABT")
  1.  ;
  1.  S HEADER(1)="Reference Lab Tests"
  1.  S HEADER(2)=$$GET1^DIQ(9009026,+$G(^BLRSITE(DUZ(2),"RL")),.01)
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D HEADONE^BLRGMENU(.HDRONE)
  1.  ;
  1.  S HEADER(3)=" "
  1.  F J=5,27,49  S $E(HEADER(4),J)="PrntName",$E(HEADER(4),J+10)="F60 IEN"
  1.  ;	
  1.  S MAXLINES=IOSL-4,LINES=MAXLINES+10
  1.  S (CNT,F60CNT,PG)=0
  1.  S QFLG="NO"
  1.  ;
  1.  S F60IEN=.9999999
  1.  F  S F60IEN=$O(^LAB(60,F60IEN))  Q:F60IEN<1!(QFLG="Q")  D
  1.  . S F60CNT=F60CNT+1
  1.  . Q:$$REFLAB^BLRUTIL6(DUZ(2),F60IEN)<1
  1.  . ;
  1.  . I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE)  Q:QFLG="Q"  W ?4
  1.  . ;
  1.  . S CNT=CNT+1
  1.  . W $$LJ^XLFSTR($$LJ^XLFSTR($$GET1^DIQ(60,F60IEN,51),9)_"["_F60IEN_"]",22)
  1.  . I $X>55 W !,?4  S LINES=LINES+1
  1.  ;
  1.  I CNT<1 D HEADERDT^BLRGMENU
  1.  ;
  1.  W !!,?4,F60CNT," Tests analyzed."
  1.  W !!,?9,$S(CNT<1:"No",1:CNT)," Reference Lab Test",$$PLURAL(CNT),"."
  1.  D PRESSKEY^BLRGMENU(4)
  1.  Q
  1.  ;
  1.  ;
  1.  ; ============================= UTILITIES =============================
  1.  ;
  1. BADSTUFF(MSG,TAB) ; EP - Simple Message that "ends" with "Routine Ends" string.
  1.  S:+$G(TAB)<1 TAB=4
  1.  W !!,?TAB,$$TRIM^XLFSTR(MSG,"LR"," "),"  Routine Ends."
  1.  D PRESSKEY^BLRGMENU(TAB+5)
  1.  Q
  1.  ;
  1. BADSTUFQ(MSG,TAB) ; EP - Simple Message.  Calls BADSTUFF.  Quits with "Q"
  1.  D BADSTUFF(MSG,$G(TAB))
  1.  Q "Q"
  1.  ;
  1. BADSTUFN(MSG,TAB) ; EP - Simple Message.  Calls BADSTUFF.  Quits with Null string
  1.  D BADSTUFF(MSG,$G(TAB))
  1.  Q ""
  1.  ;
  1. BADSTUF2(MSG,TAB) ; EP - Simple Message.  Displays MSG string only.
  1.  S TAB=$S($L($G(TAB)):TAB,1:4)
  1.  W !!,?TAB,$$TRIM^XLFSTR(MSG,"LR"," ")
  1.  D PRESSKEY^BLRGMENU(TAB+5)
  1.  Q
  1.  ;
  1. BADSTF2N(MSG,TAB) ; EP - Simple Message.  Calls BADSTUF2.  Quits with Null string
  1.  D BADSTUF2(MSG,$G(TAB))
  1.  Q ""
  1.  ;
  1. BADSTF2Q(MSG,TAB) ; EP - Simple Message.  Calls BADSTUF2.  Quits with "Q"
  1.  D BADSTUF2(MSG,$G(TAB))
  1.  Q "Q"
  1.  ;
  1. PROMPTO(MSG,TAB) ; EP - prompt only.
  1.  S TAB=$S($L($G(TAB)):TAB,1:4)
  1.  W !!,?TAB,MSG
  1.  D PRESSKEY^BLRGMENU(TAB+5)
  1.  Q
  1.  ;
  1. PROMPTON(MSG,TAB) ; EP - Calls PROMPTO.  Quits with null
  1.  D PROMPTO(MSG,$G(TAB))
  1.  Q ""
  1.  ;
  1. PROMPTOQ(MSG,TAB) ; EP - Calls PROMPTO.  Quits with "Q"
  1.  D PROMPTO(MSG,$G(TAB))
  1.  Q "Q"
  1.  ;
  1. SHOUTMSG(STR,RM) ; EP - Return a string like >>>> STR <<<<
  1.  ; RM = Right Margin (how long the string will be)
  1.  NEW HALFLEN,J,STRLEN,TMPSTR
  1.  ;
  1.  S RM=$G(RM,IOM)
  1.  ;
  1.  S HALFLEN=(RM\2)-(($L(STR)+2)\2)
  1.  S TMPSTR=$TR($J("",HALFLEN)," ",">")
  1.  S TMPSTR=TMPSTR_" "_STR_" "
  1.  S STRLEN=$L(TMPSTR)
  1.  F J=STRLEN:1:(RM-1) S TMPSTR=TMPSTR_"<"
  1.  Q TMPSTR
  1.  ;
  1. PURGALRT ; EP - Purge ALL Alerts for user
  1.  D RECIPURG^XQALBUTL(DUZ)
  1.  W !!,?14,"Alerts Purged for DUZ:",DUZ
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. GETUCIS(ARRAY) ; EP - Create an Array of UCIs
  1.  Q:$G(^%ZOSF("OS"))'["OpenM" 0    ; MSC/MKK - LR*5.2*1041 - Only for Cache systems.
  1.  ;
  1.  NEW obj,X
  1.  NEW CNT,UCI,MSG,MSGLINE
  1.  ;
  1.  S CNT=0
  1.  SET obj=##class(%ResultSet).%New("%SYS.Namespace:List")
  1.  D obj.Execute()
  1.  S X=$G(obj.Data,"none")
  1.  SET X=1
  1.  F  Q:X=""  D
  1.  . D obj.Next()
  1.  . S X=$G(obj.Data("Nsp"))
  1.  . Q:X=""
  1.  . ;
  1.  . S UCI=X
  1.  . ;
  1.  . Q:'$$CHEKIT(X)
  1.  . ;
  1.  . S ARRAY(UCI)=""
  1.  . S CNT=CNT+1
  1.  ;
  1.  I CNT<1 D
  1.  . W !,?4,"No UCIs could be determined on this system.",!
  1.  . D PRESSKEY^BLRGMENU(4)
  1.  ;
  1.  D:$D(MSG) SENDMAIL^BLRUTIL3("UCI Error",.MSG,"BZHHUTLU")
  1.  ;
  1.  Q CNT
  1.  ;
  1. CHEKIT(UCI) ; EP - Checking to make sure UCI doesn't throw an error
  1.  NEW ERRMSG,errobj,NOW,X
  1.  ;
  1.  TRY {
  1.  	S X=$O(^[UCI]XPD(9.7,"B","LR*5.2*1099"),-1)
  1.  } CATCH errobj {
  1.  	S ERRMSG=errobj.Name
  1.  }
  1.  ;
  1.  Q:$D(ERRMSG)<1 1
  1.  ;
  1.  I $D(MSG) S MSGLINE=$O(MSG("A"),-1)
  1.  E  D
  1.  . S MSG(1)="Error Occurred during UCI processing"
  1.  . S MSG(2)=" "
  1.  . S MSGLINE=2
  1.  ;
  1.  S MSGLINE=MSGLINE+1
  1.  S $E(MSG(MSGLINE),5)="UCI:"_UCI_" Error:"_ERRMSG
  1.  ;
  1.  Q 0
  1.  ;
  1. URGCHK(ORDERNUM) ; EP - Check the Urgency of an Order and, if STAT, send ALERT to LMI Mail Group
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,ORDERNUM,U,XPARSYS,XQXFLG)
  1.  ;
  1.  S (LRODT,URGENCY)=0
  1.  F  S LRODT=$O(^LRO(69,"C",ORDERNUM,LRODT))  Q:LRODT<1!(URGENCY)  D
  1.  . S LRSP=0
  1.  . F  S LRSP=$O(^LRO(69,"C",ORDERNUM,LRODT,LRSP))  Q:LRSP<1!(URGENCY)  D
  1.  .. I $$GET1^DIQ(69.03,LRSP_","_LRODT,1)["STAT" S URGENCY=URGENCY+1
  1.  ;
  1.  D:URGENCY SNDALERT^BLRUTIL3("Order # "_ORDERNUM_" is a STAT Order.",1)
  1.  Q
  1.  ;
  1.  ;
  1. STATORDA(LRODT,LRSP,STATUS) ; EP - If STAT Order from EHR, send ALERT to LMI Mail Group
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRODT,LRSP,STATUS,U,XPARSYS,XQXFLG)
  1.  ;
  1.  S STATIEN=$$FIND1^DIC(62.05,,,"STAT") ; Get the IEN of the STAT urgency
  1.  Q:STATIEN<1  ; If no STAT urgency, skip
  1.  ;
  1.  Q:STATUS'=STATIEN      ; If STATUS not STAT, skip
  1.  ;
  1.  ; Status is STAT, so send alert
  1.  ;
  1.  S ORDERNUM=$$GET1^DIQ(69.01,LRSP_","_LRODT,9.5)
  1.  Q:ORDERNUM<1           ; If no Order Number, skip
  1.  ;
  1.  D SNDALERT^BLRUTIL3("Order # "_ORDERNUM_" is a STAT Order.",1)
  1.  Q
  1.  ;
  1. MAKESTR(ARRAY) ; EP - Pass in Word Processing Array and return String
  1.  NEW (ARRAY,DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  S STRING="",LINE=0
  1.  F  S LINE=$O(ARRAY(LINE))  Q:LINE<1  S STRING=STRING_($$TRIM^XLFSTR(ARRAY(LINE),"R"," "))_" "
  1.  Q $$TRIM^XLFSTR(STRING,"LR"," ")
  1.  ;
  1. NOSNAPS ; EP - Make certain TAKE SNAPSHOTS field in BLR MASTER CONTROL file is OFF.  This should be queued.
  1.  NEW CNT,DESC,FDA,IEN,STR
  1.  ;
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  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.  ;
  1.  S STR(1)="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
  1.  . S STR(IEN+2)=$J("",5)_$$GET1^DIQ(9009029,IEN,.01)
  1.  ;
  1.  D SENDMAIL^BLRUTIL3("TAKE SNAPSHOTS OFF",.STR,"BLRUTIL7",1)
  1.  Q
  1.  ;
  1.  ;
  1. GLODUMP ; EP - "Dump" a global using $Q
  1.  NEW FRSTPART,GLOVAR,STR1
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="FO",DIR("A")="Global"
  1.  D ^DIR
  1.  I $L(X)<1!(+$G(DIRUT)) D BADSTUFF("No/Invalid Input.")  Q
  1.  ;
  1.  ; S GLOBAL=X
  1.  S GLOVAR=X   ; IHS/MSC/MKK - LR*5.2*1041
  1.  I $E(GLOVAR)'=U S GLOVAR=U_GLOVAR
  1.  ;
  1.  S FRSTPART=$P(GLOVAR,")")
  1.  S STR1=$Q(@GLOVAR@(""))
  1.  I STR1="" D BADSTUFF("No data found for "_GLOVAR_".")  Q
  1.  ;
  1.  W !!,STR1,"="  D LINEWRAP^BLRGMENU($X,@STR1,(IOM-$X))  W !
  1.  F  S STR1=$Q(@STR1)  Q:STR1=""!(STR1'[FRSTPART)  W ?4,STR1,"="  D LINEWRAP^BLRGMENU($X,@STR1,(IOM-$X))  W !
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. SETBLRVS(TWO) ; EP - Set BLRVERN variable(s)
  1.  S BLRVERN=$P($P($T(+1),";")," ")
  1.  S:$L($G(TWO)) BLRVERN2=TWO
  1.  Q
  1.  ;
  1. PLURAL(CNT) ; EP - Return "" if CNT=1, else return "s".
  1.  ; Q $S(CNT>1:"s",1:"")
  1.  Q $S(CNT=1:"",1:"s")   ; MSC/MKK - LR*5.2*1041
  1.  ;
  1. PLURALI(CNT) ; EP - Return the letter "y" if CNT=1, else return "ies".
  1.  ; Q $S(CNT>1:"ies",1:"y")
  1.  Q $S(CNT=1:"y",1:"ies")     ; MSC/MKK - LR*5.2*1041
  1.  ;
  1. LJZEROF(NUM,JW) ; EP - Left Justify, ZERO Fill - JW = Justify Width
  1.  Q $TR($$LJ^XLFSTR(NUM,JW)," ","0")
  1.  ;
  1. RJZEROF(NUM,JW) ; EP - Right Justify, ZERO Fill
  1.  Q $TR($$RJ^XLFSTR(NUM,JW)," ","0")
  1.  ;
  1. RESETERM ; EP - Reset Terminal Characteristics for a Terminal session
  1.  W *27,"[0m",!,$C(27),"[?7h"      ; Resets and ensures "Auto Wrap" is ON
  1.  Q
  1.  ;
  1. AUTOWRAP ; EP - Reset Auto-wrap for a Terminal Session
  1.  W $C(27),"[?7h"
  1.  Q