- FSCLMPQR ;SLC/STAFF-NOIS List Manager Protocol Query Remove ;1/13/98 13:06
- ;;1.1;NOIS;;Sep 06, 1998
- ;
- REMOVE ; from FSCLMP
- I '^TMP("FSC LIST CALLS",$J) W !,$C(7),"You can't delete from an empty list." H 2 Q
- N DIR,SELECT,X,Y K DIR
- S DIR(0)="SAMO^S:Selected Calls;L:Lists;Q:Query;A:All Calls"
- S DIR("A")="Remove using: " W !,"(S)elected Calls, (L)ists, (Q)uery, (A)ll Calls"
- S DIR("?",1)="Enter S to a remove selected calls from the last."
- S DIR("?",2)="Enter L to remove calls from the list that are on selected lists."
- S DIR("?",3)="Enter Q to remove calls from the list using a specific criteria."
- S DIR("?",4)="Enter A to remove all calls on the list."
- S DIR("?",5)="Note: changing a list does not change what is stored on the list."
- S DIR("?",6)="When a list is changed it appears as (MODIFIED)."
- S DIR("?",7)="Enter '^' to exit without changing the list or '??' for more help."
- S DIR("?")="^D HELP^FSCU(.DIR)"
- S DIR("??")="FSC U1 NOIS"
- D ^DIR K DIR
- S SELECT=Y
- D
- .I SELECT="S" D Q
- ..N CALL,CHOICE,DEFAULT,LNUM,OK
- ..K ^TMP("FSC SELECT",$J,"RVALUES")
- ..S CHOICE="1-"_+@VALMAR,DEFAULT="" D SELECT^FSCUL(CHOICE,"",DEFAULT,"RVALUES",.OK)
- ..I '$O(^TMP("FSC SELECT",$J,"RVALUES",0)) Q
- ..W !
- ..S LNUM=0 F S LNUM=$O(^TMP("FSC LIST CALLS",$J,"IDX",LNUM)) Q:LNUM<1 S CALL=+$O(^TMP("FSC LIST CALLS",$J,"ICX",+$O(^(LNUM,0)),0)) D
- ...S ^TMP("FSC MERGE",$J,LNUM,CALL)=""
- ..K ^TMP("FSC LIST CALLS",$J)
- ..S (LNUM,VALMCNT)=0 F S LNUM=$O(^TMP("FSC MERGE",$J,LNUM)) Q:LNUM<1 S CALL=$O(^(LNUM,0)) D
- ...I '$D(^TMP("FSC SELECT",$J,"RVALUES",LNUM)) D SETUP^FSCLMPQU(.VALMCNT,CALL)
- ..D COUNT^FSCLMPQU(VALMCNT)
- ..K ^TMP("FSC MERGE",$J),^TMP("FSC SELECT",$J,"RVALUES")
- .I SELECT="A" D Q
- ..K ^TMP("FSC LIST CALLS",$J)
- ..S ^TMP("FSC LIST CALLS",$J)="0^0"
- ..D HDR^FSCLMPQU
- .I SELECT="L" D Q
- ..N CALL,CALLX,LIMITS,LINDX,LISTNUM,LISTS,LNAME,LNUM,OK,TIME K LIMITS,LISTS
- ..D LIST^FSCLMPQU(.LISTS,.LIMITS,.OK)
- ..I '$O(LISTS(0)) Q
- ..W !
- ..S LNUM=0 F S LNUM=$O(^TMP("FSC LIST CALLS",$J,"ICX",LNUM)) Q:LNUM<1 S CALL=+$O(^(LNUM,0)) D
- ...S ^TMP("FSC MERGE",$J,LNUM,CALL)=""
- ..K ^TMP("FSC LIST CALLS",$J)
- ..S (LNUM,VALMCNT)=0 F S LNUM=$O(^TMP("FSC MERGE",$J,LNUM)) Q:LNUM<1 S CALL=$O(^(LNUM,0)) D I $D(VALMQUIT) Q
- ...S OK=1,LISTNUM=0 F S LISTNUM=$O(LISTS(LISTNUM)) Q:LISTNUM<1 D I 'OK Q
- ....S LNAME=$P(^FSC("LIST",+$P(LISTNUM,"."),0),U),LINDX=+$P(LISTNUM,".",2)
- ....I LNAME="MRE:" D Q
- .....S TIME="" F S TIME=$O(^FSCD("MRE","AUTC",LINDX,TIME)) Q:TIME="" D Q:'OK
- ......S CALLX=0 F S CALLX=$O(^FSCD("MRE","AUTC",LINDX,TIME,CALLX)) Q:CALLX<1 I CALLX=CALL S OK=0 Q
- ....I LNAME="MRA:" D Q
- .....S TIME="" F S TIME=$O(^FSCD("MRA","AUTC",LINDX,TIME)) Q:TIME="" D Q:'OK
- ......S CALLX=0 F S CALLX=$O(^FSCD("MRA","AUTC",LINDX,TIME,CALLX)) Q:CALLX<1 I CALLX=CALL S OK=0 Q
- ....I $D(@LISTS(LISTNUM)@(CALL)) D CHECK(CALL,LISTS(LISTNUM),LIMITS(LISTNUM),.OK)
- ...I OK D SETUP^FSCLMPQU(.VALMCNT,CALL) I (VALMCNT#10)=0 D CHECK^FSCLML(.VALMQUIT) I $D(VALMQUIT) S VALMBCK="Q" Q
- ..D COUNT^FSCLMPQU(VALMCNT)
- ..K ^TMP("FSC MERGE",$J)
- .I SELECT="Q" D Q
- ..D QUERY^FSCLMPQU("Remove")
- I '$D(VALMQUIT) D EMPTY^FSCLMPQU
- S VALMBG=1
- Q
- ;
- CHECK(CALL,LIST,LIMIT,OK) ;
- N CNT,DATEO,NUM
- I 'LIMIT S OK=0 Q
- S OK=1
- I $P(LIMIT,U,2) D Q
- .S CNT=0,NUM="A" F S NUM=$O(@LIST@(NUM),-1) Q:NUM<1 S CNT=CNT+1 I NUM=CALL S:CNT'>$P(LIMIT,U,2) OK=0 Q
- S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
- I DATEO'<$P(LIMIT,U,3),DATEO'>$P(LIMIT,U,4) S OK=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPQR 3523 printed Feb 18, 2025@23:45:01 Page 2
- FSCLMPQR ;SLC/STAFF-NOIS List Manager Protocol Query Remove ;1/13/98 13:06
- +1 ;;1.1;NOIS;;Sep 06, 1998
- +2 ;
- REMOVE ; from FSCLMP
- +1 IF '^TMP("FSC LIST CALLS",$JOB)
- WRITE !,$CHAR(7),"You can't delete from an empty list."
- HANG 2
- QUIT
- +2 NEW DIR,SELECT,X,Y
- KILL DIR
- +3 SET DIR(0)="SAMO^S:Selected Calls;L:Lists;Q:Query;A:All Calls"
- +4 SET DIR("A")="Remove using: "
- WRITE !,"(S)elected Calls, (L)ists, (Q)uery, (A)ll Calls"
- +5 SET DIR("?",1)="Enter S to a remove selected calls from the last."
- +6 SET DIR("?",2)="Enter L to remove calls from the list that are on selected lists."
- +7 SET DIR("?",3)="Enter Q to remove calls from the list using a specific criteria."
- +8 SET DIR("?",4)="Enter A to remove all calls on the list."
- +9 SET DIR("?",5)="Note: changing a list does not change what is stored on the list."
- +10 SET DIR("?",6)="When a list is changed it appears as (MODIFIED)."
- +11 SET DIR("?",7)="Enter '^' to exit without changing the list or '??' for more help."
- +12 SET DIR("?")="^D HELP^FSCU(.DIR)"
- +13 SET DIR("??")="FSC U1 NOIS"
- +14 DO ^DIR
- KILL DIR
- +15 SET SELECT=Y
- +16 Begin DoDot:1
- +17 IF SELECT="S"
- Begin DoDot:2
- +18 NEW CALL,CHOICE,DEFAULT,LNUM,OK
- +19 KILL ^TMP("FSC SELECT",$JOB,"RVALUES")
- +20 SET CHOICE="1-"_+@VALMAR
- SET DEFAULT=""
- DO SELECT^FSCUL(CHOICE,"",DEFAULT,"RVALUES",.OK)
- +21 IF '$ORDER(^TMP("FSC SELECT",$JOB,"RVALUES",0))
- QUIT
- +22 WRITE !
- +23 SET LNUM=0
- FOR
- SET LNUM=$ORDER(^TMP("FSC LIST CALLS",$JOB,"IDX",LNUM))
- if LNUM<1
- QUIT
- SET CALL=+$ORDER(^TMP("FSC LIST CALLS",$JOB,"ICX",+$ORDER(^(LNUM,0)),0))
- Begin DoDot:3
- +24 SET ^TMP("FSC MERGE",$JOB,LNUM,CALL)=""
- End DoDot:3
- +25 KILL ^TMP("FSC LIST CALLS",$JOB)
- +26 SET (LNUM,VALMCNT)=0
- FOR
- SET LNUM=$ORDER(^TMP("FSC MERGE",$JOB,LNUM))
- if LNUM<1
- QUIT
- SET CALL=$ORDER(^(LNUM,0))
- Begin DoDot:3
- +27 IF '$DATA(^TMP("FSC SELECT",$JOB,"RVALUES",LNUM))
- DO SETUP^FSCLMPQU(.VALMCNT,CALL)
- End DoDot:3
- +28 DO COUNT^FSCLMPQU(VALMCNT)
- +29 KILL ^TMP("FSC MERGE",$JOB),^TMP("FSC SELECT",$JOB,"RVALUES")
- End DoDot:2
- QUIT
- +30 IF SELECT="A"
- Begin DoDot:2
- +31 KILL ^TMP("FSC LIST CALLS",$JOB)
- +32 SET ^TMP("FSC LIST CALLS",$JOB)="0^0"
- +33 DO HDR^FSCLMPQU
- End DoDot:2
- QUIT
- +34 IF SELECT="L"
- Begin DoDot:2
- +35 NEW CALL,CALLX,LIMITS,LINDX,LISTNUM,LISTS,LNAME,LNUM,OK,TIME
- KILL LIMITS,LISTS
- +36 DO LIST^FSCLMPQU(.LISTS,.LIMITS,.OK)
- +37 IF '$ORDER(LISTS(0))
- QUIT
- +38 WRITE !
- +39 SET LNUM=0
- FOR
- SET LNUM=$ORDER(^TMP("FSC LIST CALLS",$JOB,"ICX",LNUM))
- if LNUM<1
- QUIT
- SET CALL=+$ORDER(^(LNUM,0))
- Begin DoDot:3
- +40 SET ^TMP("FSC MERGE",$JOB,LNUM,CALL)=""
- End DoDot:3
- +41 KILL ^TMP("FSC LIST CALLS",$JOB)
- +42 SET (LNUM,VALMCNT)=0
- FOR
- SET LNUM=$ORDER(^TMP("FSC MERGE",$JOB,LNUM))
- if LNUM<1
- QUIT
- SET CALL=$ORDER(^(LNUM,0))
- Begin DoDot:3
- +43 SET OK=1
- SET LISTNUM=0
- FOR
- SET LISTNUM=$ORDER(LISTS(LISTNUM))
- if LISTNUM<1
- QUIT
- Begin DoDot:4
- +44 SET LNAME=$PIECE(^FSC("LIST",+$PIECE(LISTNUM,"."),0),U)
- SET LINDX=+$PIECE(LISTNUM,".",2)
- +45 IF LNAME="MRE:"
- Begin DoDot:5
- +46 SET TIME=""
- FOR
- SET TIME=$ORDER(^FSCD("MRE","AUTC",LINDX,TIME))
- if TIME=""
- QUIT
- Begin DoDot:6
- +47 SET CALLX=0
- FOR
- SET CALLX=$ORDER(^FSCD("MRE","AUTC",LINDX,TIME,CALLX))
- if CALLX<1
- QUIT
- IF CALLX=CALL
- SET OK=0
- QUIT
- End DoDot:6
- if 'OK
- QUIT
- End DoDot:5
- QUIT
- +48 IF LNAME="MRA:"
- Begin DoDot:5
- +49 SET TIME=""
- FOR
- SET TIME=$ORDER(^FSCD("MRA","AUTC",LINDX,TIME))
- if TIME=""
- QUIT
- Begin DoDot:6
- +50 SET CALLX=0
- FOR
- SET CALLX=$ORDER(^FSCD("MRA","AUTC",LINDX,TIME,CALLX))
- if CALLX<1
- QUIT
- IF CALLX=CALL
- SET OK=0
- QUIT
- End DoDot:6
- if 'OK
- QUIT
- End DoDot:5
- QUIT
- +51 IF $DATA(@LISTS(LISTNUM)@(CALL))
- DO CHECK(CALL,LISTS(LISTNUM),LIMITS(LISTNUM),.OK)
- End DoDot:4
- IF 'OK
- QUIT
- +52 IF OK
- DO SETUP^FSCLMPQU(.VALMCNT,CALL)
- IF (VALMCNT#10)=0
- DO CHECK^FSCLML(.VALMQUIT)
- IF $DATA(VALMQUIT)
- SET VALMBCK="Q"
- QUIT
- End DoDot:3
- IF $DATA(VALMQUIT)
- QUIT
- +53 DO COUNT^FSCLMPQU(VALMCNT)
- +54 KILL ^TMP("FSC MERGE",$JOB)
- End DoDot:2
- QUIT
- +55 IF SELECT="Q"
- Begin DoDot:2
- +56 DO QUERY^FSCLMPQU("Remove")
- End DoDot:2
- QUIT
- End DoDot:1
- +57 IF '$DATA(VALMQUIT)
- DO EMPTY^FSCLMPQU
- +58 SET VALMBG=1
- +59 QUIT
- +60 ;
- CHECK(CALL,LIST,LIMIT,OK) ;
- +1 NEW CNT,DATEO,NUM
- +2 IF 'LIMIT
- SET OK=0
- QUIT
- +3 SET OK=1
- +4 IF $PIECE(LIMIT,U,2)
- Begin DoDot:1
- +5 SET CNT=0
- SET NUM="A"
- FOR
- SET NUM=$ORDER(@LIST@(NUM),-1)
- if NUM<1
- QUIT
- SET CNT=CNT+1
- IF NUM=CALL
- if CNT'>$PIECE(LIMIT,U,2)
- SET OK=0
- QUIT
- End DoDot:1
- QUIT
- +6 SET DATEO=$PIECE(^FSCD("CALL",CALL,0),U,3)
- +7 IF DATEO'<$PIECE(LIMIT,U,3)
- IF DATEO'>$PIECE(LIMIT,U,4)
- SET OK=0
- +8 QUIT