XUXTADSSE ;ESL/JAC/CM - Service/Section Edit ; JUN 26, 2020@9:30
;;8.0;KERNEL;**807**;Oct 16, 2024;Build 56;
;
;
; External API'S
;
; XUXTAD API's
SHOWOPT(AXUXTADOPTION) D SHOWOPT^XUXTADPRT2($G(AXUXTADOPTION)) Q
SHOWGOAL(XUXTADRTN) D SHOWGOAL^XUXTADPRT2($G(XUXTADRTN)) Q
CONTINUE(AXUXTADLF,AXUXTADTYPE) D CONTINUE^XUXTADPRT1($G(AXUXTADLF),$G(AXUXTADTYPE)) Q
ASKYESNO(AYESNOPROMPT,AXUXTADDEF) Q $$ASKYESNO^XUXTADASK1($G(AYESNOPROMPT),$G(AXUXTADDEF))
;
; FileMan/ScreenMan API's
FMDIC D ^DIC Q
SMDDS D ^DDS Q
;
;
;-- Integration Control Registrations
; Reference to ^DDS in ICR #10031
; Reference to ^DIC in ICR #10006
;
; From option: Service/Section Edit [XUXTAD SERVICE/SECTION EDIT]
;
GOAL ;; Display the goal of this routine.
;; Purpose (or goal)
;;
;; This option was created in support of the CPRS Parameter Definition
;; 'ORB FORWARD SUPERVISOR'. This parameter value documents the number of
;; days before a notification is forwarded to a recipient's supervisor for
;; an unprocessed clinical alert.
;;
;; Determination of recipients who have not processed the notification and
;; who their supervisors are is made by the Kernel Alert Utility.
;;
;; The CHIEF (or SUPERVISOR) field associated with the user's SERVICE/SECTION
;; entry will be utilized by the Kernel Alert Utility for this important
;; clinical notification process.
;;
;;*** END ***
;
; Requested by:
; Franklin Scott, RN-BC, MSN
; Chief Health Informatics Officer
; Central Texas VHCS
; (254) 742-4951 Office
; (254) 379-0791 Cell
;
; Others consulted:
; Emily Mellecker, IT Specialist (Systems Analyst),
; Service Operations - Infrastructure Operations
; Patti Howard, IT Analyst, R2 Applications, VistA
; Service Operation - Enterprise Command Center
;
ENTER ; Allow the ADPAC to update CHIEF of the SERVICE/SECTION file (#49)
;
; From option: Service/Section Edit [XUXTAD SERVICE/SECTION EDIT]
;
NEW XUXTADGOAL,XUXTADOPTION,XUXTADQUIT,XUXTADXUDA,XUXTADSSFILE
;
S XUXTADOPTION="SERVICE/SECTION EDIT"
S XUXTADQUIT=0 ; Quit flag, set to 1 when it is time to terminate routine
S XUXTADSSFILE=49 ; File number of SERVICE/SECTION file
;
D SHOWOPT(XUXTADOPTION) ; Display menu text
D ASKGOAL G:XUXTADQUIT EXIT ; Return: XUXTADGOAL ; Y,N, or '^'
D:XUXTADGOAL="Y" SHOWGOAL($T(+0)) ; Display goal to user
;
PROMPT ; Begin & loopback entry point
;
D SHOWOPT(XUXTADOPTION) W ! ; Display menu text
D GETSVC(XUXTADSSFILE) G:XUXTADQUIT EXIT ;
;
START ; Call the FM ScreenMan SERVICE/SECTION EDIT form
;
D EDIT(XUXTADSSFILE,XUXTADXUDA) G:XUXTADQUIT PROMPT
;
G PROMPT ; Loopback to PROMPT, allow editing another (or same) entry
;
EXIT ; Exit option
KILL ^TMP("SS",$J)
Q ; Quit Routine XUXTADXUSSE
;
ASKGOAL ;Prompt to determine if user want to see purpose/goal of option
;-- Input:
; XUXTADRTN ; Use $T(+0) or calling routine name
;-- Output:
; XUXTADGOAL ; Y to include only users that are not cloned
; N to process only cloned and non-cloned users
; ^ if user up-arrows out
; XUXTADQUIT ; Set to 1 if the user up-arrows out
NEW XUXTADDEF
;
S XUXTADQUIT=0 ; Routine quit processing variable initialed to No (0)
I $D(XUXTADGOAL) Q
E S XUXTADDEF="Y"
W !
S XUXTADGOAL=$$ASKYESNO(" Display goal of this option",$S(XUXTADDEF="Y":"YES",XUXTADDEF="N":"NO",1:""))
I XUXTADGOAL["^" S XUXTADQUIT=1 Q
Q ; Quit ASKGOAL
;
DDSERR ; Display FM ScreenMan error(s)
;
NEW XUXTADNUM
;
W @IOF,!!
;
S XUXTADNUM=0 ; Display any FM ScreenMan error(s)
F S XUXTADNUM=$O(^TMP("DIERR",$J,1,"TEXT",XUXTADNUM)) Q:'XUXTADNUM D ;
. W !,?1,^TMP("DIERR",$J,1,"TEXT",XUXTADNUM)
;
D CONTINUE(2,"R")
;
KILL ^TMP("DIERR",$J)
Q ; Quit DDSERR
;
EDIT(XUXTADXUFILE,XUXTADXUDA) ; Edit SERVICE/SECTION ScreenMan form
;-- Input:
; XUXTADXUFILE ; Required ; 49 (File number for SERVICE/SECTION file)
; XUXTADXUDA ; Required ; IEN of the SERVICE/SECTION entry to edit
;-- Output:
; XUXTADQUIT ; Set to 1 if a FM ScreenMan error was detected.
;
NEW %,DA,DDSCHANG,DDSFILE,DDSPAGE,DDSPARM,DDSSAVE,DIERR,DIMSG
NEW DINUM,DILOCKTM,DR,DTOUT,DUTOUT,I,IOPAR,IOUPAR
;
S DDSFILE=XUXTADXUFILE ; SERVICE/SECTION file (#49)
S DA=XUXTADXUDA ; IEN of the SERVICE/SECTION file entry
S DR="[XUXTAD "_XUXTADOPTION_"]" ; Name of ScreenMan form
; ScreenMan (DDS) Parameters:
; C ; Return DDSCHANG=1 if user made a change to the database entry
; E ; Return Error messages in ^TMP("DIERR",$J & DIERR if ScreenMan
; encounters problems when initially loading the form
; S ; Return DDSAVE=1 if user issued some form of a Save, whether
; or not any changes to the database were made.
S DDSPARM="CES" ; See ScreenMan (DDS) Parameters (above)
S DDSPAGE=1 ;.... Start with Page 1
D SMDDS ;......... Execute ScreenMan form
I $G(DIERR) D DDSERR S XUXTADQUIT=1 Q ; Process error & quit
Q ; Quit EDIT
;
GETSVC(XUXTADXUFILE) ; Ask/prompt for SERVICE/SECTION using DIC utility call
;-- Output:
; XUXTADXUDA ; Internal entry number of the SERVICE/SECTION file (#49)
; or return null if error detected
; XUXTADQUIT ; Set to 1 when an error is detected, otherwise 0
;
NEW %,C,D,D0,DA,DBT,DDH,DG,DIC,DILN,DINUM,DIPGM
NEW DISYS,DIY,DST,DTOUT,DUOUT,DZ,I,X,Y
;
KILL XUXTADXUDA ; Refresh output variable do to multiple executions
S DIC="^DIC("_XUXTADXUFILE_","
S DIC(0)="AEMQ"
S DIC("A")="Select SERVICE/SECTION NAME: "
;
D FMDIC
I X["^" S XUXTADQUIT=2 Q ; XUXTADQUIT=2 when user enters an '^'
I Y<0 S XUXTADQUIT=1 Q
S XUXTADXUDA=$P(Y,U) ; IEN of the selected SERVICE/SECTION entry
Q ; Quit GETSVC
;
;ESL/JAC/cm - Service/Section Edit
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUXTADSSE 5883 printed Jan 29, 2026@15:13:07 Page 2
XUXTADSSE ;ESL/JAC/CM - Service/Section Edit ; JUN 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
SHOWOPT(AXUXTADOPTION) DO SHOWOPT^XUXTADPRT2($GET(AXUXTADOPTION))
QUIT
SHOWGOAL(XUXTADRTN) DO SHOWGOAL^XUXTADPRT2($GET(XUXTADRTN))
QUIT
CONTINUE(AXUXTADLF,AXUXTADTYPE) DO CONTINUE^XUXTADPRT1($GET(AXUXTADLF),$GET(AXUXTADTYPE))
QUIT
ASKYESNO(AYESNOPROMPT,AXUXTADDEF) QUIT $$ASKYESNO^XUXTADASK1($GET(AYESNOPROMPT),$GET(AXUXTADDEF))
+1 ;
+2 ; FileMan/ScreenMan API's
FMDIC DO ^DIC
QUIT
SMDDS DO ^DDS
QUIT
+1 ;
+2 ;
+3 ;-- Integration Control Registrations
+4 ; Reference to ^DDS in ICR #10031
+5 ; Reference to ^DIC in ICR #10006
+6 ;
+7 ; From option: Service/Section Edit [XUXTAD SERVICE/SECTION EDIT]
+8 ;
GOAL ;; Display the goal of this routine.
+1 ;; Purpose (or goal)
+2 ;;
+3 ;; This option was created in support of the CPRS Parameter Definition
+4 ;; 'ORB FORWARD SUPERVISOR'. This parameter value documents the number of
+5 ;; days before a notification is forwarded to a recipient's supervisor for
+6 ;; an unprocessed clinical alert.
+7 ;;
+8 ;; Determination of recipients who have not processed the notification and
+9 ;; who their supervisors are is made by the Kernel Alert Utility.
+10 ;;
+11 ;; The CHIEF (or SUPERVISOR) field associated with the user's SERVICE/SECTION
+12 ;; entry will be utilized by the Kernel Alert Utility for this important
+13 ;; clinical notification process.
+14 ;;
+15 ;;*** END ***
+16 ;
+17 ; Requested by:
+18 ; Franklin Scott, RN-BC, MSN
+19 ; Chief Health Informatics Officer
+20 ; Central Texas VHCS
+21 ; (254) 742-4951 Office
+22 ; (254) 379-0791 Cell
+23 ;
+24 ; Others consulted:
+25 ; Emily Mellecker, IT Specialist (Systems Analyst),
+26 ; Service Operations - Infrastructure Operations
+27 ; Patti Howard, IT Analyst, R2 Applications, VistA
+28 ; Service Operation - Enterprise Command Center
+29 ;
ENTER ; Allow the ADPAC to update CHIEF of the SERVICE/SECTION file (#49)
+1 ;
+2 ; From option: Service/Section Edit [XUXTAD SERVICE/SECTION EDIT]
+3 ;
+4 NEW XUXTADGOAL,XUXTADOPTION,XUXTADQUIT,XUXTADXUDA,XUXTADSSFILE
+5 ;
+6 SET XUXTADOPTION="SERVICE/SECTION EDIT"
+7 ; Quit flag, set to 1 when it is time to terminate routine
SET XUXTADQUIT=0
+8 ; File number of SERVICE/SECTION file
SET XUXTADSSFILE=49
+9 ;
+10 ; Display menu text
DO SHOWOPT(XUXTADOPTION)
+11 ; Return: XUXTADGOAL ; Y,N, or '^'
DO ASKGOAL
if XUXTADQUIT
GOTO EXIT
+12 ; Display goal to user
if XUXTADGOAL="Y"
DO SHOWGOAL($TEXT(+0))
+13 ;
PROMPT ; Begin & loopback entry point
+1 ;
+2 ; Display menu text
DO SHOWOPT(XUXTADOPTION)
WRITE !
+3 ;
DO GETSVC(XUXTADSSFILE)
if XUXTADQUIT
GOTO EXIT
+4 ;
START ; Call the FM ScreenMan SERVICE/SECTION EDIT form
+1 ;
+2 DO EDIT(XUXTADSSFILE,XUXTADXUDA)
if XUXTADQUIT
GOTO PROMPT
+3 ;
+4 ; Loopback to PROMPT, allow editing another (or same) entry
GOTO PROMPT
+5 ;
EXIT ; Exit option
+1 KILL ^TMP("SS",$JOB)
+2 ; Quit Routine XUXTADXUSSE
QUIT
+3 ;
ASKGOAL ;Prompt to determine if user want to see purpose/goal of option
+1 ;-- Input:
+2 ; XUXTADRTN ; Use $T(+0) or calling routine name
+3 ;-- Output:
+4 ; XUXTADGOAL ; Y to include only users that are not cloned
+5 ; N to process only cloned and non-cloned users
+6 ; ^ if user up-arrows out
+7 ; XUXTADQUIT ; Set to 1 if the user up-arrows out
+8 NEW XUXTADDEF
+9 ;
+10 ; Routine quit processing variable initialed to No (0)
SET XUXTADQUIT=0
+11 IF $DATA(XUXTADGOAL)
QUIT
+12 IF '$TEST
SET XUXTADDEF="Y"
+13 WRITE !
+14 SET XUXTADGOAL=$$ASKYESNO(" Display goal of this option",$SELECT(XUXTADDEF="Y":"YES",XUXTADDEF="N":"NO",1:""))
+15 IF XUXTADGOAL["^"
SET XUXTADQUIT=1
QUIT
+16 ; Quit ASKGOAL
QUIT
+17 ;
DDSERR ; Display FM ScreenMan error(s)
+1 ;
+2 NEW XUXTADNUM
+3 ;
+4 WRITE @IOF,!!
+5 ;
+6 ; Display any FM ScreenMan error(s)
SET XUXTADNUM=0
+7 ;
FOR
SET XUXTADNUM=$ORDER(^TMP("DIERR",$JOB,1,"TEXT",XUXTADNUM))
if 'XUXTADNUM
QUIT
Begin DoDot:1
+8 WRITE !,?1,^TMP("DIERR",$JOB,1,"TEXT",XUXTADNUM)
End DoDot:1
+9 ;
+10 DO CONTINUE(2,"R")
+11 ;
+12 KILL ^TMP("DIERR",$JOB)
+13 ; Quit DDSERR
QUIT
+14 ;
EDIT(XUXTADXUFILE,XUXTADXUDA) ; Edit SERVICE/SECTION ScreenMan form
+1 ;-- Input:
+2 ; XUXTADXUFILE ; Required ; 49 (File number for SERVICE/SECTION file)
+3 ; XUXTADXUDA ; Required ; IEN of the SERVICE/SECTION entry to edit
+4 ;-- Output:
+5 ; XUXTADQUIT ; Set to 1 if a FM ScreenMan error was detected.
+6 ;
+7 NEW %,DA,DDSCHANG,DDSFILE,DDSPAGE,DDSPARM,DDSSAVE,DIERR,DIMSG
+8 NEW DINUM,DILOCKTM,DR,DTOUT,DUTOUT,I,IOPAR,IOUPAR
+9 ;
+10 ; SERVICE/SECTION file (#49)
SET DDSFILE=XUXTADXUFILE
+11 ; IEN of the SERVICE/SECTION file entry
SET DA=XUXTADXUDA
+12 ; Name of ScreenMan form
SET DR="[XUXTAD "_XUXTADOPTION_"]"
+13 ; ScreenMan (DDS) Parameters:
+14 ; C ; Return DDSCHANG=1 if user made a change to the database entry
+15 ; E ; Return Error messages in ^TMP("DIERR",$J & DIERR if ScreenMan
+16 ; encounters problems when initially loading the form
+17 ; S ; Return DDSAVE=1 if user issued some form of a Save, whether
+18 ; or not any changes to the database were made.
+19 ; See ScreenMan (DDS) Parameters (above)
SET DDSPARM="CES"
+20 ;.... Start with Page 1
SET DDSPAGE=1
+21 ;......... Execute ScreenMan form
DO SMDDS
+22 ; Process error & quit
IF $GET(DIERR)
DO DDSERR
SET XUXTADQUIT=1
QUIT
+23 ; Quit EDIT
QUIT
+24 ;
GETSVC(XUXTADXUFILE) ; Ask/prompt for SERVICE/SECTION using DIC utility call
+1 ;-- Output:
+2 ; XUXTADXUDA ; Internal entry number of the SERVICE/SECTION file (#49)
+3 ; or return null if error detected
+4 ; XUXTADQUIT ; Set to 1 when an error is detected, otherwise 0
+5 ;
+6 NEW %,C,D,D0,DA,DBT,DDH,DG,DIC,DILN,DINUM,DIPGM
+7 NEW DISYS,DIY,DST,DTOUT,DUOUT,DZ,I,X,Y
+8 ;
+9 ; Refresh output variable do to multiple executions
KILL XUXTADXUDA
+10 SET DIC="^DIC("_XUXTADXUFILE_","
+11 SET DIC(0)="AEMQ"
+12 SET DIC("A")="Select SERVICE/SECTION NAME: "
+13 ;
+14 DO FMDIC
+15 ; XUXTADQUIT=2 when user enters an '^'
IF X["^"
SET XUXTADQUIT=2
QUIT
+16 IF Y<0
SET XUXTADQUIT=1
QUIT
+17 ; IEN of the selected SERVICE/SECTION entry
SET XUXTADXUDA=$PIECE(Y,U)
+18 ; Quit GETSVC
QUIT
+19 ;
+20 ;ESL/JAC/cm - Service/Section Edit
+21 ;
