- 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 Feb 18, 2025@23:46:53 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