- 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 Feb 18, 2025@23:44:37 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