- 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 Jan 18, 2025@03:10:45 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