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

LRUTIL2.m

Go to the documentation of this file. 
  1. LRUTIL2 ;DALOI/JDB -- Lab KIDS Utilities ;04/30/12  10:04
  1.  ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
  1.  ;
  1.  ;File 19/10156
  1.  ;
  1.  Q
  1.  ;
  1. ENVCHK(CJ,LM,POS,QUIET) ;
  1.  ; Perform basic environment checks
  1.  N ERR
  1.  S CJ=$G(CJ)
  1.  S LM=$G(LM)
  1.  S POS=$G(POS)
  1.  S QUIET=$G(QUIET)
  1.  S ERR=0
  1.  I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D  ;
  1.  . I 'QUIET D BMES("Terminal Device is not defined.")
  1.  . S ERR="1^1"
  1.  ;
  1.  I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D  ;
  1.  . I 'QUIET D BMES("Please login to set local DUZ variables.")
  1.  . S $P(ERR,"^",1)=1 S $P(ERR,"^",3)=1
  1.  ;
  1.  I $G(DUZ) I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D  ;
  1.  . I 'QUIET D BMES("You are not a valid user on this system.")
  1.  . S $P(ERR,"^",1)=1 S $P(ERR,"^",4)=1
  1.  Q ERR
  1.  ;
  1. BMES(STR,CJ,LM,POS) ;
  1.  ; Display messages using BMES^XPDUTL or MES^XPDUTL
  1.  ; Accepts single string or string array
  1.  ; Inputs
  1.  ;  STR:<byref><byval> The string to display.
  1.  ;   CJ:<opt> Center text?  1=yes  0=no  <dflt=1>
  1.  ;   LM:<opt> Left Margin (padding)  <dflt=0>
  1.  ;  POS <opt> value for $$CJ^XLFSTR (80=default)
  1.  ;
  1.  N I,X
  1.  S CJ=$G(CJ,1)
  1.  S LM=$G(LM)
  1.  S:LM<0 LM=0
  1.  S POS=$G(POS)
  1.  I POS'>1 S POS=$G(IOM,80)
  1.  ; If an array, step through it and pass each node to MES
  1.  ; since $$CJ^XLFSTR can't handle arrays
  1.  I $D(STR)>9 D  ;
  1.  . S I=0
  1.  . F  S I=$O(STR(I)) Q:'I  D  ;
  1.  . . D MES(STR(I),CJ,LM,POS)
  1.  . ;
  1.  ;
  1.  I $D(STR)=1 D MES(STR,CJ,LM,POS)
  1.  Q
  1.  ;
  1. MES(STR,CJ,LM,POS) ;
  1.  ; Display a string using MES^XPDUTL
  1.  ;  Inputs
  1.  ;  STR:<byref>or<byval> String to display
  1.  ;   CJ:<opt> Center text?  1=yes 0=1 <dflt=1>
  1.  ;   LM:<opt> Left Margin (padding) dflt=0
  1.  ;  POS:<opt> <dflt=IOM,80>
  1.  N X,I,LRSTR2
  1.  S CJ=$G(CJ,1)
  1.  S LM=$G(LM)
  1.  S POS=$G(POS)
  1.  I LM<0 S LM=0
  1.  I POS'>1 S POS=$G(IOM,80)
  1.  I $G(STR)'="" S STR(.00001)=STR
  1.  S I=0
  1.  F  S I=$O(STR(I)) Q:'I  D  ;
  1.  . S LRSTR2=STR(I)
  1.  . I CJ S LRSTR2=$$TRIM^XLFSTR($$CJ^XLFSTR(LRSTR2,POS),"R"," ")
  1.  . I 'CJ I LM S X="" S $P(X," ",LM)=" " S LRSTR2=X_LRSTR2
  1.  . D MES^XPDUTL(LRSTR2)
  1.  Q
  1.  ;
  1. ALERT(MSG,RECIPS) ;
  1.  ; Send an Alert message.
  1.  ; Inputs
  1.  ;     MSG: Message text
  1.  ;  RECIPS:<byref><opt> Array of Recipients <dflt=G.LMI>
  1.  ;        : Set RECIPS("-G.LMI") to exclude LMI group.
  1.  ;
  1.  N DA,DIK,XQA,XQAMSG
  1.  S XQAMSG=$G(MSG)
  1.  S XQA("G.LMI")=""
  1.  I $D(RECIPS) M XQA=RECIPS
  1.  I $D(XQA("-G.LMI")) K XQA("G.LMI"),XQA("-G.LMI")
  1.  Q:$D(XQA)'>9
  1.  D SETUP^XQALERT
  1.  Q
  1.  ;
  1. OPTOOO(LROPT,MODE) ;
  1.  ;File 19/10156
  1.  ; Mark Option Out of Order (OOO) or clear OOO.
  1.  ; If the Option is already marked OOO, no action taken.
  1.  ; If the Option was not marked OOO by this API, it will
  1.  ; not be re-enabled by this API.
  1.  ; Note: OPTDE^XPDUTL API doesnt work in ENV check.
  1.  ; Inputs
  1.  ;   LROPT: The OPTION name to act on.
  1.  ;    MODE: 0 or 1 (0=disable  1=enable)
  1.  ; Outputs
  1.  ;   Mode=0
  1.  ;     1 if the option was disabled, 0 if not (or already disabled)
  1.  ;   Mode=1
  1.  ;     1 if option enabled, 0 if not (or disabled previously)
  1.  N R19,STATUS,LROOO,LRFDA,LRMSG,DIERR,OOM
  1.  S LROPT=$G(LROPT)
  1.  S MODE=$G(MODE)
  1.  S STATUS=0
  1.  S R19=$$FIND1^DIC(19,"","OX",LROPT,"B")
  1.  I 'R19 Q "0^1^Option not found"
  1.  K DIERR
  1.  S OOM=$$GET1^DIQ(19,R19_",",2,"","","LRMSG")
  1.  S LROOO=""
  1.  I OOM="" I 'MODE D  ;
  1.  . I $G(XPDNM)'="" S LROOO="OOO VIA "_$TR(XPDNM,"^","~")
  1.  . I $G(XPDNM)="" S LROOO="OOO VIA OPTOOO~LRUTIL2"
  1.  ;
  1.  I OOM="" I MODE D  ;
  1.  . S LROOO="@"
  1.  ;
  1.  ; pre-existing OOO message
  1.  I OOM'="" I $G(XPDNM)'="" D  ;
  1.  . I OOM'="OOO VIA "_$TR(XPDNM,"^","~") Q
  1.  . I MODE S LROOO="@"
  1.  I OOM'="" I $G(XPDNM)="" D  ;
  1.  . I OOM'="OOO VIA OPTOOO~LRUTIL2" Q
  1.  . I MODE S LROOO="@"
  1.  ;
  1.  I LROOO="" D  ;
  1.  . I 'MODE S STATUS="0^2^Already OOO"
  1.  . I MODE S STATUS="0^3^Can't re-enable"
  1.  ;
  1.  K DIERR,LRFDA
  1.  I LROOO'="" D  ;
  1.  . S LRFDA(1,19,R19_",",2)=$TR(LROOO,"^","~")
  1.  . D FILE^DIE("","LRFDA(1)","LRMSG")
  1.  . S STATUS=1
  1.  Q STATUS
  1.  ;
  1. ENDDIOL(TXT,GBL,FMT,USENP,CHKABORT,ABORT,PGDATA) ;
  1.  ; Substitute for EN^DDIOL API.
  1.  ; Enhanced for pagination control.
  1.  ; Inputs
  1.  ;      TXT:<byval><byref> Text to display
  1.  ;      GBL:<byval><opt> Global reference of text. (See EN^DDIOL)
  1.  ;      FMT:<opt> Format array. (See EN^DDIOL)
  1.  ;    USENP:<opt> Use NP (use pagination) 1=yes  0=no <dflt=0>
  1.  ; CHKABORT:<opt> Check for user abort 1=check 0=dont  <dflt=0>
  1.  ;    ABORT:<byref><opt> User abort status (output)
  1.  ;   PGDATA:<byref><opt> Page Data array (see NP^LRUTIL)
  1.  ; Outputs
  1.  ;    Displays the text.
  1.  ;   ABORT:
  1.  ;  PGDATA:
  1.  ;
  1.  N NODE,ADDPRMPT
  1.  S GBL=$G(GBL)
  1.  S FMT=$G(FMT)
  1.  S USENP=$G(USENP)
  1.  S CHKABORT=$G(CHKABORT)
  1.  ;
  1.  I '$D(PGDATA) D  ;
  1.  . Q:CHKABORT
  1.  . S ADDPRMPT=1
  1.  . S PGDATA("PROMPT")=$$TRIM^XLFSTR($$CJ^XLFSTR("'ENTER' to continue",$G(IOM,80)," "),"R"," ")
  1.  I 'USENP D  ;
  1.  . I $D(TXT) D  ;
  1.  . . I $D(TXT)=1 D EN^DDIOL(TXT,"",FMT) Q
  1.  . . D EN^DDIOL(.TXT)
  1.  . I GBL'="" D EN^DDIOL("",GBL,FMT) Q
  1.  Q:'USENP
  1.  ;
  1.  I $D(TXT) D  Q:CHKABORT&ABORT  ;
  1.  . I $D(TXT)=1 S TXT(.0000001)=TXT
  1.  . S NODE="TXT(0)"
  1.  . F  S NODE=$Q(@NODE) Q:NODE=""  D  Q:CHKABORT&ABORT  ;
  1.  . . D EN^DDIOL(@NODE,"",$S($D(TXT)=1:FMT,1:""))
  1.  . . D NP^LRUTIL(.ABORT,.PGDATA)
  1.  . . I CHKABORT Q:ABORT
  1.  . K TXT(.0000001)
  1.  ;
  1.  I $G(ADDPRMPT) K PGDATA("PROMPT")
  1.  Q