- 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 Feb 18, 2025@23:45:03 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