FSCLP ;SLC/STAFF-NOIS List Process ;1/13/98 13:18
;;1.1;NOIS;;Sep 06, 1998
;
UPDATE(CALL,LIST) ; from FSCLMPD, FSCTASKA, FSCTASKU
I $G(LIST),$P($G(^FSC("LIST",LIST,0)),U,3)'="A" Q
I $G(LIST),$G(CALL) D PROCESS(LIST,CALL) Q
I '$G(LIST),$G(CALL) D CALL(CALL) Q
I $G(LIST),'$G(CALL) D LIST(LIST) Q
I '$G(LIST),'$G(CALL) D Q
.N DAYDATE,DOW,REBUILD
.S DOW=$$DOW^XLFDT(DT)
.S DAYDATE=+$E(DT,6,7)
.S LIST=0 F S LIST=$O(^FSC("LIST","AU","A",LIST)) Q:LIST<1 D
..S REBUILD=$P($G(^FSC("LIST",LIST,0)),U,10)
..I REBUILD="NEVER" Q
..I REBUILD="DAILY" D LIST(LIST) Q
..I REBUILD="WEEKLY",DOW="Saturday" D LIST(LIST) Q
..I REBUILD="",DOW="Saturday" D LIST(LIST) Q
..I REBUILD="MONTHLY",DOW="Saturday",DAYDATE<8 D LIST(LIST) Q
Q
;
CALL(CALLNUM) ;
N ADD,EVAL,EXP,LEVEL,LIST,LNUM,NUM,Q,VALUE,X K Q,VALUE,X
D GET^FSCGET("ALL",CALLNUM,.VALUE)
S LIST=0 F S LIST=$O(^FSC("LIST","AU","A",LIST)) Q:LIST<1 D
.L +^XTMP("FSC LIST DEF",LIST):20 I '$T Q
.I '$D(^XTMP("FSC LIST DEF",LIST,"XOP")) K ^XTMP("FSC LIST DEF",LIST)
.I '$D(^XTMP("FSC LIST DEF",LIST)) D BUILD^FSCLDU(LIST)
.S NUM=0 F S NUM=$O(^XTMP("FSC LIST DEF",LIST,"Q",NUM)) Q:NUM<1 S EXP=^(NUM) S Q(NUM)=0 I @EXP S Q(NUM)=1
.S LEVEL=0 F S LEVEL=$O(^XTMP("FSC LIST DEF",LIST,"X",LEVEL)) Q:LEVEL<1 S EXP=$P(^(LEVEL),U,2) S X(LEVEL)=0 I @EXP S X(LEVEL)=1
.S EVAL=^XTMP("FSC LIST DEF",LIST,"XOP")
.L -^XTMP("FSC LIST DEF",LIST)
.I @EVAL D Q
..S ADD=0 D ADD^FSCLMPS(CALLNUM,LIST,.OK) I OK S ADD=1
..D NOTIFY(CALLNUM,LIST,ADD)
.S LNUM=+$O(^FSCD("LISTS","ALC",LIST,CALLNUM,0)) I LNUM D DELETE^FSCLMPS(LNUM)
Q
;
LIST(LIST) ;
N ADD,CALL,CNT,CRITERIA,LNUM,LSTART,LSTOP,OPNUM K CRITERIA,^TMP("FSC LIST",$J)
S LSTART=$$NOW^XLFDT
D TMP(LIST)
S (CNT,OPNUM)=0 F S OPNUM=$O(^TMP("FSC LIST DEF",$J,LIST,"CRITERIA",OPNUM)) Q:OPNUM<1 D
.K CRITERIA M CRITERIA=^TMP("FSC LIST DEF",$J,LIST,"CRITERIA",OPNUM)
.D QUERY^FSCQR("",.CNT,.CRITERIA)
K ^TMP("FSC LIST DEF",$J)
S CALL=0 F S CALL=$O(^FSCD("LISTS","ALC",LIST,CALL)) Q:CALL<1 D
.I '$D(^TMP("FSC LIST",$J,CALL)) S LNUM=+$O(^FSCD("LISTS","ALC",LIST,CALL,0)) D:LNUM DELETE^FSCLMPS(LNUM) Q
.K ^TMP("FSC LIST",$J,CALL)
S CALL=0 F S CALL=$O(^TMP("FSC LIST",$J,CALL)) Q:CALL<1 D
.S ADD=0 D ADD^FSCLMPS(CALL,LIST,.OK) I OK S ADD=1
.D NOTIFY(CALL,LIST,ADD)
S LSTOP=$$NOW^XLFDT
S $P(^FSC("LIST",LIST,0),U,11)=$$FMDIFF^XLFDT(LSTOP,LSTART,2)
Q
;
PROCESS(LISTNUM,CALLNUM) ;
I '$D(^FSC("LIST",LISTNUM)) Q
D TMP(LISTNUM)
N ADD,EVAL,EXP,FIELD,LEVEL,LNUM,NUM,Q,VALUE,X K Q,VALUE,X
S FIELD=0 F S FIELD=$O(^TMP("FSC LIST DEF",$J,LISTNUM,"VAR",FIELD)) Q:FIELD<1 S VALUE(^(FIELD))=""
D GET^FSCGET("CUSTOM",CALLNUM,.VALUE)
S NUM=0 F S NUM=$O(^TMP("FSC LIST DEF",$J,LISTNUM,"Q",NUM)) Q:NUM<1 S EXP=^(NUM) S Q(NUM)=0 I @EXP S Q(NUM)=1
S LEVEL=0 F S LEVEL=$O(^TMP("FSC LIST DEF",$J,LISTNUM,"X",LEVEL)) Q:LEVEL<1 S EXP=$P(^(LEVEL),U,2) S X(LEVEL)=0 I @EXP S X(LEVEL)=1
S EVAL=^TMP("FSC LIST DEF",$J,LISTNUM,"XOP")
K ^TMP("FSC LIST DEF",$J)
I @EVAL D Q
.S ADD=0 D ADD^FSCLMPS(CALLNUM,LISTNUM,.OK) I OK S ADD=1
.D NOTIFY(CALLNUM,LISTNUM,ADD)
S LNUM=+$O(^FSCD("LISTS","ALC",LISTNUM,CALLNUM,0)) I LNUM D DELETE^FSCLMPS(LNUM)
Q
;
NOTIFY(CALL,LIST,ADD) ;
I '$L($P(^FSC("LIST",LIST,0),U,6)) Q
I $D(^FSCD("NOTIFY","ACLIST",CALL,LIST)) Q
I 'ADD,$P(^FSC("LIST",LIST,0),U,7)="ADDED" Q
D SETUP^FSCNOT(CALL,LIST)
Q
;
MANUAL(LIST) ; from FSCLML, FSCLMPQU, FSCRPCA, FSCRPCL
N CNT,OPNUM,CRITERIA K CRITERIA,^TMP("FSC LIST",$J)
D TMP(LIST)
S (CNT,OPNUM)=0 F S OPNUM=$O(^TMP("FSC LIST DEF",$J,LIST,"CRITERIA",OPNUM)) Q:OPNUM<1 D
.K CRITERIA M CRITERIA=^TMP("FSC LIST DEF",$J,LIST,"CRITERIA",OPNUM)
.D QUERY^FSCQR("",.CNT,.CRITERIA)
K ^TMP("FSC LIST DEF",$J)
Q
;
TMP(LIST) ; builds ^TMP("FSC LIST DEF",$J,LIST) from ^XTMP
K ^TMP("FSC LIST DEF",$J,LIST)
L +^XTMP("FSC LIST DEF",LIST):20 I '$T Q
I '$D(^XTMP("FSC LIST DEF",LIST,"XOP")) K ^XTMP("FSC LIST DEF",LIST)
I '$D(^XTMP("FSC LIST DEF",LIST)) D BUILD^FSCLDU(LIST)
M ^TMP("FSC LIST DEF",$J,LIST)=^XTMP("FSC LIST DEF",LIST)
L -^XTMP("FSC LIST DEF",LIST)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLP 4138 printed Dec 13, 2024@02:18:39 Page 2
FSCLP ;SLC/STAFF-NOIS List Process ;1/13/98 13:18
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
UPDATE(CALL,LIST) ; from FSCLMPD, FSCTASKA, FSCTASKU
+1 IF $GET(LIST)
IF $PIECE($GET(^FSC("LIST",LIST,0)),U,3)'="A"
QUIT
+2 IF $GET(LIST)
IF $GET(CALL)
DO PROCESS(LIST,CALL)
QUIT
+3 IF '$GET(LIST)
IF $GET(CALL)
DO CALL(CALL)
QUIT
+4 IF $GET(LIST)
IF '$GET(CALL)
DO LIST(LIST)
QUIT
+5 IF '$GET(LIST)
IF '$GET(CALL)
Begin DoDot:1
+6 NEW DAYDATE,DOW,REBUILD
+7 SET DOW=$$DOW^XLFDT(DT)
+8 SET DAYDATE=+$EXTRACT(DT,6,7)
+9 SET LIST=0
FOR
SET LIST=$ORDER(^FSC("LIST","AU","A",LIST))
if LIST<1
QUIT
Begin DoDot:2
+10 SET REBUILD=$PIECE($GET(^FSC("LIST",LIST,0)),U,10)
+11 IF REBUILD="NEVER"
QUIT
+12 IF REBUILD="DAILY"
DO LIST(LIST)
QUIT
+13 IF REBUILD="WEEKLY"
IF DOW="Saturday"
DO LIST(LIST)
QUIT
+14 IF REBUILD=""
IF DOW="Saturday"
DO LIST(LIST)
QUIT
+15 IF REBUILD="MONTHLY"
IF DOW="Saturday"
IF DAYDATE<8
DO LIST(LIST)
QUIT
End DoDot:2
End DoDot:1
QUIT
+16 QUIT
+17 ;
CALL(CALLNUM) ;
+1 NEW ADD,EVAL,EXP,LEVEL,LIST,LNUM,NUM,Q,VALUE,X
KILL Q,VALUE,X
+2 DO GET^FSCGET("ALL",CALLNUM,.VALUE)
+3 SET LIST=0
FOR
SET LIST=$ORDER(^FSC("LIST","AU","A",LIST))
if LIST<1
QUIT
Begin DoDot:1
+4 LOCK +^XTMP("FSC LIST DEF",LIST):20
IF '$TEST
QUIT
+5 IF '$DATA(^XTMP("FSC LIST DEF",LIST,"XOP"))
KILL ^XTMP("FSC LIST DEF",LIST)
+6 IF '$DATA(^XTMP("FSC LIST DEF",LIST))
DO BUILD^FSCLDU(LIST)
+7 SET NUM=0
FOR
SET NUM=$ORDER(^XTMP("FSC LIST DEF",LIST,"Q",NUM))
if NUM<1
QUIT
SET EXP=^(NUM)
SET Q(NUM)=0
IF @EXP
SET Q(NUM)=1
+8 SET LEVEL=0
FOR
SET LEVEL=$ORDER(^XTMP("FSC LIST DEF",LIST,"X",LEVEL))
if LEVEL<1
QUIT
SET EXP=$PIECE(^(LEVEL),U,2)
SET X(LEVEL)=0
IF @EXP
SET X(LEVEL)=1
+9 SET EVAL=^XTMP("FSC LIST DEF",LIST,"XOP")
+10 LOCK -^XTMP("FSC LIST DEF",LIST)
+11 IF @EVAL
Begin DoDot:2
+12 SET ADD=0
DO ADD^FSCLMPS(CALLNUM,LIST,.OK)
IF OK
SET ADD=1
+13 DO NOTIFY(CALLNUM,LIST,ADD)
End DoDot:2
QUIT
+14 SET LNUM=+$ORDER(^FSCD("LISTS","ALC",LIST,CALLNUM,0))
IF LNUM
DO DELETE^FSCLMPS(LNUM)
End DoDot:1
+15 QUIT
+16 ;
LIST(LIST) ;
+1 NEW ADD,CALL,CNT,CRITERIA,LNUM,LSTART,LSTOP,OPNUM
KILL CRITERIA,^TMP("FSC LIST",$JOB)
+2 SET LSTART=$$NOW^XLFDT
+3 DO TMP(LIST)
+4 SET (CNT,OPNUM)=0
FOR
SET OPNUM=$ORDER(^TMP("FSC LIST DEF",$JOB,LIST,"CRITERIA",OPNUM))
if OPNUM<1
QUIT
Begin DoDot:1
+5 KILL CRITERIA
MERGE CRITERIA=^TMP("FSC LIST DEF",$JOB,LIST,"CRITERIA",OPNUM)
+6 DO QUERY^FSCQR("",.CNT,.CRITERIA)
End DoDot:1
+7 KILL ^TMP("FSC LIST DEF",$JOB)
+8 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("LISTS","ALC",LIST,CALL))
if CALL<1
QUIT
Begin DoDot:1
+9 IF '$DATA(^TMP("FSC LIST",$JOB,CALL))
SET LNUM=+$ORDER(^FSCD("LISTS","ALC",LIST,CALL,0))
if LNUM
DO DELETE^FSCLMPS(LNUM)
QUIT
+10 KILL ^TMP("FSC LIST",$JOB,CALL)
End DoDot:1
+11 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC LIST",$JOB,CALL))
if CALL<1
QUIT
Begin DoDot:1
+12 SET ADD=0
DO ADD^FSCLMPS(CALL,LIST,.OK)
IF OK
SET ADD=1
+13 DO NOTIFY(CALL,LIST,ADD)
End DoDot:1
+14 SET LSTOP=$$NOW^XLFDT
+15 SET $PIECE(^FSC("LIST",LIST,0),U,11)=$$FMDIFF^XLFDT(LSTOP,LSTART,2)
+16 QUIT
+17 ;
PROCESS(LISTNUM,CALLNUM) ;
+1 IF '$DATA(^FSC("LIST",LISTNUM))
QUIT
+2 DO TMP(LISTNUM)
+3 NEW ADD,EVAL,EXP,FIELD,LEVEL,LNUM,NUM,Q,VALUE,X
KILL Q,VALUE,X
+4 SET FIELD=0
FOR
SET FIELD=$ORDER(^TMP("FSC LIST DEF",$JOB,LISTNUM,"VAR",FIELD))
if FIELD<1
QUIT
SET VALUE(^(FIELD))=""
+5 DO GET^FSCGET("CUSTOM",CALLNUM,.VALUE)
+6 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("FSC LIST DEF",$JOB,LISTNUM,"Q",NUM))
if NUM<1
QUIT
SET EXP=^(NUM)
SET Q(NUM)=0
IF @EXP
SET Q(NUM)=1
+7 SET LEVEL=0
FOR
SET LEVEL=$ORDER(^TMP("FSC LIST DEF",$JOB,LISTNUM,"X",LEVEL))
if LEVEL<1
QUIT
SET EXP=$PIECE(^(LEVEL),U,2)
SET X(LEVEL)=0
IF @EXP
SET X(LEVEL)=1
+8 SET EVAL=^TMP("FSC LIST DEF",$JOB,LISTNUM,"XOP")
+9 KILL ^TMP("FSC LIST DEF",$JOB)
+10 IF @EVAL
Begin DoDot:1
+11 SET ADD=0
DO ADD^FSCLMPS(CALLNUM,LISTNUM,.OK)
IF OK
SET ADD=1
+12 DO NOTIFY(CALLNUM,LISTNUM,ADD)
End DoDot:1
QUIT
+13 SET LNUM=+$ORDER(^FSCD("LISTS","ALC",LISTNUM,CALLNUM,0))
IF LNUM
DO DELETE^FSCLMPS(LNUM)
+14 QUIT
+15 ;
NOTIFY(CALL,LIST,ADD) ;
+1 IF '$LENGTH($PIECE(^FSC("LIST",LIST,0),U,6))
QUIT
+2 IF $DATA(^FSCD("NOTIFY","ACLIST",CALL,LIST))
QUIT
+3 IF 'ADD
IF $PIECE(^FSC("LIST",LIST,0),U,7)="ADDED"
QUIT
+4 DO SETUP^FSCNOT(CALL,LIST)
+5 QUIT
+6 ;
MANUAL(LIST) ; from FSCLML, FSCLMPQU, FSCRPCA, FSCRPCL
+1 NEW CNT,OPNUM,CRITERIA
KILL CRITERIA,^TMP("FSC LIST",$JOB)
+2 DO TMP(LIST)
+3 SET (CNT,OPNUM)=0
FOR
SET OPNUM=$ORDER(^TMP("FSC LIST DEF",$JOB,LIST,"CRITERIA",OPNUM))
if OPNUM<1
QUIT
Begin DoDot:1
+4 KILL CRITERIA
MERGE CRITERIA=^TMP("FSC LIST DEF",$JOB,LIST,"CRITERIA",OPNUM)
+5 DO QUERY^FSCQR("",.CNT,.CRITERIA)
End DoDot:1
+6 KILL ^TMP("FSC LIST DEF",$JOB)
+7 QUIT
+8 ;
TMP(LIST) ; builds ^TMP("FSC LIST DEF",$J,LIST) from ^XTMP
+1 KILL ^TMP("FSC LIST DEF",$JOB,LIST)
+2 LOCK +^XTMP("FSC LIST DEF",LIST):20
IF '$TEST
QUIT
+3 IF '$DATA(^XTMP("FSC LIST DEF",LIST,"XOP"))
KILL ^XTMP("FSC LIST DEF",LIST)
+4 IF '$DATA(^XTMP("FSC LIST DEF",LIST))
DO BUILD^FSCLDU(LIST)
+5 MERGE ^TMP("FSC LIST DEF",$JOB,LIST)=^XTMP("FSC LIST DEF",LIST)
+6 LOCK -^XTMP("FSC LIST DEF",LIST)
+7 QUIT
