FSCUL ;SLC/STAFF-NOIS Utilities Lists ;1/13/98 17:13
;;1.1;NOIS;;Sep 06, 1998
;
EXPAND(CHOICE,OK,DEFAULT) ; from FSCLMPC, FSCLMPD
N CNT,DIC,DIR,X,Y K DIC,DIR,Y
S OK=1
S DIR(0)="SA^BRIEF:BRIEF;DETAILED:DETAILED;CUSTOM:CUSTOM;FIELDS:FIELDS;STATISTIC:STATISTIC"
S DIR("A")="Select (B)rief, (D)etailed, (C)ustom, (F)ields, or (S)tatistic: "
S DIR("B")=$G(DEFAULT,"BRIEF")
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) S OK=0,CHOICE=$G(CHOICE)
I OK K CHOICE S CHOICE=Y
S CHOICE=$S(CHOICE="BRIEF":"B",CHOICE="DETAILED":"D",CHOICE="CUSTOM":"F",CHOICE="FIELDS":"C",1:"S")
Q:'OK
I CHOICE="F" D
.S DIC=7107.6,DIC(0)="AEMOQ",DIC("A")="Select Format: " D ^DIC K DIC S:Y<1 OK=0 S CHOICE("F")=Y
I CHOICE="C" D
.S DIC=7107.2,DIC(0)="AEMOQZ",DIC("A")="Select Field: " F CNT=1:1 D ^DIC Q:Y<1 S CHOICE(CNT)=Y(0)
.K DIC
I CHOICE="S" D
.K ^TMP("FSC STATS",$J) S DIC=7107.2,DIC(0)="AEMOQZ",DIC("A")="Select Field: " F CNT=1:1 D ^DIC Q:Y<1 S CHOICE(CNT)=Y(0)
.K DIC
Q
;
SELECT(CHOICE,PARAM,DEFAULT,SELECT,OK) ; from FSCEB, FSCLMPC, FSCLMPCC, FSCLMPD, FSCLMPE, FSCLMPM, FSCLMPNB, FSCLMPNR, FSCLMPQR, FSCLMPQS, FSCLMPS, FSCNAS
; select a list of numbers
; ex. D ("1-7,15-22","S","","VALUES",.OK)
; returns ^TMP("FSC SELECT",$J,SELECT)=entry
; ^TMP("FSC SELECT",$J,SELECT,entry #)=""
; OK = 1:valid, 0:invalid
N ENTRY,PROMPT,X K ^TMP("FSC SELECT",$J,"AVAIL"),^(SELECT) S OK=1
S PROMPT=$P(PARAM,U,2),PARAM=$P(PARAM,U)
I CHOICE=+CHOICE S ^TMP("FSC SELECT",$J,SELECT)=CHOICE,^(SELECT,CHOICE)="" Q
I $P(CHOICE,"-")=$P(CHOICE,"-",2,99) S ^TMP("FSC SELECT",$J,SELECT)=+CHOICE,^(SELECT,+CHOICE)="" Q
D NUMS(CHOICE,"AVAIL")
S OK="" F W !,$S($L(PROMPT):PROMPT,1:"Select Calls")," (",CHOICE,"): ",$S($L($G(DEFAULT)):DEFAULT_"// ",1:"") R X:DTIME D Q:$L(OK)
.S:'$T X=U S:'$L(X) X=DEFAULT S:'$L(X) X=U I X[U S OK=0 Q
.I $E(X)'="?",$E(X)'=$E(+X) S OK="" W " invalid entry" Q
.I X["?" D Q
..I X["???" D Q
...W "HELP FRAME" ;***
..I X="??" D Q
...W "EXTENDED HELP" ;***
..I PARAM["S" W " enter only a single number" Q
..W " enter a number or number range (ex. 5,8-11)"
.S ENTRY=X
.K ^TMP("FSC SELECT",$J,SELECT)
.S ^TMP("FSC SELECT",$J,SELECT)=ENTRY
.I PARAM["S" D Q:'OK
..S OK=1
..I ENTRY'=+ENTRY W " enter a single number" S OK=""
.D NUMS(ENTRY,SELECT)
.S OK=1,X="" F S X=$O(^TMP("FSC SELECT",$J,SELECT,X)) Q:X="" I '$D(^TMP("FSC SELECT",$J,"AVAIL",X)) S OK="" Q
.I OK Q
.W " enter an appropriate number"
.K ^TMP("FSC SELECT",$J,SELECT)
K ^TMP("FSC SELECT",$J,"AVAIL")
Q
;
NUMS(STRING,SUB) ;
Q:STRING="1-0" N CNT,UNIT,UNIT1,UNIT2
F CNT=1:1 S UNIT=$P(STRING,",",CNT) Q:'$L(UNIT) D
.I UNIT'["-" S ^TMP("FSC SELECT",$J,SUB,UNIT)="" Q
.S UNIT1=+UNIT,UNIT2=+$P(UNIT,"-",2),^TMP("FSC SELECT",$J,SUB,UNIT1)="",^TMP("FSC SELECT",$J,SUB,UNIT2)=""
.F S UNIT1=UNIT1+1 Q:UNIT1'<UNIT2 S ^TMP("FSC SELECT",$J,SUB,UNIT1)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCUL 2926 printed Sep 23, 2025@19:56:43 Page 2
FSCUL ;SLC/STAFF-NOIS Utilities Lists ;1/13/98 17:13
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
EXPAND(CHOICE,OK,DEFAULT) ; from FSCLMPC, FSCLMPD
+1 NEW CNT,DIC,DIR,X,Y
KILL DIC,DIR,Y
+2 SET OK=1
+3 SET DIR(0)="SA^BRIEF:BRIEF;DETAILED:DETAILED;CUSTOM:CUSTOM;FIELDS:FIELDS;STATISTIC:STATISTIC"
+4 SET DIR("A")="Select (B)rief, (D)etailed, (C)ustom, (F)ields, or (S)tatistic: "
+5 SET DIR("B")=$GET(DEFAULT,"BRIEF")
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DUOUT)!$DATA(DTOUT)
SET OK=0
SET CHOICE=$GET(CHOICE)
+8 IF OK
KILL CHOICE
SET CHOICE=Y
+9 SET CHOICE=$SELECT(CHOICE="BRIEF":"B",CHOICE="DETAILED":"D",CHOICE="CUSTOM":"F",CHOICE="FIELDS":"C",1:"S")
+10 if 'OK
QUIT
+11 IF CHOICE="F"
Begin DoDot:1
+12 SET DIC=7107.6
SET DIC(0)="AEMOQ"
SET DIC("A")="Select Format: "
DO ^DIC
KILL DIC
if Y<1
SET OK=0
SET CHOICE("F")=Y
End DoDot:1
+13 IF CHOICE="C"
Begin DoDot:1
+14 SET DIC=7107.2
SET DIC(0)="AEMOQZ"
SET DIC("A")="Select Field: "
FOR CNT=1:1
DO ^DIC
if Y<1
QUIT
SET CHOICE(CNT)=Y(0)
+15 KILL DIC
End DoDot:1
+16 IF CHOICE="S"
Begin DoDot:1
+17 KILL ^TMP("FSC STATS",$JOB)
SET DIC=7107.2
SET DIC(0)="AEMOQZ"
SET DIC("A")="Select Field: "
FOR CNT=1:1
DO ^DIC
if Y<1
QUIT
SET CHOICE(CNT)=Y(0)
+18 KILL DIC
End DoDot:1
+19 QUIT
+20 ;
SELECT(CHOICE,PARAM,DEFAULT,SELECT,OK) ; from FSCEB, FSCLMPC, FSCLMPCC, FSCLMPD, FSCLMPE, FSCLMPM, FSCLMPNB, FSCLMPNR, FSCLMPQR, FSCLMPQS, FSCLMPS, FSCNAS
+1 ; select a list of numbers
+2 ; ex. D ("1-7,15-22","S","","VALUES",.OK)
+3 ; returns ^TMP("FSC SELECT",$J,SELECT)=entry
+4 ; ^TMP("FSC SELECT",$J,SELECT,entry #)=""
+5 ; OK = 1:valid, 0:invalid
+6 NEW ENTRY,PROMPT,X
KILL ^TMP("FSC SELECT",$JOB,"AVAIL"),^(SELECT)
SET OK=1
+7 SET PROMPT=$PIECE(PARAM,U,2)
SET PARAM=$PIECE(PARAM,U)
+8 IF CHOICE=+CHOICE
SET ^TMP("FSC SELECT",$JOB,SELECT)=CHOICE
SET ^(SELECT,CHOICE)=""
QUIT
+9 IF $PIECE(CHOICE,"-")=$PIECE(CHOICE,"-",2,99)
SET ^TMP("FSC SELECT",$JOB,SELECT)=+CHOICE
SET ^(SELECT,+CHOICE)=""
QUIT
+10 DO NUMS(CHOICE,"AVAIL")
+11 SET OK=""
FOR
WRITE !,$SELECT($LENGTH(PROMPT):PROMPT,1:"Select Calls")," (",CHOICE,"): ",$SELECT($LENGTH($GET(DEFAULT)):DEFAULT_"// ",1:"")
READ X:DTIME
Begin DoDot:1
+12 if '$TEST
SET X=U
if '$LENGTH(X)
SET X=DEFAULT
if '$LENGTH(X)
SET X=U
IF X[U
SET OK=0
QUIT
+13 IF $EXTRACT(X)'="?"
IF $EXTRACT(X)'=$EXTRACT(+X)
SET OK=""
WRITE " invalid entry"
QUIT
+14 IF X["?"
Begin DoDot:2
+15 IF X["???"
Begin DoDot:3
+16 ;***
WRITE "HELP FRAME"
End DoDot:3
QUIT
+17 IF X="??"
Begin DoDot:3
+18 ;***
WRITE "EXTENDED HELP"
End DoDot:3
QUIT
+19 IF PARAM["S"
WRITE " enter only a single number"
QUIT
+20 WRITE " enter a number or number range (ex. 5,8-11)"
End DoDot:2
QUIT
+21 SET ENTRY=X
+22 KILL ^TMP("FSC SELECT",$JOB,SELECT)
+23 SET ^TMP("FSC SELECT",$JOB,SELECT)=ENTRY
+24 IF PARAM["S"
Begin DoDot:2
+25 SET OK=1
+26 IF ENTRY'=+ENTRY
WRITE " enter a single number"
SET OK=""
End DoDot:2
if 'OK
QUIT
+27 DO NUMS(ENTRY,SELECT)
+28 SET OK=1
SET X=""
FOR
SET X=$ORDER(^TMP("FSC SELECT",$JOB,SELECT,X))
if X=""
QUIT
IF '$DATA(^TMP("FSC SELECT",$JOB,"AVAIL",X))
SET OK=""
QUIT
+29 IF OK
QUIT
+30 WRITE " enter an appropriate number"
+31 KILL ^TMP("FSC SELECT",$JOB,SELECT)
End DoDot:1
if $LENGTH(OK)
QUIT
+32 KILL ^TMP("FSC SELECT",$JOB,"AVAIL")
+33 QUIT
+34 ;
NUMS(STRING,SUB) ;
+1 if STRING="1-0"
QUIT
NEW CNT,UNIT,UNIT1,UNIT2
+2 FOR CNT=1:1
SET UNIT=$PIECE(STRING,",",CNT)
if '$LENGTH(UNIT)
QUIT
Begin DoDot:1
+3 IF UNIT'["-"
SET ^TMP("FSC SELECT",$JOB,SUB,UNIT)=""
QUIT
+4 SET UNIT1=+UNIT
SET UNIT2=+$PIECE(UNIT,"-",2)
SET ^TMP("FSC SELECT",$JOB,SUB,UNIT1)=""
SET ^TMP("FSC SELECT",$JOB,SUB,UNIT2)=""
+5 FOR
SET UNIT1=UNIT1+1
if UNIT1'<UNIT2
QUIT
SET ^TMP("FSC SELECT",$JOB,SUB,UNIT1)=""
End DoDot:1
+6 QUIT
