FSCLMPQU ;SLC/STAFF-NOIS List Manager Protocol Query Utility ;9/6/98  21:08
 ;;1.1;NOIS;;Sep 06, 1998
 ;
SETUP(VALMCNT,CALL) ; from FSCELL, FSCLMPQA, FSCLMPQR, FSCLMPQS
 N LISTNUM
 S VALMCNT=VALMCNT+1
 S LISTNUM=1+$G(^TMP("FSC LIST CALLS",$J)),^($J)=LISTNUM_U_VALMCNT
 S ^TMP("FSC LIST CALLS",$J,VALMCNT,0)=$$SHORT^FSCGETS(CALL,LISTNUM)
 S ^TMP("FSC LIST CALLS",$J,"CX",CALL)=""
 S ^TMP("FSC LIST CALLS",$J,"ICX",VALMCNT,CALL)=""
 S ^TMP("FSC LIST CALLS",$J,"IDX",LISTNUM,VALMCNT)=""
 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
 ;
COUNT(VALMCNT) ; from FSCELL, FSCLMPQA, FSCLMPQR, FSCLMPQS
 N LISTNUM,LNUM
 S (LISTNUM,LNUM)=0 F  S LISTNUM=$O(^TMP("FSC LIST CALLS",$J,"IDX",LISTNUM)) Q:LISTNUM<1  S LNUM=LNUM+1
 S ^TMP("FSC LIST CALLS",$J)=LNUM_U_VALMCNT
 D HDR
 Q
 ;
HDR ; from FSCLMPQA, FSCLMPQQ, FSCLMPQR
 S:FSCLNAME'["(MODIFIED)" FSCLNAME=FSCLNAME_" (MODIFIED)" D HEADER^FSCLML
 Q
 ;
LIST(RLISTS,LIMITS,OK) ; from FSCLMPQA, FSCLMPQR, FSCLMPQS
 N FIELD0,INDX,LNAME,LNUM,RLIST
 S OK=1 F  D  Q:'$L(OK)
 .N FSCLIMIT,LIST
 .D LIST^FSCULOOK(.LIST,.FSCLIMIT,.OK)
 .I LIST<1!'OK  S OK="" Q
 .S LNUM=+LIST,LNAME=$P(LIST,U,2)
 .S L0=^FSC("LIST",LNUM,0)
 .S RLIST="^FSCD(""LISTS"",""ALC"","_LNUM_")"
 .I $L($P(L0,U,4)),'$P(L0,U,5) S RLIST="^FSCD(""CALL"","_$P(L0,U,4)_")"
 .I $P(L0,U,5) D  Q:'$G(INDX)
 ..N DIC,FIELD0 K DIC S FIELD0=$G(^FSC("FLD",$P(L0,U,5),0)),DIC=+$P($P(FIELD0,U,3),"P",2) Q:'DIC
 ..S DIC(0)="AEMOQ",DIC("A")="Select "_$P(FIELD0,U,2)_": "
 ..I $E(LNAME,1,4)="MRE:"!($E(LNAME,1,4)="MRA:") S DIC("A")="  Select User: ",DIC("B")=DUZ
 ..D ^DIC K DIC Q:Y<1
 ..S INDX=+Y,LNAME=LNAME_" "_$P(Y,U,2),RLIST="^FSCD(""CALL"","_$P(L0,U,4)_","_INDX_")"
 ..I INDX S LIST=+LIST_"."_INDX
 .I $P(L0,U,3)="M" D
 ..S RLIST="^TMP(""FSC MLC"","_$J_","_LNUM_")"
 ..D MANUAL^FSCLP(LNUM)
 ..M ^TMP("FSC MLC",$J,LNUM)=^TMP("FSC LIST",$J)
 ..K ^TMP("FSC LIST",$J)
 .S LISTNUM=+LIST
 .S RLISTS(LISTNUM)=RLIST,LIMITS(LISTNUM)=FSCLIMIT
 .D MRU^FSCMR(DUZ,+$P(LISTNUM,"."),+$P(LISTNUM,".",2))
 I '$L(OK) S OK=1
 Q
 ;
QUERY(TYPE) ; from FSCLMPQA, FSCLMPQR, FSCLMPQS
 N CALL,MSG S MSG=1
 K ^TMP("FSC LIST",$J)
 S CALL=0 F  S CALL=$O(^TMP("FSC LIST CALLS",$J,"CX",CALL)) Q:CALL<1  S ^TMP("FSC LIST",$J,CALL,0)=CALL ;*** calls should be loaded with internal number of call
 D BROWSE^FSCQB("",FSCLNAME,.VALMCNT,.MSG,TYPE)
 S FSCQUERY=1 S:FSCLNAME'["(MODIFIED)" FSCLNAME=FSCLNAME_" (MODIFIED)"
 K VALMQUIT D ENTRY^FSCLML I $D(VALMQUIT) S VALMBCK="Q" Q
 D HEADER^FSCLML
 Q
 ;
EMPTY ; from FSCLML, FSCLMPQA, FSCLMPQR, FSCLMPQS
 I '^TMP("FSC LIST CALLS",$J),'$O(^($J,0)) D
 .S ^TMP("FSC LIST CALLS",$J,1,0)=" "
 .S ^TMP("FSC LIST CALLS",$J,2,0)="     No calls on list."
 .S VALMCNT=2
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPQU   2829     printed  Sep 23, 2025@19:54:52                                                                                                                                                                                                    Page 2
FSCLMPQU  ;SLC/STAFF-NOIS List Manager Protocol Query Utility ;9/6/98  21:08
 +1       ;;1.1;NOIS;;Sep 06, 1998
 +2       ;
SETUP(VALMCNT,CALL) ; from FSCELL, FSCLMPQA, FSCLMPQR, FSCLMPQS
 +1        NEW LISTNUM
 +2        SET VALMCNT=VALMCNT+1
 +3        SET LISTNUM=1+$GET(^TMP("FSC LIST CALLS",$JOB))
           SET ^($JOB)=LISTNUM_U_VALMCNT
 +4        SET ^TMP("FSC LIST CALLS",$JOB,VALMCNT,0)=$$SHORT^FSCGETS(CALL,LISTNUM)
 +5        SET ^TMP("FSC LIST CALLS",$JOB,"CX",CALL)=""
 +6        SET ^TMP("FSC LIST CALLS",$JOB,"ICX",VALMCNT,CALL)=""
 +7        SET ^TMP("FSC LIST CALLS",$JOB,"IDX",LISTNUM,VALMCNT)=""
 +8        IF $DATA(^TMP("FSC LIST CLEANUP",$JOB,CALL))
               Begin DoDot:1
 +9                SET VALMCNT=VALMCNT+1
 +10               SET ^TMP("FSC LIST CALLS",$JOB,VALMCNT,0)="  "_^TMP("FSC LIST CLEANUP",$JOB,CALL)
               End DoDot:1
 +11       QUIT 
 +12      ;
COUNT(VALMCNT) ; from FSCELL, FSCLMPQA, FSCLMPQR, FSCLMPQS
 +1        NEW LISTNUM,LNUM
 +2        SET (LISTNUM,LNUM)=0
           FOR 
               SET LISTNUM=$ORDER(^TMP("FSC LIST CALLS",$JOB,"IDX",LISTNUM))
               if LISTNUM<1
                   QUIT 
               SET LNUM=LNUM+1
 +3        SET ^TMP("FSC LIST CALLS",$JOB)=LNUM_U_VALMCNT
 +4        DO HDR
 +5        QUIT 
 +6       ;
HDR       ; from FSCLMPQA, FSCLMPQQ, FSCLMPQR
 +1        if FSCLNAME'["(MODIFIED)"
               SET FSCLNAME=FSCLNAME_" (MODIFIED)"
           DO HEADER^FSCLML
 +2        QUIT 
 +3       ;
LIST(RLISTS,LIMITS,OK) ; from FSCLMPQA, FSCLMPQR, FSCLMPQS
 +1        NEW FIELD0,INDX,LNAME,LNUM,RLIST
 +2        SET OK=1
           FOR 
               Begin DoDot:1
 +3                NEW FSCLIMIT,LIST
 +4                DO LIST^FSCULOOK(.LIST,.FSCLIMIT,.OK)
 +5                IF LIST<1!'OK
                       SET OK=""
                       QUIT 
 +6                SET LNUM=+LIST
                   SET LNAME=$PIECE(LIST,U,2)
 +7                SET L0=^FSC("LIST",LNUM,0)
 +8                SET RLIST="^FSCD(""LISTS"",""ALC"","_LNUM_")"
 +9                IF $LENGTH($PIECE(L0,U,4))
                       IF '$PIECE(L0,U,5)
                           SET RLIST="^FSCD(""CALL"","_$PIECE(L0,U,4)_")"
 +10               IF $PIECE(L0,U,5)
                       Begin DoDot:2
 +11                       NEW DIC,FIELD0
                           KILL DIC
                           SET FIELD0=$GET(^FSC("FLD",$PIECE(L0,U,5),0))
                           SET DIC=+$PIECE($PIECE(FIELD0,U,3),"P",2)
                           if 'DIC
                               QUIT 
 +12                       SET DIC(0)="AEMOQ"
                           SET DIC("A")="Select "_$PIECE(FIELD0,U,2)_": "
 +13                       IF $EXTRACT(LNAME,1,4)="MRE:"!($EXTRACT(LNAME,1,4)="MRA:")
                               SET DIC("A")="  Select User: "
                               SET DIC("B")=DUZ
 +14                       DO ^DIC
                           KILL DIC
                           if Y<1
                               QUIT 
 +15                       SET INDX=+Y
                           SET LNAME=LNAME_" "_$PIECE(Y,U,2)
                           SET RLIST="^FSCD(""CALL"","_$PIECE(L0,U,4)_","_INDX_")"
 +16                       IF INDX
                               SET LIST=+LIST_"."_INDX
                       End DoDot:2
                       if '$GET(INDX)
                           QUIT 
 +17               IF $PIECE(L0,U,3)="M"
                       Begin DoDot:2
 +18                       SET RLIST="^TMP(""FSC MLC"","_$JOB_","_LNUM_")"
 +19                       DO MANUAL^FSCLP(LNUM)
 +20                       MERGE ^TMP("FSC MLC",$JOB,LNUM)=^TMP("FSC LIST",$JOB)
 +21                       KILL ^TMP("FSC LIST",$JOB)
                       End DoDot:2
 +22               SET LISTNUM=+LIST
 +23               SET RLISTS(LISTNUM)=RLIST
                   SET LIMITS(LISTNUM)=FSCLIMIT
 +24               DO MRU^FSCMR(DUZ,+$PIECE(LISTNUM,"."),+$PIECE(LISTNUM,".",2))
               End DoDot:1
               if '$LENGTH(OK)
                   QUIT 
 +25       IF '$LENGTH(OK)
               SET OK=1
 +26       QUIT 
 +27      ;
QUERY(TYPE) ; from FSCLMPQA, FSCLMPQR, FSCLMPQS
 +1        NEW CALL,MSG
           SET MSG=1
 +2        KILL ^TMP("FSC LIST",$JOB)
 +3       ;*** calls should be loaded with internal number of call
           SET CALL=0
           FOR 
               SET CALL=$ORDER(^TMP("FSC LIST CALLS",$JOB,"CX",CALL))
               if CALL<1
                   QUIT 
               SET ^TMP("FSC LIST",$JOB,CALL,0)=CALL
 +4        DO BROWSE^FSCQB("",FSCLNAME,.VALMCNT,.MSG,TYPE)
 +5        SET FSCQUERY=1
           if FSCLNAME'["(MODIFIED)"
               SET FSCLNAME=FSCLNAME_" (MODIFIED)"
 +6        KILL VALMQUIT
           DO ENTRY^FSCLML
           IF $DATA(VALMQUIT)
               SET VALMBCK="Q"
               QUIT 
 +7        DO HEADER^FSCLML
 +8        QUIT 
 +9       ;
EMPTY     ; from FSCLML, FSCLMPQA, FSCLMPQR, FSCLMPQS
 +1        IF '^TMP("FSC LIST CALLS",$JOB)
               IF '$ORDER(^($JOB,0))
                   Begin DoDot:1
 +2                    SET ^TMP("FSC LIST CALLS",$JOB,1,0)=" "
 +3                    SET ^TMP("FSC LIST CALLS",$JOB,2,0)="     No calls on list."
 +4                    SET VALMCNT=2
                   End DoDot:1
 +5        QUIT