XUHUI ;SFISC/SO-Main Field Event Trigger Routine ;1:05 PM 7 Nov 2002
;;8.0;KERNEL;**236,266**;Jul 10, 1995
;This routine comprised three(3) entry points:
;HUI(), HUIKEY(), and OPKG()
;
;PCHK1: Is the business rules check used for the top level for file
;#200, called from AXUHUI xref.
;
;PCHK2: Is the business rules check ussed for the KEYS multiple
;sub-file #200.051
;
;GETVAR: Sets up the variables that are passed thru
;TaskMan to the various options that are to be unwound.
;
;TASK: Sets up the variable list that is to be passed
;thru TaskMan and tasks the job.
;
;CLEAN: Kills any Name Spaced variables that are not implisivly Newed
;
HUI(XUHUIOP,XUHUINM,XUHUIA,XUHUIXR) ;This is the HUI Entry Point
;XUHUIOP tells the Unwinder to use either 101 for Protocol file or
; 19 for Option file, default = 101
;XUHUINM is the Name(#.01) value of the option to launched
;XUHUIA is a code S = Set xref; K = Kill xref; default = S
;XUHUIXR is the name of the xref
;
N ESC S ESC=0
D PCHK1 Q:ESC
D GETVAR
D TASK
D CLEAN
Q
;
GETVAR ; Get the variables that are to be passed via Taskman
S XUHUIFIL=DIFILE ;File #, IA #3586
I $D(DIFLD) M XUHUIFLD=DIFLD ;Field #, IA# 3586
I '$D(DIFLD) S XUHUIFLD=""
S XUHUIXR=$G(XUHUIXR)
M XUHUIDA=DA ;IEN(s) of record, IA# 3586
M XUHUIX=X ;New Style 'X' array
M XUHUIX1=X1
M XUHUIX2=X2
Q
;
TASK ;Creat a task
;Check to see if Protocol DISABLED ;266
N ESC
S ESC=0
I 'XUHUIOP D Q:ESC
. N IEN,DISABLE
. D CLEAN^DILF
. S IEN=$$FIND1^DIC(101,"","X",XUHUINM)
. I $D(DIERR) D CLEAN^DILF S ESC=1 Q
. D CLEAN^DILF
. S DISABLE=$$GET1^DIQ(101,IEN_",",2)
. I $D(DIERR) D CLEAN^DILF S ESC=1 Q
. D CLEAN^DILF
. I DISABLE'="" S ESC=1 ;Protocol is DISABLED
. Q
N ZTSAVE,ZTDTH,ZTIO,ZTRTN,ZTDESC,ZTREQ,ZTSK ;266
S XUHUIA=$S('$D(XUHUIA):"S",XUHUIA="":"S",1:XUHUIA)
S ZTSAVE("XUHUIA")=""
S ZTSAVE("XUHUIFIL")=""
S ZTSAVE("XUHUIFLD")=""
S ZTSAVE("XUHUIXR")=""
S ZTSAVE("XUHUIDA*")=""
S ZTSAVE("XUHUIX*")=""
S ZTSAVE("XUHUINM")="" ;Name of top level Protocol or Option
S XUHUIOP=$S('$D(XUHUIOP):101,XUHUIOP="":101,1:XUHUIOP)
S ZTSAVE("XUHUIOP")=""
S ZTDTH=$H,ZTIO="",ZTRTN="DEQUE^XUHUI",ZTREQ="@"
S ZTDESC="TASKED FIELD CHANGED EVENT ("_$S(XUHUIA="S":"SET)",1:"KILL)")
D ^%ZTLOAD
Q
;
DEQUE ;From: TaskMan
S X=XUHUINM
S DIC=$S(XUHUIOP=101:"^ORD(101,",XUHUIOP=19:"^DIC(19,",1:"")
D EN^XQOR
D CLEAN ; Kill off XUHUI* variables that are passed via Taskman
Q
;
HUIKEY(XUHUIOP,XUHUINM,XUHUIA,XUHUIXR) ;HUI Key check Entry Point
;XUHUIOP tells the Unwinder to use either 101 for Protocol file or
; 19 for Option file, default = 101
;XUHUINM is the Name(#.01) value of the option to launched
;XUHUIA is a code S = Set xref; K = Kill xref; default = S
;XUHUIXR is the name of the xref
N ESC S ESC=0
D PCHK2 Q:ESC
D GETVAR
D TASK
D CLEAN
Q
;
OPKG(XUHUIOP,XUHUINM,XUHUIA,XUHUIXR) ;All Other Package Entry Point
;XUHUIOP tells the Unwinder to use either 101 for Protocol file or
; 19 for Option file, default = 101
;XUHUINM is the Name(#.01) value of the option to launched
;XUHUIA is a code S = Set xref; K = Kill xref; default = S
;XUHUIXR is the name of the xref
D GETVAR
D TASK
D CLEAN
Q
;
PCHK1 ;
I '$D(^XUSEC("PROVIDER",DA))#2 S ESC=1 Q ;User is not a Provider
Q
;
PCHK2 ;
I $P($G(^DIC(19.1,DA,0)),"^")'="PROVIDER" S ESC=1 Q ;Key Not the PROVIDER key ;266
Q
;
CLEAN ;Kill of XUHUI variables
K XUHUIFIL,XUHUIFLD,XUHUIDA,XUHUIX,XUHUIX1,XUHUIX2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUHUI 3571 printed Dec 13, 2024@02:09:34 Page 2
XUHUI ;SFISC/SO-Main Field Event Trigger Routine ;1:05 PM 7 Nov 2002
+1 ;;8.0;KERNEL;**236,266**;Jul 10, 1995
+2 ;This routine comprised three(3) entry points:
+3 ;HUI(), HUIKEY(), and OPKG()
+4 ;
+5 ;PCHK1: Is the business rules check used for the top level for file
+6 ;#200, called from AXUHUI xref.
+7 ;
+8 ;PCHK2: Is the business rules check ussed for the KEYS multiple
+9 ;sub-file #200.051
+10 ;
+11 ;GETVAR: Sets up the variables that are passed thru
+12 ;TaskMan to the various options that are to be unwound.
+13 ;
+14 ;TASK: Sets up the variable list that is to be passed
+15 ;thru TaskMan and tasks the job.
+16 ;
+17 ;CLEAN: Kills any Name Spaced variables that are not implisivly Newed
+18 ;
HUI(XUHUIOP,XUHUINM,XUHUIA,XUHUIXR) ;This is the HUI Entry Point
+1 ;XUHUIOP tells the Unwinder to use either 101 for Protocol file or
+2 ; 19 for Option file, default = 101
+3 ;XUHUINM is the Name(#.01) value of the option to launched
+4 ;XUHUIA is a code S = Set xref; K = Kill xref; default = S
+5 ;XUHUIXR is the name of the xref
+6 ;
+7 NEW ESC
SET ESC=0
+8 DO PCHK1
if ESC
QUIT
+9 DO GETVAR
+10 DO TASK
+11 DO CLEAN
+12 QUIT
+13 ;
GETVAR ; Get the variables that are to be passed via Taskman
+1 ;File #, IA #3586
SET XUHUIFIL=DIFILE
+2 ;Field #, IA# 3586
IF $DATA(DIFLD)
MERGE XUHUIFLD=DIFLD
+3 IF '$DATA(DIFLD)
SET XUHUIFLD=""
+4 SET XUHUIXR=$GET(XUHUIXR)
+5 ;IEN(s) of record, IA# 3586
MERGE XUHUIDA=DA
+6 ;New Style 'X' array
MERGE XUHUIX=X
+7 MERGE XUHUIX1=X1
+8 MERGE XUHUIX2=X2
+9 QUIT
+10 ;
TASK ;Creat a task
+1 ;Check to see if Protocol DISABLED ;266
+2 NEW ESC
+3 SET ESC=0
+4 IF 'XUHUIOP
Begin DoDot:1
+5 NEW IEN,DISABLE
+6 DO CLEAN^DILF
+7 SET IEN=$$FIND1^DIC(101,"","X",XUHUINM)
+8 IF $DATA(DIERR)
DO CLEAN^DILF
SET ESC=1
QUIT
+9 DO CLEAN^DILF
+10 SET DISABLE=$$GET1^DIQ(101,IEN_",",2)
+11 IF $DATA(DIERR)
DO CLEAN^DILF
SET ESC=1
QUIT
+12 DO CLEAN^DILF
+13 ;Protocol is DISABLED
IF DISABLE'=""
SET ESC=1
+14 QUIT
End DoDot:1
if ESC
QUIT
+15 ;266
NEW ZTSAVE,ZTDTH,ZTIO,ZTRTN,ZTDESC,ZTREQ,ZTSK
+16 SET XUHUIA=$SELECT('$DATA(XUHUIA):"S",XUHUIA="":"S",1:XUHUIA)
+17 SET ZTSAVE("XUHUIA")=""
+18 SET ZTSAVE("XUHUIFIL")=""
+19 SET ZTSAVE("XUHUIFLD")=""
+20 SET ZTSAVE("XUHUIXR")=""
+21 SET ZTSAVE("XUHUIDA*")=""
+22 SET ZTSAVE("XUHUIX*")=""
+23 ;Name of top level Protocol or Option
SET ZTSAVE("XUHUINM")=""
+24 SET XUHUIOP=$SELECT('$DATA(XUHUIOP):101,XUHUIOP="":101,1:XUHUIOP)
+25 SET ZTSAVE("XUHUIOP")=""
+26 SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTRTN="DEQUE^XUHUI"
SET ZTREQ="@"
+27 SET ZTDESC="TASKED FIELD CHANGED EVENT ("_$SELECT(XUHUIA="S":"SET)",1:"KILL)")
+28 DO ^%ZTLOAD
+29 QUIT
+30 ;
DEQUE ;From: TaskMan
+1 SET X=XUHUINM
+2 SET DIC=$SELECT(XUHUIOP=101:"^ORD(101,",XUHUIOP=19:"^DIC(19,",1:"")
+3 DO EN^XQOR
+4 ; Kill off XUHUI* variables that are passed via Taskman
DO CLEAN
+5 QUIT
+6 ;
HUIKEY(XUHUIOP,XUHUINM,XUHUIA,XUHUIXR) ;HUI Key check Entry Point
+1 ;XUHUIOP tells the Unwinder to use either 101 for Protocol file or
+2 ; 19 for Option file, default = 101
+3 ;XUHUINM is the Name(#.01) value of the option to launched
+4 ;XUHUIA is a code S = Set xref; K = Kill xref; default = S
+5 ;XUHUIXR is the name of the xref
+6 NEW ESC
SET ESC=0
+7 DO PCHK2
if ESC
QUIT
+8 DO GETVAR
+9 DO TASK
+10 DO CLEAN
+11 QUIT
+12 ;
OPKG(XUHUIOP,XUHUINM,XUHUIA,XUHUIXR) ;All Other Package Entry Point
+1 ;XUHUIOP tells the Unwinder to use either 101 for Protocol file or
+2 ; 19 for Option file, default = 101
+3 ;XUHUINM is the Name(#.01) value of the option to launched
+4 ;XUHUIA is a code S = Set xref; K = Kill xref; default = S
+5 ;XUHUIXR is the name of the xref
+6 DO GETVAR
+7 DO TASK
+8 DO CLEAN
+9 QUIT
+10 ;
PCHK1 ;
+1 ;User is not a Provider
IF '$DATA(^XUSEC("PROVIDER",DA))#2
SET ESC=1
QUIT
+2 QUIT
+3 ;
PCHK2 ;
+1 ;Key Not the PROVIDER key ;266
IF $PIECE($GET(^DIC(19.1,DA,0)),"^")'="PROVIDER"
SET ESC=1
QUIT
+2 QUIT
+3 ;
CLEAN ;Kill of XUHUI variables
+1 KILL XUHUIFIL,XUHUIFLD,XUHUIDA,XUHUIX,XUHUIX1,XUHUIX2
+2 QUIT
