FSCULOOK ;SLC/STAFF-NOIS Utilities Lookup ;1/11/98 18:55
;;1.1;NOIS;;Sep 06, 1998
;
LOOKUP(ITEM,DEFAULT,PARAM,OK,SCREEN) ; from FSCLMPC, FSCLMPQU, FSCOPT, FSCRPTS, FSCUEDIT, FSCUX
N DIC,DLAYGO,Y K DIC,Y
S DEFAULT=$G(DEFAULT),SCREEN=$G(SCREEN)
D LOOK(ITEM,DEFAULT,PARAM,SCREEN,.DIC,.OK)
I 'OK Q
I DIC(0)["L" S DLAYGO=DIC
D ^DIC K DIC
D VALUE(.DEFAULT,.Y,.OK)
Q
;
LOOK(ITEM,DEFAULT,PARAM,SCREEN,DIC,OK) ;
S OK=1
S DIC(0)=PARAM
I $L(DEFAULT) S DIC("B")=DEFAULT
I $L(SCREEN) S DIC("S")=SCREEN
I ITEM="CALL" S DIC=7100,DIC("A")="Select Call: " Q
I ITEM="LIST" S DIC=7107.1,DIC("A")="Select List: " Q
I ITEM="PARAM" S DIC=7109,DIC("A")="Select Parameter: " Q
I ITEM="RPT" S DIC=7107.5,DIC("A")="Select Report: " Q
I ITEM="MOD" S DIC=7105.4,DIC("A")="Select Module/Version: " Q
I ITEM="SITE" S DIC=7105.1,DIC("A")="Select "_$$NAME(ITEM)_": " Q
I ITEM="SPEC" S DIC=7105.2,DIC("A")="Select Specialist: " Q
I ITEM="FORMAT" S DIC=7107.6,DIC("A")="Select Format: " Q
I ITEM="FTYPE" S DIC=7107.7,DIC("A")="Select Display Format: " Q
I ITEM="ISC" S DIC=7105.3,DIC("A")="Select "_$$NAME(ITEM)_": " Q
I ITEM="PRI" S DIC=7106.2,DIC("A")="Select Priority: " Q
I ITEM="PARAM" S DIC=7109,DIC("A")="Select Parameter: ",DIC("S")="I Y=1"
I ITEM="SUB" S DIC=7105.6,DIC("A")="Select Subcomponent: " Q
I ITEM="TASK" S DIC=7106.3,DIC("A")="Select Task: " Q
I ITEM="FUNC" S DIC=7106.4,DIC("A")="Select Functional Area: " Q
I ITEM="PACK" S DIC=7105.5,DIC("A")="Select Package: " Q
I ITEM="WORK" S DIC=7103.5,DIC("A")="Select Workload: " Q
I ITEM="STATUS" S DIC=7100.5,DIC("A")="Select Status History: " Q
K DIC S OK=0
Q
;
VALUE(DEFAULT,Y,OK) ;
S DEFAULT=Y
I $D(Y(0)) S DEFAULT(0)=Y(0)
I Y<1 S OK=0
Q
;
NAME(ABBREV) ; $$(abbreviation) -> text of field
N FLD
S FLD=+$O(^FSC("FLD","AC",ABBREV,0))
Q:'$D(^FSC("FLD",FLD,0)) "" Q $P(^(0),U,2)
;
LIST(LIST,RESTRICT,OK) ; from FSCLMPC, FSCLMPQU, FSCOPT, FSCRPTS, FSCUM
N DEFAULT,X
S DEFAULT=$G(LIST)
F D Q:$D(OK)
.S RESTRICT=0
.W !,"Select List: "_$S($L(DEFAULT):DEFAULT_"// ",1:"") R X:DTIME S:$L(DEFAULT)&'$L(X) X=DEFAULT I '$T S OK=0 Q
.I X[U!'$L(X) S LIST=-1,OK=0 Q
.I $E(X,1,2)="R."!($E(X,1,2)="r.") S RESTRICT=1,X=$E(X,3,245) I '$L(X) S X="?"
.D LOOKUP("LIST",.LIST,"EMOQ",.OK) I 'OK K OK Q
.I 'RESTRICT,$$ASK^FSCLIMIT(LIST) S RESTRICT=1
.I RESTRICT D RESTRICT^FSCLIMIT(.RESTRICT) I '$L(RESTRICT) K OK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCULOOK 2444 printed Oct 16, 2024@18:21:04 Page 2
FSCULOOK ;SLC/STAFF-NOIS Utilities Lookup ;1/11/98 18:55
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
LOOKUP(ITEM,DEFAULT,PARAM,OK,SCREEN) ; from FSCLMPC, FSCLMPQU, FSCOPT, FSCRPTS, FSCUEDIT, FSCUX
+1 NEW DIC,DLAYGO,Y
KILL DIC,Y
+2 SET DEFAULT=$GET(DEFAULT)
SET SCREEN=$GET(SCREEN)
+3 DO LOOK(ITEM,DEFAULT,PARAM,SCREEN,.DIC,.OK)
+4 IF 'OK
QUIT
+5 IF DIC(0)["L"
SET DLAYGO=DIC
+6 DO ^DIC
KILL DIC
+7 DO VALUE(.DEFAULT,.Y,.OK)
+8 QUIT
+9 ;
LOOK(ITEM,DEFAULT,PARAM,SCREEN,DIC,OK) ;
+1 SET OK=1
+2 SET DIC(0)=PARAM
+3 IF $LENGTH(DEFAULT)
SET DIC("B")=DEFAULT
+4 IF $LENGTH(SCREEN)
SET DIC("S")=SCREEN
+5 IF ITEM="CALL"
SET DIC=7100
SET DIC("A")="Select Call: "
QUIT
+6 IF ITEM="LIST"
SET DIC=7107.1
SET DIC("A")="Select List: "
QUIT
+7 IF ITEM="PARAM"
SET DIC=7109
SET DIC("A")="Select Parameter: "
QUIT
+8 IF ITEM="RPT"
SET DIC=7107.5
SET DIC("A")="Select Report: "
QUIT
+9 IF ITEM="MOD"
SET DIC=7105.4
SET DIC("A")="Select Module/Version: "
QUIT
+10 IF ITEM="SITE"
SET DIC=7105.1
SET DIC("A")="Select "_$$NAME(ITEM)_": "
QUIT
+11 IF ITEM="SPEC"
SET DIC=7105.2
SET DIC("A")="Select Specialist: "
QUIT
+12 IF ITEM="FORMAT"
SET DIC=7107.6
SET DIC("A")="Select Format: "
QUIT
+13 IF ITEM="FTYPE"
SET DIC=7107.7
SET DIC("A")="Select Display Format: "
QUIT
+14 IF ITEM="ISC"
SET DIC=7105.3
SET DIC("A")="Select "_$$NAME(ITEM)_": "
QUIT
+15 IF ITEM="PRI"
SET DIC=7106.2
SET DIC("A")="Select Priority: "
QUIT
+16 IF ITEM="PARAM"
SET DIC=7109
SET DIC("A")="Select Parameter: "
SET DIC("S")="I Y=1"
+17 IF ITEM="SUB"
SET DIC=7105.6
SET DIC("A")="Select Subcomponent: "
QUIT
+18 IF ITEM="TASK"
SET DIC=7106.3
SET DIC("A")="Select Task: "
QUIT
+19 IF ITEM="FUNC"
SET DIC=7106.4
SET DIC("A")="Select Functional Area: "
QUIT
+20 IF ITEM="PACK"
SET DIC=7105.5
SET DIC("A")="Select Package: "
QUIT
+21 IF ITEM="WORK"
SET DIC=7103.5
SET DIC("A")="Select Workload: "
QUIT
+22 IF ITEM="STATUS"
SET DIC=7100.5
SET DIC("A")="Select Status History: "
QUIT
+23 KILL DIC
SET OK=0
+24 QUIT
+25 ;
VALUE(DEFAULT,Y,OK) ;
+1 SET DEFAULT=Y
+2 IF $DATA(Y(0))
SET DEFAULT(0)=Y(0)
+3 IF Y<1
SET OK=0
+4 QUIT
+5 ;
NAME(ABBREV) ; $$(abbreviation) -> text of field
+1 NEW FLD
+2 SET FLD=+$ORDER(^FSC("FLD","AC",ABBREV,0))
+3 if '$DATA(^FSC("FLD",FLD,0))
QUIT ""
QUIT $PIECE(^(0),U,2)
+4 ;
LIST(LIST,RESTRICT,OK) ; from FSCLMPC, FSCLMPQU, FSCOPT, FSCRPTS, FSCUM
+1 NEW DEFAULT,X
+2 SET DEFAULT=$GET(LIST)
+3 FOR
Begin DoDot:1
+4 SET RESTRICT=0
+5 WRITE !,"Select List: "_$SELECT($LENGTH(DEFAULT):DEFAULT_"// ",1:"")
READ X:DTIME
if $LENGTH(DEFAULT)&'$LENGTH(X)
SET X=DEFAULT
IF '$TEST
SET OK=0
QUIT
+6 IF X[U!'$LENGTH(X)
SET LIST=-1
SET OK=0
QUIT
+7 IF $EXTRACT(X,1,2)="R."!($EXTRACT(X,1,2)="r.")
SET RESTRICT=1
SET X=$EXTRACT(X,3,245)
IF '$LENGTH(X)
SET X="?"
+8 DO LOOKUP("LIST",.LIST,"EMOQ",.OK)
IF 'OK
KILL OK
QUIT
+9 IF 'RESTRICT
IF $$ASK^FSCLIMIT(LIST)
SET RESTRICT=1
+10 IF RESTRICT
DO RESTRICT^FSCLIMIT(.RESTRICT)
IF '$LENGTH(RESTRICT)
KILL OK
End DoDot:1
if $DATA(OK)
QUIT
+11 QUIT
