FSCAFFIL ;SLC/STAFF-NOIS Affiliation ;1/17/98 16:50
;;1.1;NOIS;;Sep 06, 1998
;
AFFIL(CALL) ; from FSCTASKA
N ADD,REMOVE K ADD,REMOVE
D CLEAN(CALL,.REMOVE,.ADD)
I $O(REMOVE(0)) D DEL(.REMOVE)
I $O(ADD(0)) D NEW(CALL,.ADD)
K ADD,REMOVE
Q
;
CLEAN(CALL,REMOVE,ADD) ;
N EVENT,METHOD,MISC,NEVENT,NMETHOD,NOTNUM,PACK,PACKGP,RTD,SPEC,USER
D CINFO(CALL,.PACK,.PACKGP,.MISC,.RTD,.SPEC)
S USER=0 F S USER=$O(^FSCD("NOTIFY","ACUSER",CALL,USER)) Q:USER'>0 S NOTNUM=+^(USER) I NOTNUM D
.I $P($G(^FSCD("NOTIFY",NOTNUM,0)),U,7) Q
.I '$D(^FSC("SPEC",USER,0)) Q ; ** should not be processing non spec
.D SINFO(USER,.METHOD,.EVENT)
.I '$L(METHOD) S REMOVE(USER)=NOTNUM Q
.I '$L(EVENT) S REMOVE(USER)=NOTNUM Q
.I USER'=SPEC D
..I '$$CHECK(USER,PACK,PACKGP) S REMOVE(USER)=NOTNUM Q
..I MISC,$D(^FSC("SPEC","AF",1,USER)) S REMOVE(USER)=NOTNUM
.I $D(REMOVE(USER)) Q
.D NINFO(NOTNUM,.NMETHOD,.NEVENT)
.I NMETHOD'=METHOD S $P(^FSCD("NOTIFY",NOTNUM,0),U,5)=METHOD
.I NEVENT'=EVENT S $P(^FSCD("NOTIFY",NOTNUM,0),U,6)=EVENT
I SPEC,'$D(^FSCD("NOTIFY","ACUSER",CALL,SPEC)) D CHKADD(SPEC,.ADD)
I PACK S USER=0 F S USER=$O(^FSC("SPEC","AP",PACK,USER)) Q:USER'>0 D
.I $D(REMOVE(USER)) Q
.I $D(ADD(USER)) Q
.I $D(^FSCD("NOTIFY","ACUSER",CALL,USER)) Q
.I RTD,$D(^FSC("SPEC","AF",2,USER)) D CHKADD(USER,.ADD)
.I 'MISC,$D(^FSC("SPEC","AF",1,USER)) D CHKADD(USER,.ADD)
I PACKGP S USER=0 F S USER=$O(^FSC("SPEC","AG",PACKGP,USER)) Q:USER'>0 D
.I $D(REMOVE(USER)) Q
.I $D(ADD(USER)) Q
.I $D(^FSCD("NOTIFY","ACUSER",CALL,USER)) Q
.I '$P($G(^FSC("SPEC",USER,20,+$O(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,3) Q
.I RTD,$D(^FSC("SPEC","AF",2,USER)) D CHKADD(USER,.ADD)
.I 'MISC,$D(^FSC("SPEC","AF",1,USER)) D CHKADD(USER,.ADD)
Q
;
CHECK(USER,PACK,PACKGP) ; $$(user,package,package group) -> 0 or 1 if ok to tag for notify
I '$P($G(^FSC("SPEC",USER,0)),U,22) Q 0
I PACKGP,$P($G(^FSC("SPEC",USER,20,+$O(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,3) Q 1
I PACK,$O(^FSC("SPEC","AP",PACK,USER,0)) Q 1
Q 0
;
CHKADD(USER,ADD) ;
N EVENT,METHOD
D SINFO(USER,.METHOD,.EVENT)
I '$L(METHOD) Q
I '$L(EVENT) Q
S ADD(USER)=METHOD_U_EVENT
Q
;
CINFO(CALL,PACK,PACKGP,MISC,RTD,SPEC) ;
N ZERO,ONETW
S ZERO=$G(^FSCD("CALL",+CALL,0)),ONETW=$G(^(120))
S PACK=$P(ONETW,U,9)
S PACKGP=$P(ONETW,U,13)
S MISC=$S($P(ZERO,U,10)=5:1,1:"")
S RTD=$S($P(ZERO,U,17):1,1:"")
S SPEC=$P(ZERO,U,9)
Q
;
SINFO(SPEC,METHOD,EVENT) ;
S METHOD=$P($G(^FSC("SPEC",+SPEC,0)),U,14),EVENT=$P($G(^(0)),U,15)
Q
;
NINFO(NUM,METHOD,EVENT) ;
S METHOD=$P($G(^FSCD("NOTIFY",+NUM,0)),U,5),EVENT=$P($G(^(0)),U,6)
Q
;
DEL(REMOVE) ;
N USER
S USER=0 F S USER=$O(REMOVE(USER)) Q:USER'>0 D
.I REMOVE(USER) D DEL^FSCUCD("^FSCD(""NOTIFY"",",REMOVE(USER))
Q
;
NEW(CALL,ADD) ;
N USER
S USER=0 F S USER=$O(ADD(USER)) Q:USER'>0 D
.D SETUP^FSCNOT(CALL,,,USER,$P(ADD(USER),U),$P(ADD(USER),U,2))
Q
;
TEST ; run in debug
N CALL
S CALL=999 F S CALL=$O(^FSCD("CALL",CALL)) Q:CALL<1 Q:CALL>10000 W !,CALL D AFFIL(CALL)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCAFFIL 3081 printed Oct 16, 2024@18:18:01 Page 2
FSCAFFIL ;SLC/STAFF-NOIS Affiliation ;1/17/98 16:50
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
AFFIL(CALL) ; from FSCTASKA
+1 NEW ADD,REMOVE
KILL ADD,REMOVE
+2 DO CLEAN(CALL,.REMOVE,.ADD)
+3 IF $ORDER(REMOVE(0))
DO DEL(.REMOVE)
+4 IF $ORDER(ADD(0))
DO NEW(CALL,.ADD)
+5 KILL ADD,REMOVE
+6 QUIT
+7 ;
CLEAN(CALL,REMOVE,ADD) ;
+1 NEW EVENT,METHOD,MISC,NEVENT,NMETHOD,NOTNUM,PACK,PACKGP,RTD,SPEC,USER
+2 DO CINFO(CALL,.PACK,.PACKGP,.MISC,.RTD,.SPEC)
+3 SET USER=0
FOR
SET USER=$ORDER(^FSCD("NOTIFY","ACUSER",CALL,USER))
if USER'>0
QUIT
SET NOTNUM=+^(USER)
IF NOTNUM
Begin DoDot:1
+4 IF $PIECE($GET(^FSCD("NOTIFY",NOTNUM,0)),U,7)
QUIT
+5 ; ** should not be processing non spec
IF '$DATA(^FSC("SPEC",USER,0))
QUIT
+6 DO SINFO(USER,.METHOD,.EVENT)
+7 IF '$LENGTH(METHOD)
SET REMOVE(USER)=NOTNUM
QUIT
+8 IF '$LENGTH(EVENT)
SET REMOVE(USER)=NOTNUM
QUIT
+9 IF USER'=SPEC
Begin DoDot:2
+10 IF '$$CHECK(USER,PACK,PACKGP)
SET REMOVE(USER)=NOTNUM
QUIT
+11 IF MISC
IF $DATA(^FSC("SPEC","AF",1,USER))
SET REMOVE(USER)=NOTNUM
End DoDot:2
+12 IF $DATA(REMOVE(USER))
QUIT
+13 DO NINFO(NOTNUM,.NMETHOD,.NEVENT)
+14 IF NMETHOD'=METHOD
SET $PIECE(^FSCD("NOTIFY",NOTNUM,0),U,5)=METHOD
+15 IF NEVENT'=EVENT
SET $PIECE(^FSCD("NOTIFY",NOTNUM,0),U,6)=EVENT
End DoDot:1
+16 IF SPEC
IF '$DATA(^FSCD("NOTIFY","ACUSER",CALL,SPEC))
DO CHKADD(SPEC,.ADD)
+17 IF PACK
SET USER=0
FOR
SET USER=$ORDER(^FSC("SPEC","AP",PACK,USER))
if USER'>0
QUIT
Begin DoDot:1
+18 IF $DATA(REMOVE(USER))
QUIT
+19 IF $DATA(ADD(USER))
QUIT
+20 IF $DATA(^FSCD("NOTIFY","ACUSER",CALL,USER))
QUIT
+21 IF RTD
IF $DATA(^FSC("SPEC","AF",2,USER))
DO CHKADD(USER,.ADD)
+22 IF 'MISC
IF $DATA(^FSC("SPEC","AF",1,USER))
DO CHKADD(USER,.ADD)
End DoDot:1
+23 IF PACKGP
SET USER=0
FOR
SET USER=$ORDER(^FSC("SPEC","AG",PACKGP,USER))
if USER'>0
QUIT
Begin DoDot:1
+24 IF $DATA(REMOVE(USER))
QUIT
+25 IF $DATA(ADD(USER))
QUIT
+26 IF $DATA(^FSCD("NOTIFY","ACUSER",CALL,USER))
QUIT
+27 IF '$PIECE($GET(^FSC("SPEC",USER,20,+$ORDER(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,3)
QUIT
+28 IF RTD
IF $DATA(^FSC("SPEC","AF",2,USER))
DO CHKADD(USER,.ADD)
+29 IF 'MISC
IF $DATA(^FSC("SPEC","AF",1,USER))
DO CHKADD(USER,.ADD)
End DoDot:1
+30 QUIT
+31 ;
CHECK(USER,PACK,PACKGP) ; $$(user,package,package group) -> 0 or 1 if ok to tag for notify
+1 IF '$PIECE($GET(^FSC("SPEC",USER,0)),U,22)
QUIT 0
+2 IF PACKGP
IF $PIECE($GET(^FSC("SPEC",USER,20,+$ORDER(^FSC("SPEC","AG",PACKGP,USER,0)),0)),U,3)
QUIT 1
+3 IF PACK
IF $ORDER(^FSC("SPEC","AP",PACK,USER,0))
QUIT 1
+4 QUIT 0
+5 ;
CHKADD(USER,ADD) ;
+1 NEW EVENT,METHOD
+2 DO SINFO(USER,.METHOD,.EVENT)
+3 IF '$LENGTH(METHOD)
QUIT
+4 IF '$LENGTH(EVENT)
QUIT
+5 SET ADD(USER)=METHOD_U_EVENT
+6 QUIT
+7 ;
CINFO(CALL,PACK,PACKGP,MISC,RTD,SPEC) ;
+1 NEW ZERO,ONETW
+2 SET ZERO=$GET(^FSCD("CALL",+CALL,0))
SET ONETW=$GET(^(120))
+3 SET PACK=$PIECE(ONETW,U,9)
+4 SET PACKGP=$PIECE(ONETW,U,13)
+5 SET MISC=$SELECT($PIECE(ZERO,U,10)=5:1,1:"")
+6 SET RTD=$SELECT($PIECE(ZERO,U,17):1,1:"")
+7 SET SPEC=$PIECE(ZERO,U,9)
+8 QUIT
+9 ;
SINFO(SPEC,METHOD,EVENT) ;
+1 SET METHOD=$PIECE($GET(^FSC("SPEC",+SPEC,0)),U,14)
SET EVENT=$PIECE($GET(^(0)),U,15)
+2 QUIT
+3 ;
NINFO(NUM,METHOD,EVENT) ;
+1 SET METHOD=$PIECE($GET(^FSCD("NOTIFY",+NUM,0)),U,5)
SET EVENT=$PIECE($GET(^(0)),U,6)
+2 QUIT
+3 ;
DEL(REMOVE) ;
+1 NEW USER
+2 SET USER=0
FOR
SET USER=$ORDER(REMOVE(USER))
if USER'>0
QUIT
Begin DoDot:1
+3 IF REMOVE(USER)
DO DEL^FSCUCD("^FSCD(""NOTIFY"",",REMOVE(USER))
End DoDot:1
+4 QUIT
+5 ;
NEW(CALL,ADD) ;
+1 NEW USER
+2 SET USER=0
FOR
SET USER=$ORDER(ADD(USER))
if USER'>0
QUIT
Begin DoDot:1
+3 DO SETUP^FSCNOT(CALL,,,USER,$PIECE(ADD(USER),U),$PIECE(ADD(USER),U,2))
End DoDot:1
+4 QUIT
+5 ;
TEST ; run in debug
+1 NEW CALL
+2 SET CALL=999
FOR
SET CALL=$ORDER(^FSCD("CALL",CALL))
if CALL<1
QUIT
if CALL>10000
QUIT
WRITE !,CALL
DO AFFIL(CALL)
+3 QUIT