LRUTIL2 ;DALOI/JDB -- Lab KIDS Utilities ;04/30/12 10:04
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
;File 19/10156
;
Q
;
ENVCHK(CJ,LM,POS,QUIET) ;
; Perform basic environment checks
N ERR
S CJ=$G(CJ)
S LM=$G(LM)
S POS=$G(POS)
S QUIET=$G(QUIET)
S ERR=0
I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D ;
. I 'QUIET D BMES("Terminal Device is not defined.")
. S ERR="1^1"
;
I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D ;
. I 'QUIET D BMES("Please login to set local DUZ variables.")
. S $P(ERR,"^",1)=1 S $P(ERR,"^",3)=1
;
I $G(DUZ) I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D ;
. I 'QUIET D BMES("You are not a valid user on this system.")
. S $P(ERR,"^",1)=1 S $P(ERR,"^",4)=1
Q ERR
;
BMES(STR,CJ,LM,POS) ;
; Display messages using BMES^XPDUTL or MES^XPDUTL
; Accepts single string or string array
; Inputs
; STR:<byref><byval> The string to display.
; CJ:<opt> Center text? 1=yes 0=no <dflt=1>
; LM:<opt> Left Margin (padding) <dflt=0>
; POS <opt> value for $$CJ^XLFSTR (80=default)
;
N I,X
S CJ=$G(CJ,1)
S LM=$G(LM)
S:LM<0 LM=0
S POS=$G(POS)
I POS'>1 S POS=$G(IOM,80)
; If an array, step through it and pass each node to MES
; since $$CJ^XLFSTR can't handle arrays
I $D(STR)>9 D ;
. S I=0
. F S I=$O(STR(I)) Q:'I D ;
. . D MES(STR(I),CJ,LM,POS)
. ;
;
I $D(STR)=1 D MES(STR,CJ,LM,POS)
Q
;
MES(STR,CJ,LM,POS) ;
; Display a string using MES^XPDUTL
; Inputs
; STR:<byref>or<byval> String to display
; CJ:<opt> Center text? 1=yes 0=1 <dflt=1>
; LM:<opt> Left Margin (padding) dflt=0
; POS:<opt> <dflt=IOM,80>
N X,I,LRSTR2
S CJ=$G(CJ,1)
S LM=$G(LM)
S POS=$G(POS)
I LM<0 S LM=0
I POS'>1 S POS=$G(IOM,80)
I $G(STR)'="" S STR(.00001)=STR
S I=0
F S I=$O(STR(I)) Q:'I D ;
. S LRSTR2=STR(I)
. I CJ S LRSTR2=$$TRIM^XLFSTR($$CJ^XLFSTR(LRSTR2,POS),"R"," ")
. I 'CJ I LM S X="" S $P(X," ",LM)=" " S LRSTR2=X_LRSTR2
. D MES^XPDUTL(LRSTR2)
Q
;
ALERT(MSG,RECIPS) ;
; Send an Alert message.
; Inputs
; MSG: Message text
; RECIPS:<byref><opt> Array of Recipients <dflt=G.LMI>
; : Set RECIPS("-G.LMI") to exclude LMI group.
;
N DA,DIK,XQA,XQAMSG
S XQAMSG=$G(MSG)
S XQA("G.LMI")=""
I $D(RECIPS) M XQA=RECIPS
I $D(XQA("-G.LMI")) K XQA("G.LMI"),XQA("-G.LMI")
Q:$D(XQA)'>9
D SETUP^XQALERT
Q
;
OPTOOO(LROPT,MODE) ;
;File 19/10156
; Mark Option Out of Order (OOO) or clear OOO.
; If the Option is already marked OOO, no action taken.
; If the Option was not marked OOO by this API, it will
; not be re-enabled by this API.
; Note: OPTDE^XPDUTL API doesnt work in ENV check.
; Inputs
; LROPT: The OPTION name to act on.
; MODE: 0 or 1 (0=disable 1=enable)
; Outputs
; Mode=0
; 1 if the option was disabled, 0 if not (or already disabled)
; Mode=1
; 1 if option enabled, 0 if not (or disabled previously)
N R19,STATUS,LROOO,LRFDA,LRMSG,DIERR,OOM
S LROPT=$G(LROPT)
S MODE=$G(MODE)
S STATUS=0
S R19=$$FIND1^DIC(19,"","OX",LROPT,"B")
I 'R19 Q "0^1^Option not found"
K DIERR
S OOM=$$GET1^DIQ(19,R19_",",2,"","","LRMSG")
S LROOO=""
I OOM="" I 'MODE D ;
. I $G(XPDNM)'="" S LROOO="OOO VIA "_$TR(XPDNM,"^","~")
. I $G(XPDNM)="" S LROOO="OOO VIA OPTOOO~LRUTIL2"
;
I OOM="" I MODE D ;
. S LROOO="@"
;
; pre-existing OOO message
I OOM'="" I $G(XPDNM)'="" D ;
. I OOM'="OOO VIA "_$TR(XPDNM,"^","~") Q
. I MODE S LROOO="@"
I OOM'="" I $G(XPDNM)="" D ;
. I OOM'="OOO VIA OPTOOO~LRUTIL2" Q
. I MODE S LROOO="@"
;
I LROOO="" D ;
. I 'MODE S STATUS="0^2^Already OOO"
. I MODE S STATUS="0^3^Can't re-enable"
;
K DIERR,LRFDA
I LROOO'="" D ;
. S LRFDA(1,19,R19_",",2)=$TR(LROOO,"^","~")
. D FILE^DIE("","LRFDA(1)","LRMSG")
. S STATUS=1
Q STATUS
;
ENDDIOL(TXT,GBL,FMT,USENP,CHKABORT,ABORT,PGDATA) ;
; Substitute for EN^DDIOL API.
; Enhanced for pagination control.
; Inputs
; TXT:<byval><byref> Text to display
; GBL:<byval><opt> Global reference of text. (See EN^DDIOL)
; FMT:<opt> Format array. (See EN^DDIOL)
; USENP:<opt> Use NP (use pagination) 1=yes 0=no <dflt=0>
; CHKABORT:<opt> Check for user abort 1=check 0=dont <dflt=0>
; ABORT:<byref><opt> User abort status (output)
; PGDATA:<byref><opt> Page Data array (see NP^LRUTIL)
; Outputs
; Displays the text.
; ABORT:
; PGDATA:
;
N NODE,ADDPRMPT
S GBL=$G(GBL)
S FMT=$G(FMT)
S USENP=$G(USENP)
S CHKABORT=$G(CHKABORT)
;
I '$D(PGDATA) D ;
. Q:CHKABORT
. S ADDPRMPT=1
. S PGDATA("PROMPT")=$$TRIM^XLFSTR($$CJ^XLFSTR("'ENTER' to continue",$G(IOM,80)," "),"R"," ")
I 'USENP D ;
. I $D(TXT) D ;
. . I $D(TXT)=1 D EN^DDIOL(TXT,"",FMT) Q
. . D EN^DDIOL(.TXT)
. I GBL'="" D EN^DDIOL("",GBL,FMT) Q
Q:'USENP
;
I $D(TXT) D Q:CHKABORT&ABORT ;
. I $D(TXT)=1 S TXT(.0000001)=TXT
. S NODE="TXT(0)"
. F S NODE=$Q(@NODE) Q:NODE="" D Q:CHKABORT&ABORT ;
. . D EN^DDIOL(@NODE,"",$S($D(TXT)=1:FMT,1:""))
. . D NP^LRUTIL(.ABORT,.PGDATA)
. . I CHKABORT Q:ABORT
. K TXT(.0000001)
;
I $G(ADDPRMPT) K PGDATA("PROMPT")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUTIL2 5172 printed Apr 09, 2024@21:23:49 Page 2
LRUTIL2 ;DALOI/JDB -- Lab KIDS Utilities ;04/30/12 10:04
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 ;File 19/10156
+4 ;
+5 QUIT
+6 ;
ENVCHK(CJ,LM,POS,QUIET) ;
+1 ; Perform basic environment checks
+2 NEW ERR
+3 SET CJ=$GET(CJ)
+4 SET LM=$GET(LM)
+5 SET POS=$GET(POS)
+6 SET QUIET=$GET(QUIET)
+7 SET ERR=0
+8 ;
IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)
Begin DoDot:1
+9 IF 'QUIET
DO BMES("Terminal Device is not defined.")
+10 SET ERR="1^1"
End DoDot:1
+11 ;
+12 ;
IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)
Begin DoDot:1
+13 IF 'QUIET
DO BMES("Please login to set local DUZ variables.")
+14 SET $PIECE(ERR,"^",1)=1
SET $PIECE(ERR,"^",3)=1
End DoDot:1
+15 ;
+16 ;
IF $GET(DUZ)
IF $PIECE($$ACTIVE^XUSER(DUZ),"^")'=1
Begin DoDot:1
+17 IF 'QUIET
DO BMES("You are not a valid user on this system.")
+18 SET $PIECE(ERR,"^",1)=1
SET $PIECE(ERR,"^",4)=1
End DoDot:1
+19 QUIT ERR
+20 ;
BMES(STR,CJ,LM,POS) ;
+1 ; Display messages using BMES^XPDUTL or MES^XPDUTL
+2 ; Accepts single string or string array
+3 ; Inputs
+4 ; STR:<byref><byval> The string to display.
+5 ; CJ:<opt> Center text? 1=yes 0=no <dflt=1>
+6 ; LM:<opt> Left Margin (padding) <dflt=0>
+7 ; POS <opt> value for $$CJ^XLFSTR (80=default)
+8 ;
+9 NEW I,X
+10 SET CJ=$GET(CJ,1)
+11 SET LM=$GET(LM)
+12 if LM<0
SET LM=0
+13 SET POS=$GET(POS)
+14 IF POS'>1
SET POS=$GET(IOM,80)
+15 ; If an array, step through it and pass each node to MES
+16 ; since $$CJ^XLFSTR can't handle arrays
+17 ;
IF $DATA(STR)>9
Begin DoDot:1
+18 SET I=0
+19 ;
FOR
SET I=$ORDER(STR(I))
if 'I
QUIT
Begin DoDot:2
+20 DO MES(STR(I),CJ,LM,POS)
End DoDot:2
+21 ;
End DoDot:1
+22 ;
+23 IF $DATA(STR)=1
DO MES(STR,CJ,LM,POS)
+24 QUIT
+25 ;
MES(STR,CJ,LM,POS) ;
+1 ; Display a string using MES^XPDUTL
+2 ; Inputs
+3 ; STR:<byref>or<byval> String to display
+4 ; CJ:<opt> Center text? 1=yes 0=1 <dflt=1>
+5 ; LM:<opt> Left Margin (padding) dflt=0
+6 ; POS:<opt> <dflt=IOM,80>
+7 NEW X,I,LRSTR2
+8 SET CJ=$GET(CJ,1)
+9 SET LM=$GET(LM)
+10 SET POS=$GET(POS)
+11 IF LM<0
SET LM=0
+12 IF POS'>1
SET POS=$GET(IOM,80)
+13 IF $GET(STR)'=""
SET STR(.00001)=STR
+14 SET I=0
+15 ;
FOR
SET I=$ORDER(STR(I))
if 'I
QUIT
Begin DoDot:1
+16 SET LRSTR2=STR(I)
+17 IF CJ
SET LRSTR2=$$TRIM^XLFSTR($$CJ^XLFSTR(LRSTR2,POS),"R"," ")
+18 IF 'CJ
IF LM
SET X=""
SET $PIECE(X," ",LM)=" "
SET LRSTR2=X_LRSTR2
+19 DO MES^XPDUTL(LRSTR2)
End DoDot:1
+20 QUIT
+21 ;
ALERT(MSG,RECIPS) ;
+1 ; Send an Alert message.
+2 ; Inputs
+3 ; MSG: Message text
+4 ; RECIPS:<byref><opt> Array of Recipients <dflt=G.LMI>
+5 ; : Set RECIPS("-G.LMI") to exclude LMI group.
+6 ;
+7 NEW DA,DIK,XQA,XQAMSG
+8 SET XQAMSG=$GET(MSG)
+9 SET XQA("G.LMI")=""
+10 IF $DATA(RECIPS)
MERGE XQA=RECIPS
+11 IF $DATA(XQA("-G.LMI"))
KILL XQA("G.LMI"),XQA("-G.LMI")
+12 if $DATA(XQA)'>9
QUIT
+13 DO SETUP^XQALERT
+14 QUIT
+15 ;
OPTOOO(LROPT,MODE) ;
+1 ;File 19/10156
+2 ; Mark Option Out of Order (OOO) or clear OOO.
+3 ; If the Option is already marked OOO, no action taken.
+4 ; If the Option was not marked OOO by this API, it will
+5 ; not be re-enabled by this API.
+6 ; Note: OPTDE^XPDUTL API doesnt work in ENV check.
+7 ; Inputs
+8 ; LROPT: The OPTION name to act on.
+9 ; MODE: 0 or 1 (0=disable 1=enable)
+10 ; Outputs
+11 ; Mode=0
+12 ; 1 if the option was disabled, 0 if not (or already disabled)
+13 ; Mode=1
+14 ; 1 if option enabled, 0 if not (or disabled previously)
+15 NEW R19,STATUS,LROOO,LRFDA,LRMSG,DIERR,OOM
+16 SET LROPT=$GET(LROPT)
+17 SET MODE=$GET(MODE)
+18 SET STATUS=0
+19 SET R19=$$FIND1^DIC(19,"","OX",LROPT,"B")
+20 IF 'R19
QUIT "0^1^Option not found"
+21 KILL DIERR
+22 SET OOM=$$GET1^DIQ(19,R19_",",2,"","","LRMSG")
+23 SET LROOO=""
+24 ;
IF OOM=""
IF 'MODE
Begin DoDot:1
+25 IF $GET(XPDNM)'=""
SET LROOO="OOO VIA "_$TRANSLATE(XPDNM,"^","~")
+26 IF $GET(XPDNM)=""
SET LROOO="OOO VIA OPTOOO~LRUTIL2"
End DoDot:1
+27 ;
+28 ;
IF OOM=""
IF MODE
Begin DoDot:1
+29 SET LROOO="@"
End DoDot:1
+30 ;
+31 ; pre-existing OOO message
+32 ;
IF OOM'=""
IF $GET(XPDNM)'=""
Begin DoDot:1
+33 IF OOM'="OOO VIA "_$TRANSLATE(XPDNM,"^","~")
QUIT
+34 IF MODE
SET LROOO="@"
End DoDot:1
+35 ;
IF OOM'=""
IF $GET(XPDNM)=""
Begin DoDot:1
+36 IF OOM'="OOO VIA OPTOOO~LRUTIL2"
QUIT
+37 IF MODE
SET LROOO="@"
End DoDot:1
+38 ;
+39 ;
IF LROOO=""
Begin DoDot:1
+40 IF 'MODE
SET STATUS="0^2^Already OOO"
+41 IF MODE
SET STATUS="0^3^Can't re-enable"
End DoDot:1
+42 ;
+43 KILL DIERR,LRFDA
+44 ;
IF LROOO'=""
Begin DoDot:1
+45 SET LRFDA(1,19,R19_",",2)=$TRANSLATE(LROOO,"^","~")
+46 DO FILE^DIE("","LRFDA(1)","LRMSG")
+47 SET STATUS=1
End DoDot:1
+48 QUIT STATUS
+49 ;
ENDDIOL(TXT,GBL,FMT,USENP,CHKABORT,ABORT,PGDATA) ;
+1 ; Substitute for EN^DDIOL API.
+2 ; Enhanced for pagination control.
+3 ; Inputs
+4 ; TXT:<byval><byref> Text to display
+5 ; GBL:<byval><opt> Global reference of text. (See EN^DDIOL)
+6 ; FMT:<opt> Format array. (See EN^DDIOL)
+7 ; USENP:<opt> Use NP (use pagination) 1=yes 0=no <dflt=0>
+8 ; CHKABORT:<opt> Check for user abort 1=check 0=dont <dflt=0>
+9 ; ABORT:<byref><opt> User abort status (output)
+10 ; PGDATA:<byref><opt> Page Data array (see NP^LRUTIL)
+11 ; Outputs
+12 ; Displays the text.
+13 ; ABORT:
+14 ; PGDATA:
+15 ;
+16 NEW NODE,ADDPRMPT
+17 SET GBL=$GET(GBL)
+18 SET FMT=$GET(FMT)
+19 SET USENP=$GET(USENP)
+20 SET CHKABORT=$GET(CHKABORT)
+21 ;
+22 ;
IF '$DATA(PGDATA)
Begin DoDot:1
+23 if CHKABORT
QUIT
+24 SET ADDPRMPT=1
+25 SET PGDATA("PROMPT")=$$TRIM^XLFSTR($$CJ^XLFSTR("'ENTER' to continue",$GET(IOM,80)," "),"R"," ")
End DoDot:1
+26 ;
IF 'USENP
Begin DoDot:1
+27 ;
IF $DATA(TXT)
Begin DoDot:2
+28 IF $DATA(TXT)=1
DO EN^DDIOL(TXT,"",FMT)
QUIT
+29 DO EN^DDIOL(.TXT)
End DoDot:2
+30 IF GBL'=""
DO EN^DDIOL("",GBL,FMT)
QUIT
End DoDot:1
+31 if 'USENP
QUIT
+32 ;
+33 ;
IF $DATA(TXT)
Begin DoDot:1
+34 IF $DATA(TXT)=1
SET TXT(.0000001)=TXT
+35 SET NODE="TXT(0)"
+36 ;
FOR
SET NODE=$QUERY(@NODE)
if NODE=""
QUIT
Begin DoDot:2
+37 DO EN^DDIOL(@NODE,"",$SELECT($DATA(TXT)=1:FMT,1:""))
+38 DO NP^LRUTIL(.ABORT,.PGDATA)
+39 IF CHKABORT
if ABORT
QUIT
End DoDot:2
if CHKABORT&ABORT
QUIT
+40 KILL TXT(.0000001)
End DoDot:1
if CHKABORT&ABORT
QUIT
+41 ;
+42 IF $GET(ADDPRMPT)
KILL PGDATA("PROMPT")
+43 QUIT
