FSCLML ;SLC/STAFF-NOIS List Manager - List ;1/13/98 12:36
;;1.1;NOIS;;Sep 06, 1998
;
ENTRY ; from list template - entry code, FSCLMPC, FSCLMPNF, FSCLMPQQ, FSCLMPQU, FSCRPTS
N CALL,DATEO,LIMIT,LIMITOK,LISTCALL,LNUM,SOURCE,TIME
K ^TMP("FSC LIST CALLS",$J)
S FSCLIMIT=$S($G(FSCLIMIT):FSCLIMIT,1:"1^"_$$MAXCALL^FSCUP)
S (LIMIT,LNUM,VALMCNT)=0,FSCUD=$$USERDEF^FSCU(DUZ),VALMCAP=$$CAP^FSCU("L")
I '$G(FSCDEV) W !
I '$G(FSCQUERY) D
.I $E(FSCLNAME,1,4)="MRE:" D Q
..S TIME="" F S TIME=$O(^FSCD("MRE","AUTC",FSCINDX,TIME)) Q:TIME="" D Q:LIMIT
...S CALL=0 F S CALL=$O(^FSCD("MRE","AUTC",FSCINDX,TIME,CALL)) Q:CALL<1 D SETUP Q:LIMIT
.I $E(FSCLNAME,1,4)="MRA:" D Q
..S TIME="" F S TIME=$O(^FSCD("MRA","AUTC",FSCINDX,TIME)) Q:TIME="" D Q:LIMIT
...S CALL=0 F S CALL=$O(^FSCD("MRA","AUTC",FSCINDX,TIME,CALL)) Q:CALL<1 D SETUP Q:LIMIT
.I $L($P(FSCL0,U,4)) D Q
..S SOURCE="^FSCD(""CALL"","_$P(FSCL0,U,4)_$S($G(FSCINDX):","_FSCINDX,1:"")_")"
..S CALL="A" F S CALL=$O(@SOURCE@(CALL),-1) Q:CALL<1 D SETUP Q:LIMIT I (VALMCNT#10)=0 D CHECK(.VALMQUIT) I $D(VALMQUIT) Q
.I $P(FSCL0,U,3)="M" D Q
..D MANUAL^FSCLP(FSCLNUM)
..S CALL="A" F S CALL=$O(^TMP("FSC LIST",$J,CALL),-1) Q:CALL<1 D SETUP Q:LIMIT I (VALMCNT#10)=0 D CHECK(.VALMQUIT) I $D(VALMQUIT) Q
.S LISTCALL="A" F S LISTCALL=$O(^FSCD("LISTS","L",FSCLNUM,LISTCALL),-1) Q:LISTCALL<1 D Q:LIMIT I (VALMCNT#10)=0 D CHECK(.VALMQUIT) I $D(VALMQUIT) Q
..S CALL=+$G(^FSCD("LISTS",LISTCALL,0)) D SETUP
I $G(FSCQUERY) S CALL="A" F S CALL=$O(^TMP("FSC LIST",$J,CALL),-1) Q:CALL<1 D SETUP Q:LIMIT I (VALMCNT#10)=0 D CHECK(.VALMQUIT) I $D(VALMQUIT) Q
I $D(VALMQUIT) S FSCQUERY=0 Q
I $G(FSCLIMIT),FSCLNAME'["(MODIFIED)",LNUM=$P(FSCLIMIT,U,2)!$P(FSCLIMIT,U,3) S FSCLNAME=FSCLNAME_" (MODIFIED)"
S ^TMP("FSC LIST CALLS",$J)=LNUM_U_VALMCNT
D EMPTY^FSCLMPQU
S FSCQUERY=0
Q
;
SETUP ; from FSCUS
I $G(FSCLIMIT) S LIMITOK=1 D Q:'LIMITOK
.I $P(FSCLIMIT,U,2) D Q
..I LNUM'<$P(FSCLIMIT,U,2) S LIMIT=1,LIMITOK=0 W !,"List is restricted to ",$P(FSCLIMIT,U,2)," entries.",$C(7) H 2
.S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
.I DATEO<$P(FSCLIMIT,U,3) S LIMITOK=0 Q
.I DATEO>$P(FSCLIMIT,U,4) S LIMITOK=0 Q
S LNUM=LNUM+1,VALMCNT=VALMCNT+1
S ^TMP("FSC LIST CALLS",$J,VALMCNT,0)=$$SHORT^FSCGETS(CALL,LNUM)
S ^TMP("FSC LIST CALLS",$J,"IDX",LNUM,VALMCNT)=""
S ^TMP("FSC LIST CALLS",$J,"CX",CALL)=""
S ^TMP("FSC LIST CALLS",$J,"ICX",VALMCNT,CALL)=""
I $D(^TMP("FSC LIST CLEANUP",$J,CALL)) D
.S VALMCNT=VALMCNT+1
.S ^TMP("FSC LIST CALLS",$J,VALMCNT,0)=" "_^TMP("FSC LIST CLEANUP",$J,CALL)
Q
;
CHECK(VALMQUIT) ; from FSCLMPQA, FSCLMPQR, FSCLMPQS, FSCUS
I $G(FSCDEV) Q
I 'VALMCNT Q
N X
W "." K VALMQUIT
R X:0 I $T,X=U D
.N DIR,X,Y K DIR
.S DIR(0)="YAO",DIR("A")="Do you want to stop this action? ",DIR("B")="NO"
.S DIR("?",1)="Enter YES to stop processing this action."
.S DIR("?",2)="NOTE: stopping this process will not preserve your previous screen."
.S DIR("?",3)="Enter NO or '^' to continue processing."
.S DIR("?")="^D HELP^FSCU(.DIR)"
.S DIR("??")="FSC U 1 NOIS"
.D ^DIR K DIR
.I Y=1 S VALMQUIT=1
Q
;
S VALMHDR(1)=$$SETSTR^VALM1("# of calls: "_+^TMP("FSC LIST CALLS",$J),"List: "_FSCLNAME,62,18)
Q
;
EXIT ; from list template - exit code
D CLEAR^VALM1
K ^TMP("FSC LIST",$J)
K ^TMP("FSC LIST CALLS",$J)
K ^TMP("FSC SELECT",$J)
K ^TMP("FSC STATS",$J)
Q
;
HELP ; from list template - help code
I $G(X)'["?" Q
S VALMBCK="R"
N XQH
I X="?" S XQH="FSC MENU LIST" D EN^XQH Q
I X="???" S VALMANS="?" D CLEAR^VALM1 S XQH="FSC U1 NOIS" D EN^XQH Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLML 3702 printed Dec 13, 2024@02:18:07 Page 2
FSCLML ;SLC/STAFF-NOIS List Manager - List ;1/13/98 12:36
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
ENTRY ; from list template - entry code, FSCLMPC, FSCLMPNF, FSCLMPQQ, FSCLMPQU, FSCRPTS
+1 NEW CALL,DATEO,LIMIT,LIMITOK,LISTCALL,LNUM,SOURCE,TIME
+2 KILL ^TMP("FSC LIST CALLS",$JOB)
+3 SET FSCLIMIT=$SELECT($GET(FSCLIMIT):FSCLIMIT,1:"1^"_$$MAXCALL^FSCUP)
+4 SET (LIMIT,LNUM,VALMCNT)=0
SET FSCUD=$$USERDEF^FSCU(DUZ)
SET VALMCAP=$$CAP^FSCU("L")
+5 IF '$GET(FSCDEV)
WRITE !
+6 IF '$GET(FSCQUERY)
Begin DoDot:1
+7 IF $EXTRACT(FSCLNAME,1,4)="MRE:"
Begin DoDot:2
+8 SET TIME=""
FOR
SET TIME=$ORDER(^FSCD("MRE","AUTC",FSCINDX,TIME))
if TIME=""
QUIT
Begin DoDot:3
+9 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("MRE","AUTC",FSCINDX,TIME,CALL))
if CALL<1
QUIT
DO SETUP
if LIMIT
QUIT
End DoDot:3
if LIMIT
QUIT
End DoDot:2
QUIT
+10 IF $EXTRACT(FSCLNAME,1,4)="MRA:"
Begin DoDot:2
+11 SET TIME=""
FOR
SET TIME=$ORDER(^FSCD("MRA","AUTC",FSCINDX,TIME))
if TIME=""
QUIT
Begin DoDot:3
+12 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("MRA","AUTC",FSCINDX,TIME,CALL))
if CALL<1
QUIT
DO SETUP
if LIMIT
QUIT
End DoDot:3
if LIMIT
QUIT
End DoDot:2
QUIT
+13 IF $LENGTH($PIECE(FSCL0,U,4))
Begin DoDot:2
+14 SET SOURCE="^FSCD(""CALL"","_$PIECE(FSCL0,U,4)_$SELECT($GET(FSCINDX):","_FSCINDX,1:"")_")"
+15 SET CALL="A"
FOR
SET CALL=$ORDER(@SOURCE@(CALL),-1)
if CALL<1
QUIT
DO SETUP
if LIMIT
QUIT
IF (VALMCNT#10)=0
DO CHECK(.VALMQUIT)
IF $DATA(VALMQUIT)
QUIT
End DoDot:2
QUIT
+16 IF $PIECE(FSCL0,U,3)="M"
Begin DoDot:2
+17 DO MANUAL^FSCLP(FSCLNUM)
+18 SET CALL="A"
FOR
SET CALL=$ORDER(^TMP("FSC LIST",$JOB,CALL),-1)
if CALL<1
QUIT
DO SETUP
if LIMIT
QUIT
IF (VALMCNT#10)=0
DO CHECK(.VALMQUIT)
IF $DATA(VALMQUIT)
QUIT
End DoDot:2
QUIT
+19 SET LISTCALL="A"
FOR
SET LISTCALL=$ORDER(^FSCD("LISTS","L",FSCLNUM,LISTCALL),-1)
if LISTCALL<1
QUIT
Begin DoDot:2
+20 SET CALL=+$GET(^FSCD("LISTS",LISTCALL,0))
DO SETUP
End DoDot:2
if LIMIT
QUIT
IF (VALMCNT#10)=0
DO CHECK(.VALMQUIT)
IF $DATA(VALMQUIT)
QUIT
End DoDot:1
+21 IF $GET(FSCQUERY)
SET CALL="A"
FOR
SET CALL=$ORDER(^TMP("FSC LIST",$JOB,CALL),-1)
if CALL<1
QUIT
DO SETUP
if LIMIT
QUIT
IF (VALMCNT#10)=0
DO CHECK(.VALMQUIT)
IF $DATA(VALMQUIT)
QUIT
+22 IF $DATA(VALMQUIT)
SET FSCQUERY=0
QUIT
+23 IF $GET(FSCLIMIT)
IF FSCLNAME'["(MODIFIED)"
IF LNUM=$PIECE(FSCLIMIT,U,2)!$PIECE(FSCLIMIT,U,3)
SET FSCLNAME=FSCLNAME_" (MODIFIED)"
+24 SET ^TMP("FSC LIST CALLS",$JOB)=LNUM_U_VALMCNT
+25 DO EMPTY^FSCLMPQU
+26 SET FSCQUERY=0
+27 QUIT
+28 ;
SETUP ; from FSCUS
+1 IF $GET(FSCLIMIT)
SET LIMITOK=1
Begin DoDot:1
+2 IF $PIECE(FSCLIMIT,U,2)
Begin DoDot:2
+3 IF LNUM'<$PIECE(FSCLIMIT,U,2)
SET LIMIT=1
SET LIMITOK=0
WRITE !,"List is restricted to ",$PIECE(FSCLIMIT,U,2)," entries.",$CHAR(7)
HANG 2
End DoDot:2
QUIT
+4 SET DATEO=$PIECE(^FSCD("CALL",CALL,0),U,3)
+5 IF DATEO<$PIECE(FSCLIMIT,U,3)
SET LIMITOK=0
QUIT
+6 IF DATEO>$PIECE(FSCLIMIT,U,4)
SET LIMITOK=0
QUIT
End DoDot:1
if 'LIMITOK
QUIT
+7 SET LNUM=LNUM+1
SET VALMCNT=VALMCNT+1
+8 SET ^TMP("FSC LIST CALLS",$JOB,VALMCNT,0)=$$SHORT^FSCGETS(CALL,LNUM)
+9 SET ^TMP("FSC LIST CALLS",$JOB,"IDX",LNUM,VALMCNT)=""
+10 SET ^TMP("FSC LIST CALLS",$JOB,"CX",CALL)=""
+11 SET ^TMP("FSC LIST CALLS",$JOB,"ICX",VALMCNT,CALL)=""
+12 IF $DATA(^TMP("FSC LIST CLEANUP",$JOB,CALL))
Begin DoDot:1
+13 SET VALMCNT=VALMCNT+1
+14 SET ^TMP("FSC LIST CALLS",$JOB,VALMCNT,0)=" "_^TMP("FSC LIST CLEANUP",$JOB,CALL)
End DoDot:1
+15 QUIT
+16 ;
CHECK(VALMQUIT) ; from FSCLMPQA, FSCLMPQR, FSCLMPQS, FSCUS
+1 IF $GET(FSCDEV)
QUIT
+2 IF 'VALMCNT
QUIT
+3 NEW X
+4 WRITE "."
KILL VALMQUIT
+5 READ X:0
IF $TEST
IF X=U
Begin DoDot:1
+6 NEW DIR,X,Y
KILL DIR
+7 SET DIR(0)="YAO"
SET DIR("A")="Do you want to stop this action? "
SET DIR("B")="NO"
+8 SET DIR("?",1)="Enter YES to stop processing this action."
+9 SET DIR("?",2)="NOTE: stopping this process will not preserve your previous screen."
+10 SET DIR("?",3)="Enter NO or '^' to continue processing."
+11 SET DIR("?")="^D HELP^FSCU(.DIR)"
+12 SET DIR("??")="FSC U 1 NOIS"
+13 DO ^DIR
KILL DIR
+14 IF Y=1
SET VALMQUIT=1
End DoDot:1
+15 QUIT
+16 ;
+1 SET VALMHDR(1)=$$SETSTR^VALM1("# of calls: "_+^TMP("FSC LIST CALLS",$JOB),"List: "_FSCLNAME,62,18)
+2 QUIT
+3 ;
EXIT ; from list template - exit code
+1 DO CLEAR^VALM1
+2 KILL ^TMP("FSC LIST",$JOB)
+3 KILL ^TMP("FSC LIST CALLS",$JOB)
+4 KILL ^TMP("FSC SELECT",$JOB)
+5 KILL ^TMP("FSC STATS",$JOB)
+6 QUIT
+7 ;
HELP ; from list template - help code
+1 IF $GET(X)'["?"
QUIT
+2 SET VALMBCK="R"
+3 NEW XQH
+4 IF X="?"
SET XQH="FSC MENU LIST"
DO EN^XQH
QUIT
+5 IF X="???"
SET VALMANS="?"
DO CLEAR^VALM1
SET XQH="FSC U1 NOIS"
DO EN^XQH
QUIT
+6 QUIT
