XUXTADDILG ;ESL/JAC/CM - UTL Reusable FM DIALOG Calls #1 ; 06/26/2020@9:30
;;8.0;KERNEL;**807**;Oct 16, 2024;Build 56;
;
;
; External API'S
;
; XUXTAD API's
CENTER(AXUXTADTEXT,AXUXTADLF,AXUXTADRM,AXUXTADRVIDEO) D CENTER^XUXTADPRT1($G(AXUXTADTEXT),$G(AXUXTADLF),$G(AXUXTADRM),$G(AXUXTADRVIDEO)) Q
CONTINUE(AXUXTADLF,AXUXTADTYPE) D CONTINUE^XUXTADPRT1($G(AXUXTADLF),$G(AXUXTADTYPE)) Q
MSG(ADIFLGS,ADIOUT,ADIMARGIN,ADICOLUMN,ADIINNAME) D MSG^DIALOG($G(ADIFLGS),$G(ADIOUT),$G(ADIMARGIN),$G(ADICOLUMN),$G(ADIINNAME)) Q
;
;-- Integration Control Registrations
; Reference to MSG^DIALOG in ICR #2050
; Reference to CLEAN^DILF in ICR #2054
;
DIERR(XUXTADWIDTH,XUXTADLFTMAR,XUXTADMSGROOT,XUXTADFRMRTN,XUXTADNOPAUSE) ; Display DBS error messages.
; Call this subroutine after a database server API call. If DIERR
; is not detected, the API will return XUXTADQUIT=0 and quit; otherwise
; the error message will be displayed.
;
;-- Input:
; XUXTADWIDTH ; Required ; Maximum line length or text width
; for formatting the text.
; XUXTADLFTMAR ; Required ; Starting position of left margin for writing
; the text of the error message.
; XUXTADMSGROOT ; Optional ; Closed root of which the local input error
; message resides.
; XUXTADFRMRTN ; Optional ; Calling entry point that generates this
; error. For example: 'BUILD1^R2IVVUO1'.
; XUXTADNOPAUSE ; Optional ; If 1 don't pause screen output for user
; response, continue processing.
;
;-- Output:
; XUXTADQUIT ; 0 ; if everything is ok
; 1 ; when a required parameter is missing or a database
; server error was detected.
;
SET XUXTADQUIT=0 ; Initialize output flag XUXTADQUIT to successful (0).
S XUXTADFRMRTN=$G(XUXTADFRMRTN)
;
; Check for required input parameters
;
I '$G(XUXTADWIDTH)!('$G(XUXTADLFTMAR)) D Q
. I $E(IOST,1,2)="C-" D ; Output message only to a display screen.
. . NEW XUXTADERRMSG
. . S XUXTADERRMSG="One or more required input parameters are missing "
. . D CENTER(XUXTADERRMSG,2,IOM,1)
. . I XUXTADFRMRTN]"" D ;
. . . S XUXTADERRMSG="in calling routine "_XUXTADFRMRTN
. . . D CENTER(XUXTADERRMSG,1,IOM,1)
. . S XUXTADERRMSG="to the DIERR^R2IVVOAU API call"
. . D CENTER(XUXTADERRMSG,1,IOM,1)
. . Q:$G(XUXTADNOPAUSE) I $E(IOST,1,2)="C-" D CONTINUE(2,"R")
. SET XUXTADQUIT=1 ; Set return flag to unsuccessful
Q:'$G(DIERR) ; Quit if no database server error message detected.
;
; Display database server error message & cleanup message array
;
; Flags "WE":
; (W)rite text to current device
; (E)rror array text is processed
;
I $E(IOST,1,2)="C-" D ; Output message only to a display screen.
. W !
. I $G(XUXTADMSGROOT)]"" D MSG("WE",,XUXTADWIDTH,XUXTADLFTMAR,XUXTADMSGROOT)
. I $G(XUXTADMSGROOT)']"" D MSG("WE","",XUXTADWIDTH,XUXTADLFTMAR)
. I $G(XUXTADIENS)]"" W !,?XUXTADLFTMAR,"For IENS: ",XUXTADIENS D ;
. . Q:'$G(XUXTADFILE) W " file #",XUXTADFILE
. I $G(XUXTADIENS)]"" W !,?XUXTADLFTMAR,"For IENS: ",XUXTADIENS D ;
. . Q:'$G(XUXTADFILE) W " file #",XUXTADFILE
. I XUXTADFRMRTN]"" W !,?XUXTADLFTMAR,"Error generated from "_XUXTADFRMRTN_"."
. Q:$G(XUXTADNOPAUSE) I $E(IOST,1,2)="C-" D CONTINUE(2,"R")
D CLEAN^DILF ; Kills standard ^TMP DBS global and local variables.
I $G(XUXTADMSGROOT)]"" KILL @XUXTADMSGROOT ; Cleanup local message array
SET XUXTADQUIT=1 ; Set return flag to unsuccessful
Q ; DIERR
;
;XUXTADDILG ;ESL/JAC/cm - UTL Reusable FM DIALOG Calls #1 ; 06/26/2020 09:30
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUXTADDILG 3679 printed Sep 23, 2025@19:50:34 Page 2
XUXTADDILG ;ESL/JAC/CM - UTL Reusable FM DIALOG Calls #1 ; 06/26/2020@9:30
+1 ;;8.0;KERNEL;**807**;Oct 16, 2024;Build 56;
+2 ;
+3 ;
+4 ; External API'S
+5 ;
+6 ; XUXTAD API's
CENTER(AXUXTADTEXT,AXUXTADLF,AXUXTADRM,AXUXTADRVIDEO) DO CENTER^XUXTADPRT1($GET(AXUXTADTEXT),$GET(AXUXTADLF),$GET(AXUXTADRM),$GET(AXUXTADRVIDEO))
QUIT
CONTINUE(AXUXTADLF,AXUXTADTYPE) DO CONTINUE^XUXTADPRT1($GET(AXUXTADLF),$GET(AXUXTADTYPE))
QUIT
MSG(ADIFLGS,ADIOUT,ADIMARGIN,ADICOLUMN,ADIINNAME) DO MSG^DIALOG($GET(ADIFLGS),$GET(ADIOUT),$GET(ADIMARGIN),$GET(ADICOLUMN),$GET(ADIINNAME))
QUIT
+1 ;
+2 ;-- Integration Control Registrations
+3 ; Reference to MSG^DIALOG in ICR #2050
+4 ; Reference to CLEAN^DILF in ICR #2054
+5 ;
DIERR(XUXTADWIDTH,XUXTADLFTMAR,XUXTADMSGROOT,XUXTADFRMRTN,XUXTADNOPAUSE) ; Display DBS error messages.
+1 ; Call this subroutine after a database server API call. If DIERR
+2 ; is not detected, the API will return XUXTADQUIT=0 and quit; otherwise
+3 ; the error message will be displayed.
+4 ;
+5 ;-- Input:
+6 ; XUXTADWIDTH ; Required ; Maximum line length or text width
+7 ; for formatting the text.
+8 ; XUXTADLFTMAR ; Required ; Starting position of left margin for writing
+9 ; the text of the error message.
+10 ; XUXTADMSGROOT ; Optional ; Closed root of which the local input error
+11 ; message resides.
+12 ; XUXTADFRMRTN ; Optional ; Calling entry point that generates this
+13 ; error. For example: 'BUILD1^R2IVVUO1'.
+14 ; XUXTADNOPAUSE ; Optional ; If 1 don't pause screen output for user
+15 ; response, continue processing.
+16 ;
+17 ;-- Output:
+18 ; XUXTADQUIT ; 0 ; if everything is ok
+19 ; 1 ; when a required parameter is missing or a database
+20 ; server error was detected.
+21 ;
+22 ; Initialize output flag XUXTADQUIT to successful (0).
SET XUXTADQUIT=0
+23 SET XUXTADFRMRTN=$GET(XUXTADFRMRTN)
+24 ;
+25 ; Check for required input parameters
+26 ;
+27 IF '$GET(XUXTADWIDTH)!('$GET(XUXTADLFTMAR))
Begin DoDot:1
+28 ; Output message only to a display screen.
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+29 NEW XUXTADERRMSG
+30 SET XUXTADERRMSG="One or more required input parameters are missing "
+31 DO CENTER(XUXTADERRMSG,2,IOM,1)
+32 ;
IF XUXTADFRMRTN]""
Begin DoDot:3
+33 SET XUXTADERRMSG="in calling routine "_XUXTADFRMRTN
+34 DO CENTER(XUXTADERRMSG,1,IOM,1)
End DoDot:3
+35 SET XUXTADERRMSG="to the DIERR^R2IVVOAU API call"
+36 DO CENTER(XUXTADERRMSG,1,IOM,1)
+37 if $GET(XUXTADNOPAUSE)
QUIT
IF $EXTRACT(IOST,1,2)="C-"
DO CONTINUE(2,"R")
End DoDot:2
+38 ; Set return flag to unsuccessful
SET XUXTADQUIT=1
End DoDot:1
QUIT
+39 ; Quit if no database server error message detected.
if '$GET(DIERR)
QUIT
+40 ;
+41 ; Display database server error message & cleanup message array
+42 ;
+43 ; Flags "WE":
+44 ; (W)rite text to current device
+45 ; (E)rror array text is processed
+46 ;
+47 ; Output message only to a display screen.
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+48 WRITE !
+49 IF $GET(XUXTADMSGROOT)]""
DO MSG("WE",,XUXTADWIDTH,XUXTADLFTMAR,XUXTADMSGROOT)
+50 IF $GET(XUXTADMSGROOT)']""
DO MSG("WE","",XUXTADWIDTH,XUXTADLFTMAR)
+51 ;
IF $GET(XUXTADIENS)]""
WRITE !,?XUXTADLFTMAR,"For IENS: ",XUXTADIENS
Begin DoDot:2
+52 if '$GET(XUXTADFILE)
QUIT
WRITE " file #",XUXTADFILE
End DoDot:2
+53 ;
IF $GET(XUXTADIENS)]""
WRITE !,?XUXTADLFTMAR,"For IENS: ",XUXTADIENS
Begin DoDot:2
+54 if '$GET(XUXTADFILE)
QUIT
WRITE " file #",XUXTADFILE
End DoDot:2
+55 IF XUXTADFRMRTN]""
WRITE !,?XUXTADLFTMAR,"Error generated from "_XUXTADFRMRTN_"."
+56 if $GET(XUXTADNOPAUSE)
QUIT
IF $EXTRACT(IOST,1,2)="C-"
DO CONTINUE(2,"R")
End DoDot:1
+57 ; Kills standard ^TMP DBS global and local variables.
DO CLEAN^DILF
+58 ; Cleanup local message array
IF $GET(XUXTADMSGROOT)]""
KILL @XUXTADMSGROOT
+59 ; Set return flag to unsuccessful
SET XUXTADQUIT=1
+60 ; DIERR
QUIT
+61 ;
+62 ;XUXTADDILG ;ESL/JAC/cm - UTL Reusable FM DIALOG Calls #1 ; 06/26/2020 09:30
