- 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 Feb 18, 2025@23:44:35 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