FSCLM ;SLC/STAFF-NOIS List Manager ;10/27/97 15:50
;;1.1;NOIS;;Sep 06, 1998
;
LIST(FSCLNAME,FSCINDX) ; from FSCOPT
N FSCL0,FSCLNUM
S FSCLNUM=+$O(^FSC("LIST","B",FSCLNAME,0))
S FSCL0=$G(^FSC("LIST",FSCLNUM,0))
I $P(FSCL0,U,5) D INDEX(.FSCLNAME,.FSCINDX,FSCL0) Q:'$G(FSCINDX)
D MRU^FSCMR(DUZ,FSCLNUM,+$G(FSCINDX))
S VALMSG=""
D EN^VALM("FSC LIST CALLS")
Q
;
MODIFY(FSCLNAME,FSCLNUM) ; from FSCLMPC, FSCLMPO
S VALMSG=""
D EN^VALM("FSC MODIFY LISTS")
Q
;
INSTALLS ; from FSCSTUR
S VALMSG=""
D EN^VALM("FSC INSTALLS")
Q
;
EDIT(FSCCALLS) ; from FSCLMPE, FSCOPT
I $O(^TMP("FSC SELECT",$J,FSCCALLS,+$O(^TMP("FSC SELECT",$J,FSCCALLS,0)))) D EN^VALM("FSC EDIT MULTIPLE CALLS") Q
S VALMSG=""
D EN^VALM("FSC EDIT SINGLE CALL")
Q
;
VIEW(LISTREF,LISTSEL,FSCFMT) ; from FSCLMPD, FSCOPT, FSCRPTS
; LIST = list #^list name
S VALMSG=""
D EN^VALM("FSC VIEW CALLS")
Q
;
INDEX(FSCLNAME,FSCINDX,FSCL0) ; from FSCLMPC, FSCRPTS
N DIC,FIELD0,X,Y K DIC
I '$G(FSCINDX) D Q
.S FIELD0=$G(^FSC("FLD",$P(FSCL0,U,5),0)),DIC=+$P($P(FIELD0,U,3),"P",2) I 'DIC Q
.S DIC(0)="AEMOQ",DIC("A")=" Select "_$P(FIELD0,U,2)_": "
.I $E(FSCLNAME,1,4)="MRE:"!($E(FSCLNAME,1,4)="MRA:") S DIC("A")=" Select User: ",DIC("B")=DUZ
.F D ^DIC Q:Y'<1 Q:$D(DTOUT) Q:$D(DUOUT) W " You must make an entry or '^' to exit.",$C(7)
.K DIC Q:$D(DTOUT) Q:$D(DUOUT)
.S FSCINDX=+Y,FSCLNAME=FSCLNAME_" "_$S($P(Y,U,2)'=+$P(Y,U,2):$P(Y,U,2),1:$$VALUE^FSCGET($P(Y,U,2),+$P($P(FIELD0,U,3),"P",2),.01))
S FSCLNAME=FSCLNAME_" "_$P(FSCINDX,U,2),FSCINDX=+FSCINDX
Q
;
PROTOHDR(SCREEN) ; from protocol header action on protocol menus
S XQORM("KEY","PAGE")=+$O(^ORD(101,"B","VALM GOTO PAGE",0))_"^1"
S (XQORM("KEY","SEARCH"),XQORM("KEY","ST"),XQORM("KEY","TEXT"))=+$O(^ORD(101,"B","VALM SEARCH LIST",0))_"^1"
S XQORM("KEY","QUI")=+$O(^ORD(101,"B","VALM QUIT",0))_"^1"
S XQORM("KEY","PG")=+$O(^ORD(101,"B","VALM GOTO PAGE",0))_"^1"
S XQORM("KEY","EXIT")=+$O(^ORD(101,"B","FSC HIDDEN EXIT",0))_"^1"
S XQORM("KEY","EX")=+$O(^ORD(101,"B","FSC HIDDEN EXIT",0))_"^1"
I SCREEN="LIST" D
.I XQORM("B")="View",VALMBG+15'>VALMCNT S XQORM("B")="Next Screen"
I SCREEN="EDIT" D
.I $O(^TMP("FSC MULT",$J,FSCCNT)),VALMBG+15>VALMCNT S XQORM("B")="Next Call"
I XQORM("B")="Quit",$$EXIT^FSCUF(DUZ) S XQORM("B")="Exit"
Q
;
NAV ; *** temporary call to reset hidden menu protocols, needs to be removed
S X=+$O(^ORD(101,"B","FSC MENU HIDDEN ACTIONS",0)) I X S X=X_";ORD(101," D EN^XQOR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLM 2516 printed Dec 13, 2024@02:18:04 Page 2
FSCLM ;SLC/STAFF-NOIS List Manager ;10/27/97 15:50
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
LIST(FSCLNAME,FSCINDX) ; from FSCOPT
+1 NEW FSCL0,FSCLNUM
+2 SET FSCLNUM=+$ORDER(^FSC("LIST","B",FSCLNAME,0))
+3 SET FSCL0=$GET(^FSC("LIST",FSCLNUM,0))
+4 IF $PIECE(FSCL0,U,5)
DO INDEX(.FSCLNAME,.FSCINDX,FSCL0)
if '$GET(FSCINDX)
QUIT
+5 DO MRU^FSCMR(DUZ,FSCLNUM,+$GET(FSCINDX))
+6 SET VALMSG=""
+7 DO EN^VALM("FSC LIST CALLS")
+8 QUIT
+9 ;
MODIFY(FSCLNAME,FSCLNUM) ; from FSCLMPC, FSCLMPO
+1 SET VALMSG=""
+2 DO EN^VALM("FSC MODIFY LISTS")
+3 QUIT
+4 ;
INSTALLS ; from FSCSTUR
+1 SET VALMSG=""
+2 DO EN^VALM("FSC INSTALLS")
+3 QUIT
+4 ;
EDIT(FSCCALLS) ; from FSCLMPE, FSCOPT
+1 IF $ORDER(^TMP("FSC SELECT",$JOB,FSCCALLS,+$ORDER(^TMP("FSC SELECT",$JOB,FSCCALLS,0))))
DO EN^VALM("FSC EDIT MULTIPLE CALLS")
QUIT
+2 SET VALMSG=""
+3 DO EN^VALM("FSC EDIT SINGLE CALL")
+4 QUIT
+5 ;
VIEW(LISTREF,LISTSEL,FSCFMT) ; from FSCLMPD, FSCOPT, FSCRPTS
+1 ; LIST = list #^list name
+2 SET VALMSG=""
+3 DO EN^VALM("FSC VIEW CALLS")
+4 QUIT
+5 ;
INDEX(FSCLNAME,FSCINDX,FSCL0) ; from FSCLMPC, FSCRPTS
+1 NEW DIC,FIELD0,X,Y
KILL DIC
+2 IF '$GET(FSCINDX)
Begin DoDot:1
+3 SET FIELD0=$GET(^FSC("FLD",$PIECE(FSCL0,U,5),0))
SET DIC=+$PIECE($PIECE(FIELD0,U,3),"P",2)
IF 'DIC
QUIT
+4 SET DIC(0)="AEMOQ"
SET DIC("A")=" Select "_$PIECE(FIELD0,U,2)_": "
+5 IF $EXTRACT(FSCLNAME,1,4)="MRE:"!($EXTRACT(FSCLNAME,1,4)="MRA:")
SET DIC("A")=" Select User: "
SET DIC("B")=DUZ
+6 FOR
DO ^DIC
if Y'<1
QUIT
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
WRITE " You must make an entry or '^' to exit.",$CHAR(7)
+7 KILL DIC
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
+8 SET FSCINDX=+Y
SET FSCLNAME=FSCLNAME_" "_$SELECT($PIECE(Y,U,2)'=+$PIECE(Y,U,2):$PIECE(Y,U,2),1:$$VALUE^FSCGET($PIECE(Y,U,2),+$PIECE($PIECE(FIELD0,U,3),"P",2),.01))
End DoDot:1
QUIT
+9 SET FSCLNAME=FSCLNAME_" "_$PIECE(FSCINDX,U,2)
SET FSCINDX=+FSCINDX
+10 QUIT
+11 ;
PROTOHDR(SCREEN) ; from protocol header action on protocol menus
+1 SET XQORM("KEY","PAGE")=+$ORDER(^ORD(101,"B","VALM GOTO PAGE",0))_"^1"
+2 SET (XQORM("KEY","SEARCH"),XQORM("KEY","ST"),XQORM("KEY","TEXT"))=+$ORDER(^ORD(101,"B","VALM SEARCH LIST",0))_"^1"
+3 SET XQORM("KEY","QUI")=+$ORDER(^ORD(101,"B","VALM QUIT",0))_"^1"
+4 SET XQORM("KEY","PG")=+$ORDER(^ORD(101,"B","VALM GOTO PAGE",0))_"^1"
+5 SET XQORM("KEY","EXIT")=+$ORDER(^ORD(101,"B","FSC HIDDEN EXIT",0))_"^1"
+6 SET XQORM("KEY","EX")=+$ORDER(^ORD(101,"B","FSC HIDDEN EXIT",0))_"^1"
+7 IF SCREEN="LIST"
Begin DoDot:1
+8 IF XQORM("B")="View"
IF VALMBG+15'>VALMCNT
SET XQORM("B")="Next Screen"
End DoDot:1
+9 IF SCREEN="EDIT"
Begin DoDot:1
+10 IF $ORDER(^TMP("FSC MULT",$JOB,FSCCNT))
IF VALMBG+15>VALMCNT
SET XQORM("B")="Next Call"
End DoDot:1
+11 IF XQORM("B")="Quit"
IF $$EXIT^FSCUF(DUZ)
SET XQORM("B")="Exit"
+12 QUIT
+13 ;
NAV ; *** temporary call to reset hidden menu protocols, needs to be removed
+1 SET X=+$ORDER(^ORD(101,"B","FSC MENU HIDDEN ACTIONS",0))
IF X
SET X=X_";ORD(101,"
DO EN^XQOR
+2 QUIT
