FSCLMPC ;SLC/STAFF-NOIS List Manager Protocol Change ;1/13/98 12:39
;;1.1;NOIS;;Sep 06, 1998
;
LIST ; from FSCLMP
N FSCLIMIT,LIST,OK
D LIST^FSCULOOK(.LIST,.FSCLIMIT,.OK)
I 'OK Q
N FSCINDX
S FSCLNAME=$P(LIST,U,2),FSCLNUM=+LIST,FSCL0=$G(^FSC("LIST",FSCLNUM,0))
I $P(FSCL0,U,5) D INDEX^FSCLM(.FSCLNAME,.FSCINDX,FSCL0) Q:'$G(FSCINDX)
D MRU^FSCMR(DUZ,FSCLNUM,+$G(FSCINDX))
S VALMSG="",VALMBG=1 K VALMQUIT D ENTRY^FSCLML I $D(VALMQUIT) S VALMBCK="Q" Q
D HEADER^FSCLML
Q
;
LD ; from FSCLMP
I $D(FSCQEDIT) D ASKLIST^FSCLMPD
N LIST,OK
D LOOKUP^FSCULOOK("LIST",.LIST,"AEMOQ",.OK)
I OK D MODIFY^FSCLM($P(LIST,U,2),+LIST) S VALMBCK="Q" Q
Q
;
STYLE ; from FSCLMP
N OK
S FSCSTYLE=$E(FSCSTYLE)
D EXPAND^FSCUX(.FSCSTYLE,.OK)
I OK D
.S FSCSTYLE=$$STYLE^FSCU(FSCSTYLE)
.S VALMAR="^TMP("_"""FSC MULT "_FSCSTYLE_""""_",$J,+$G(FSCCNT))"
.S VALMCNT=0 D BUILD^FSCFORM(FSCCNT,+$G(^TMP("FSC MULT",$J,FSCCNT)),.FSCSTYLE,.VALMCNT,"FSC MULT ")
.S VALMBG=1
.S VALMCAP=$$CAP^FSCU("E",.FSCSTYLE,FSCCNT)
S VALMBCK=$S($G(FSCEXIT):"Q",$D(FSCSTYLE("E")):"Q",$D(FSCSTYLE("T")):"Q",1:"R")
Q
;
VC ; from FSCLMP
N AVAIL,OK S AVAIL=$G(^TMP("FSC SELECT",$J,"VVALUES"))
I '$L(AVAIL) Q
D SELECT^FSCUL(AVAIL,"S","","OTHER",.OK)
I OK D
.S VALMBG=+$O(@VALMAR@("IDX",+$O(^TMP("FSC LIST CALLS",$J,"IDX",+^TMP("FSC SELECT",$J,"OTHER"),0)),0))
Q
;
VIEW ; from FSCLMP
N CALLCNT,CALLNUM,FIELD,FORMAT,LASTCNUM,LINENUM,LISTNUM,LISTSEL,NUM,OK K FORMAT
S FORMAT="",OK=1 D EXPAND^FSCUX(.FORMAT,.OK) I 'OK Q
K FSCFMT S (FSCFMT,FSCSTYLE)=$$STYLE^FSCU(FORMAT),FIELD="" F S FIELD=$O(FORMAT(FIELD)) Q:FIELD="" S FSCFMT(FIELD)=FORMAT(FIELD)
S LASTCNUM=1,NUM=0 F S NUM=$O(@VALMAR@("IDX",NUM)) Q:NUM<1 S LASTCNUM=NUM I $O(@VALMAR@("IDX",NUM,0))>VALMBG Q
S LASTCNUM=+$O(@VALMAR@("IDX",LASTCNUM),-1)
I $O(^TMP("FSC VIEW "_FSCFMT,$J,0)),FSCFMT="BRIEF"!(FSCFMT="DETAIL") D Q
.S VALMAR="^TMP(""FSC VIEW "_FSCFMT_""",$J)"
.S VALMCAP=$$CAP^FSCU("V",.FSCSTYLE),CALLCNT=+$P(@VALMAR,U),VALMCNT=+$P(@VALMAR,U,2),VALMBG=$S(LASTCNUM:+$O(@VALMAR@("IDX",LASTCNUM,0)),1:1)
K ^TMP("FSC VIEW "_FSCFMT,$J)
S LISTSEL="VVALUES"
S VALMCNT=0
S VALMCAP=$$CAP^FSCU("V",.FSCSTYLE)
W !
S (CALLCNT,LISTNUM)=0 F S LISTNUM=$O(^TMP("FSC SELECT",$J,LISTSEL,LISTNUM)) Q:LISTNUM<1 D
.S CALLCNT=CALLCNT+1
.S LINENUM=+$O(^TMP("FSC LIST CALLS",$J,"IDX",LISTNUM,0)),CALLNUM=+$O(^TMP("FSC LIST CALLS",$J,"ICX",LINENUM,0))
.D BUILD^FSCFORM(LINENUM,CALLNUM,.FSCFMT,.VALMCNT,"FSC VIEW ")
S VALMAR="^TMP(""FSC VIEW "_FSCFMT_""",$J)"
S @VALMAR=CALLCNT_U_VALMCNT
S VALMBG=$S(LASTCNUM:+$O(@VALMAR@("IDX",LASTCNUM,0)),1:1)
I VALMBG<17,$P(@VALMAR,U,2)<17 S VALMBG=1
D VIDEOOFF^FSCU
S VALMBCK=$S($G(FSCEXIT):"Q",$D(FSCFMT("E")):"Q",$D(FSCFMT("T")):"Q",1:"R")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPC 2785 printed Nov 22, 2024@17:28:11 Page 2
FSCLMPC ;SLC/STAFF-NOIS List Manager Protocol Change ;1/13/98 12:39
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
LIST ; from FSCLMP
+1 NEW FSCLIMIT,LIST,OK
+2 DO LIST^FSCULOOK(.LIST,.FSCLIMIT,.OK)
+3 IF 'OK
QUIT
+4 NEW FSCINDX
+5 SET FSCLNAME=$PIECE(LIST,U,2)
SET FSCLNUM=+LIST
SET FSCL0=$GET(^FSC("LIST",FSCLNUM,0))
+6 IF $PIECE(FSCL0,U,5)
DO INDEX^FSCLM(.FSCLNAME,.FSCINDX,FSCL0)
if '$GET(FSCINDX)
QUIT
+7 DO MRU^FSCMR(DUZ,FSCLNUM,+$GET(FSCINDX))
+8 SET VALMSG=""
SET VALMBG=1
KILL VALMQUIT
DO ENTRY^FSCLML
IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+9 DO HEADER^FSCLML
+10 QUIT
+11 ;
LD ; from FSCLMP
+1 IF $DATA(FSCQEDIT)
DO ASKLIST^FSCLMPD
+2 NEW LIST,OK
+3 DO LOOKUP^FSCULOOK("LIST",.LIST,"AEMOQ",.OK)
+4 IF OK
DO MODIFY^FSCLM($PIECE(LIST,U,2),+LIST)
SET VALMBCK="Q"
QUIT
+5 QUIT
+6 ;
STYLE ; from FSCLMP
+1 NEW OK
+2 SET FSCSTYLE=$EXTRACT(FSCSTYLE)
+3 DO EXPAND^FSCUX(.FSCSTYLE,.OK)
+4 IF OK
Begin DoDot:1
+5 SET FSCSTYLE=$$STYLE^FSCU(FSCSTYLE)
+6 SET VALMAR="^TMP("_"""FSC MULT "_FSCSTYLE_""""_",$J,+$G(FSCCNT))"
+7 SET VALMCNT=0
DO BUILD^FSCFORM(FSCCNT,+$GET(^TMP("FSC MULT",$JOB,FSCCNT)),.FSCSTYLE,.VALMCNT,"FSC MULT ")
+8 SET VALMBG=1
+9 SET VALMCAP=$$CAP^FSCU("E",.FSCSTYLE,FSCCNT)
End DoDot:1
+10 SET VALMBCK=$SELECT($GET(FSCEXIT):"Q",$DATA(FSCSTYLE("E")):"Q",$DATA(FSCSTYLE("T")):"Q",1:"R")
+11 QUIT
+12 ;
VC ; from FSCLMP
+1 NEW AVAIL,OK
SET AVAIL=$GET(^TMP("FSC SELECT",$JOB,"VVALUES"))
+2 IF '$LENGTH(AVAIL)
QUIT
+3 DO SELECT^FSCUL(AVAIL,"S","","OTHER",.OK)
+4 IF OK
Begin DoDot:1
+5 SET VALMBG=+$ORDER(@VALMAR@("IDX",+$ORDER(^TMP("FSC LIST CALLS",$JOB,"IDX",+^TMP("FSC SELECT",$JOB,"OTHER"),0)),0))
End DoDot:1
+6 QUIT
+7 ;
VIEW ; from FSCLMP
+1 NEW CALLCNT,CALLNUM,FIELD,FORMAT,LASTCNUM,LINENUM,LISTNUM,LISTSEL,NUM,OK
KILL FORMAT
+2 SET FORMAT=""
SET OK=1
DO EXPAND^FSCUX(.FORMAT,.OK)
IF 'OK
QUIT
+3 KILL FSCFMT
SET (FSCFMT,FSCSTYLE)=$$STYLE^FSCU(FORMAT)
SET FIELD=""
FOR
SET FIELD=$ORDER(FORMAT(FIELD))
if FIELD=""
QUIT
SET FSCFMT(FIELD)=FORMAT(FIELD)
+4 SET LASTCNUM=1
SET NUM=0
FOR
SET NUM=$ORDER(@VALMAR@("IDX",NUM))
if NUM<1
QUIT
SET LASTCNUM=NUM
IF $ORDER(@VALMAR@("IDX",NUM,0))>VALMBG
QUIT
+5 SET LASTCNUM=+$ORDER(@VALMAR@("IDX",LASTCNUM),-1)
+6 IF $ORDER(^TMP("FSC VIEW "_FSCFMT,$JOB,0))
IF FSCFMT="BRIEF"!(FSCFMT="DETAIL")
Begin DoDot:1
+7 SET VALMAR="^TMP(""FSC VIEW "_FSCFMT_""",$J)"
+8 SET VALMCAP=$$CAP^FSCU("V",.FSCSTYLE)
SET CALLCNT=+$PIECE(@VALMAR,U)
SET VALMCNT=+$PIECE(@VALMAR,U,2)
SET VALMBG=$SELECT(LASTCNUM:+$ORDER(@VALMAR@("IDX",LASTCNUM,0)),1:1)
End DoDot:1
QUIT
+9 KILL ^TMP("FSC VIEW "_FSCFMT,$JOB)
+10 SET LISTSEL="VVALUES"
+11 SET VALMCNT=0
+12 SET VALMCAP=$$CAP^FSCU("V",.FSCSTYLE)
+13 WRITE !
+14 SET (CALLCNT,LISTNUM)=0
FOR
SET LISTNUM=$ORDER(^TMP("FSC SELECT",$JOB,LISTSEL,LISTNUM))
if LISTNUM<1
QUIT
Begin DoDot:1
+15 SET CALLCNT=CALLCNT+1
+16 SET LINENUM=+$ORDER(^TMP("FSC LIST CALLS",$JOB,"IDX",LISTNUM,0))
SET CALLNUM=+$ORDER(^TMP("FSC LIST CALLS",$JOB,"ICX",LINENUM,0))
+17 DO BUILD^FSCFORM(LINENUM,CALLNUM,.FSCFMT,.VALMCNT,"FSC VIEW ")
End DoDot:1
+18 SET VALMAR="^TMP(""FSC VIEW "_FSCFMT_""",$J)"
+19 SET @VALMAR=CALLCNT_U_VALMCNT
+20 SET VALMBG=$SELECT(LASTCNUM:+$ORDER(@VALMAR@("IDX",LASTCNUM,0)),1:1)
+21 IF VALMBG<17
IF $PIECE(@VALMAR,U,2)<17
SET VALMBG=1
+22 DO VIDEOOFF^FSCU
+23 SET VALMBCK=$SELECT($GET(FSCEXIT):"Q",$DATA(FSCFMT("E")):"Q",$DATA(FSCFMT("T")):"Q",1:"R")
+24 QUIT
