- FSCLMPQA ;SLC/STAFF-NOIS List Manager Protocol Query Add ;3/24/98 11:47
- ;;1.1;NOIS;;Sep 06, 1998
- ;
- ADD ; from FSCLMP
- N DIR,FSCLIMIT,SELECT,X,Y K DIR
- S VALMCNT=+$P(^TMP("FSC LIST CALLS",$J),U,2) I VALMCNT=0 K ^($J) S ^($J)="0^0"
- S DIR(0)="SAMO^S:Selected Calls;L:Lists;Q:Query;E:Expand"
- S DIR("A")="Add using: " W !,"(S)elected Calls, (L)ists, (Q)uery, (E)xpand"
- S DIR("?",1)="Enter S to add to the list specific calls."
- S DIR("?",2)="Enter L to add to the list calls from other lists."
- S DIR("?",3)="Enter Q to add to the list calls meeting a specific criteria."
- S DIR("?",4)="Enter E to to expand list to all duplicates."
- S DIR("?",5)="Note: changing a list does not change calls 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="E" D Q
- ..N CALL,PRIMARY,SECOND K ^TMP("FSC MERGE",$J)
- ..M ^TMP("FSC MERGE",$J)=^TMP("FSC LIST CALLS",$J,"CX")
- ..K ^TMP("FSC LIST CALLS",$J)
- ..S ^TMP("FSC LIST CALLS",$J)="0^0"
- ..S VALMCNT=0
- ..S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,CALL)) Q:CALL<1 D
- ...S PRIMARY=+$P($G(^FSCD("CALL",CALL,120)),U,24) I 'PRIMARY Q
- ...S ^TMP("FSC MERGE",$J,"CX",PRIMARY)=""
- ..S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"CX",CALL)) Q:CALL<1 D
- ...S ^TMP("FSC MERGE",$J,CALL)=""
- ..S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"CX",CALL)) Q:CALL<1 D
- ...S SECOND=0 F S SECOND=$O(^FSCD("CALL","APRIMARY",CALL,SECOND)) Q:SECOND<1 D
- ....S ^TMP("FSC MERGE",$J,SECOND)=""
- ..S CALL="A" F S CALL=$O(^TMP("FSC MERGE",$J,CALL),-1) Q:CALL="" D
- ...D SETUP^FSCLMPQU(.VALMCNT,CALL)
- ..D COUNT^FSCLMPQU(VALMCNT)
- ..D HDR^FSCLMPQU
- ..K ^TMP("FSC MERGE",$J)
- .I SELECT="S" D Q
- ..N CALL,CALLS,DIC,Y K CALLS,DIC
- ..S DIC=7100,DIC(0)="AEMOQ",DIC("A")="Select Call: "
- ..F D ^DIC Q:Y<1 S CALLS(+Y)=""
- ..K DIC
- ..I '$O(CALLS(0)) Q
- ..S CALL=0 F S CALL=$O(CALLS(CALL)) Q:CALL<1 I '$D(^TMP("FSC LIST CALLS",$J,"CX",CALL)) D SETUP^FSCLMPQU(.VALMCNT,CALL)
- ..D COUNT^FSCLMPQU(VALMCNT)
- .I SELECT="L" D Q
- ..N CALL,LIMIT,LIMITS,LINDX,LISTNUM,LISTS,LNAME,LNUM,OK,RLIST,TIME K LIMITS,LISTS
- ..D LIST^FSCLMPQU(.LISTS,.LIMITS,.OK)
- ..I 'OK Q
- ..I '$O(LISTS(0)) Q
- ..S LISTNUM=0 F S LISTNUM=$O(LISTS(LISTNUM)) Q:LISTNUM<1 S RLIST=LISTS(LISTNUM),FSCLIMIT=LIMITS(LISTNUM) D I $D(VALMQUIT) Q
- ...S LNAME=$P(^FSC("LIST",+$P(LISTNUM,"."),0),U),LINDX=+$P(LISTNUM,".",2)
- ...I LNAME="MRE:" D Q
- ....S (LIMIT,LNUM)=0,TIME="" F S TIME=$O(^FSCD("MRE","AUTC",LINDX,TIME)) Q:TIME="" D Q:LIMIT
- .....S CALL=0 F S CALL=$O(^FSCD("MRE","AUTC",LINDX,TIME,CALL)) Q:CALL<1 I '$D(^TMP("FSC LIST CALLS",$J,"CX",CALL)) D CHECK(.VALMCNT,CALL,.LIMIT,.LNUM) Q:LIMIT
- ...I LNAME="MRA:" D Q
- ....S (LIMIT,LNUM)=0,TIME="" F S TIME=$O(^FSCD("MRA","AUTC",LINDX,TIME)) Q:TIME="" D Q:LIMIT
- .....S CALL=0 F S CALL=$O(^FSCD("MRA","AUTC",LINDX,TIME,CALL)) Q:CALL<1 I '$D(^TMP("FSC LIST CALLS",$J,"CX",CALL)) D CHECK(.VALMCNT,CALL,.LIMIT,.LNUM) Q:LIMIT
- ...S (LIMIT,LNUM)=0,CALL="A" F S CALL=$O(@RLIST@(CALL),-1) Q:CALL<1 I '$D(^TMP("FSC LIST CALLS",$J,"CX",CALL)) D CHECK(.VALMCNT,CALL,.LIMIT,.LNUM) Q:LIMIT I (VALMCNT#10)=0 D CHECK^FSCLML(.VALMQUIT) I $D(VALMQUIT) S VALMBCK="Q" Q
- ..D COUNT^FSCLMPQU(VALMCNT)
- .I SELECT="Q" D Q
- ..D QUERY^FSCLMPQU("Add")
- I '$D(VALMQUIT) D EMPTY^FSCLMPQU
- S VALMBG=1
- Q
- ;
- CHECK(VALMCNT,CALL,LIMIT,LNUM) ;
- N DATEO,LIMITOK
- I $G(FSCLIMIT) S LIMITOK=1 D Q:'LIMITOK
- .I $P(FSCLIMIT,U,2) S:LNUM'<$P(FSCLIMIT,U,2) LIMIT=1,LIMITOK=0 Q
- .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
- D SETUP^FSCLMPQU(.VALMCNT,CALL)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPQA 3839 printed Feb 18, 2025@23:44:59 Page 2
- FSCLMPQA ;SLC/STAFF-NOIS List Manager Protocol Query Add ;3/24/98 11:47
- +1 ;;1.1;NOIS;;Sep 06, 1998
- +2 ;
- ADD ; from FSCLMP
- +1 NEW DIR,FSCLIMIT,SELECT,X,Y
- KILL DIR
- +2 SET VALMCNT=+$PIECE(^TMP("FSC LIST CALLS",$JOB),U,2)
- IF VALMCNT=0
- KILL ^($JOB)
- SET ^($JOB)="0^0"
- +3 SET DIR(0)="SAMO^S:Selected Calls;L:Lists;Q:Query;E:Expand"
- +4 SET DIR("A")="Add using: "
- WRITE !,"(S)elected Calls, (L)ists, (Q)uery, (E)xpand"
- +5 SET DIR("?",1)="Enter S to add to the list specific calls."
- +6 SET DIR("?",2)="Enter L to add to the list calls from other lists."
- +7 SET DIR("?",3)="Enter Q to add to the list calls meeting a specific criteria."
- +8 SET DIR("?",4)="Enter E to to expand list to all duplicates."
- +9 SET DIR("?",5)="Note: changing a list does not change calls 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="E"
- Begin DoDot:2
- +18 NEW CALL,PRIMARY,SECOND
- KILL ^TMP("FSC MERGE",$JOB)
- +19 MERGE ^TMP("FSC MERGE",$JOB)=^TMP("FSC LIST CALLS",$JOB,"CX")
- +20 KILL ^TMP("FSC LIST CALLS",$JOB)
- +21 SET ^TMP("FSC LIST CALLS",$JOB)="0^0"
- +22 SET VALMCNT=0
- +23 SET CALL=0
- FOR
- SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,CALL))
- if CALL<1
- QUIT
- Begin DoDot:3
- +24 SET PRIMARY=+$PIECE($GET(^FSCD("CALL",CALL,120)),U,24)
- IF 'PRIMARY
- QUIT
- +25 SET ^TMP("FSC MERGE",$JOB,"CX",PRIMARY)=""
- End DoDot:3
- +26 SET CALL=0
- FOR
- SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,"CX",CALL))
- if CALL<1
- QUIT
- Begin DoDot:3
- +27 SET ^TMP("FSC MERGE",$JOB,CALL)=""
- End DoDot:3
- +28 SET CALL=0
- FOR
- SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,"CX",CALL))
- if CALL<1
- QUIT
- Begin DoDot:3
- +29 SET SECOND=0
- FOR
- SET SECOND=$ORDER(^FSCD("CALL","APRIMARY",CALL,SECOND))
- if SECOND<1
- QUIT
- Begin DoDot:4
- +30 SET ^TMP("FSC MERGE",$JOB,SECOND)=""
- End DoDot:4
- End DoDot:3
- +31 SET CALL="A"
- FOR
- SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,CALL),-1)
- if CALL=""
- QUIT
- Begin DoDot:3
- +32 DO SETUP^FSCLMPQU(.VALMCNT,CALL)
- End DoDot:3
- +33 DO COUNT^FSCLMPQU(VALMCNT)
- +34 DO HDR^FSCLMPQU
- +35 KILL ^TMP("FSC MERGE",$JOB)
- End DoDot:2
- QUIT
- +36 IF SELECT="S"
- Begin DoDot:2
- +37 NEW CALL,CALLS,DIC,Y
- KILL CALLS,DIC
- +38 SET DIC=7100
- SET DIC(0)="AEMOQ"
- SET DIC("A")="Select Call: "
- +39 FOR
- DO ^DIC
- if Y<1
- QUIT
- SET CALLS(+Y)=""
- +40 KILL DIC
- +41 IF '$ORDER(CALLS(0))
- QUIT
- +42 SET CALL=0
- FOR
- SET CALL=$ORDER(CALLS(CALL))
- if CALL<1
- QUIT
- IF '$DATA(^TMP("FSC LIST CALLS",$JOB,"CX",CALL))
- DO SETUP^FSCLMPQU(.VALMCNT,CALL)
- +43 DO COUNT^FSCLMPQU(VALMCNT)
- End DoDot:2
- QUIT
- +44 IF SELECT="L"
- Begin DoDot:2
- +45 NEW CALL,LIMIT,LIMITS,LINDX,LISTNUM,LISTS,LNAME,LNUM,OK,RLIST,TIME
- KILL LIMITS,LISTS
- +46 DO LIST^FSCLMPQU(.LISTS,.LIMITS,.OK)
- +47 IF 'OK
- QUIT
- +48 IF '$ORDER(LISTS(0))
- QUIT
- +49 SET LISTNUM=0
- FOR
- SET LISTNUM=$ORDER(LISTS(LISTNUM))
- if LISTNUM<1
- QUIT
- SET RLIST=LISTS(LISTNUM)
- SET FSCLIMIT=LIMITS(LISTNUM)
- Begin DoDot:3
- +50 SET LNAME=$PIECE(^FSC("LIST",+$PIECE(LISTNUM,"."),0),U)
- SET LINDX=+$PIECE(LISTNUM,".",2)
- +51 IF LNAME="MRE:"
- Begin DoDot:4
- +52 SET (LIMIT,LNUM)=0
- SET TIME=""
- FOR
- SET TIME=$ORDER(^FSCD("MRE","AUTC",LINDX,TIME))
- if TIME=""
- QUIT
- Begin DoDot:5
- +53 SET CALL=0
- FOR
- SET CALL=$ORDER(^FSCD("MRE","AUTC",LINDX,TIME,CALL))
- if CALL<1
- QUIT
- IF '$DATA(^TMP("FSC LIST CALLS",$JOB,"CX",CALL))
- DO CHECK(.VALMCNT,CALL,.LIMIT,.LNUM)
- if LIMIT
- QUIT
- End DoDot:5
- if LIMIT
- QUIT
- End DoDot:4
- QUIT
- +54 IF LNAME="MRA:"
- Begin DoDot:4
- +55 SET (LIMIT,LNUM)=0
- SET TIME=""
- FOR
- SET TIME=$ORDER(^FSCD("MRA","AUTC",LINDX,TIME))
- if TIME=""
- QUIT
- Begin DoDot:5
- +56 SET CALL=0
- FOR
- SET CALL=$ORDER(^FSCD("MRA","AUTC",LINDX,TIME,CALL))
- if CALL<1
- QUIT
- IF '$DATA(^TMP("FSC LIST CALLS",$JOB,"CX",CALL))
- DO CHECK(.VALMCNT,CALL,.LIMIT,.LNUM)
- if LIMIT
- QUIT
- End DoDot:5
- if LIMIT
- QUIT
- End DoDot:4
- QUIT
- +57 SET (LIMIT,LNUM)=0
- SET CALL="A"
- FOR
- SET CALL=$ORDER(@RLIST@(CALL),-1)
- if CALL<1
- QUIT
- IF '$DATA(^TMP("FSC LIST CALLS",$JOB,"CX",CALL))
- DO CHECK(.VALMCNT,CALL,.LIMIT,.LNUM)
- if LIMIT
- QUIT
- IF (VALMCNT#10)=0
- DO CHECK^FSCLML(.VALMQUIT)
- IF $DATA(VALMQUIT)
- SET VALMBCK="Q"
- QUIT
- End DoDot:3
- IF $DATA(VALMQUIT)
- QUIT
- +58 DO COUNT^FSCLMPQU(VALMCNT)
- End DoDot:2
- QUIT
- +59 IF SELECT="Q"
- Begin DoDot:2
- +60 DO QUERY^FSCLMPQU("Add")
- End DoDot:2
- QUIT
- End DoDot:1
- +61 IF '$DATA(VALMQUIT)
- DO EMPTY^FSCLMPQU
- +62 SET VALMBG=1
- +63 QUIT
- +64 ;
- CHECK(VALMCNT,CALL,LIMIT,LNUM) ;
- +1 NEW DATEO,LIMITOK
- +2 IF $GET(FSCLIMIT)
- SET LIMITOK=1
- Begin DoDot:1
- +3 IF $PIECE(FSCLIMIT,U,2)
- if LNUM'<$PIECE(FSCLIMIT,U,2)
- SET LIMIT=1
- SET LIMITOK=0
- 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
- +8 DO SETUP^FSCLMPQU(.VALMCNT,CALL)
- +9 QUIT