source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCUL.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1FSCUL ;SLC/STAFF-NOIS Utilities Lists ;1/13/98 17:13
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4EXPAND(CHOICE,OK,DEFAULT) ; from FSCLMPC, FSCLMPD
5 N CNT,DIC,DIR,X,Y K DIC,DIR,Y
6 S OK=1
7 S DIR(0)="SA^BRIEF:BRIEF;DETAILED:DETAILED;CUSTOM:CUSTOM;FIELDS:FIELDS;STATISTIC:STATISTIC"
8 S DIR("A")="Select (B)rief, (D)etailed, (C)ustom, (F)ields, or (S)tatistic: "
9 S DIR("B")=$G(DEFAULT,"BRIEF")
10 D ^DIR K DIR
11 I $D(DUOUT)!$D(DTOUT) S OK=0,CHOICE=$G(CHOICE)
12 I OK K CHOICE S CHOICE=Y
13 S CHOICE=$S(CHOICE="BRIEF":"B",CHOICE="DETAILED":"D",CHOICE="CUSTOM":"F",CHOICE="FIELDS":"C",1:"S")
14 Q:'OK
15 I CHOICE="F" D
16 .S DIC=7107.6,DIC(0)="AEMOQ",DIC("A")="Select Format: " D ^DIC K DIC S:Y<1 OK=0 S CHOICE("F")=Y
17 I CHOICE="C" D
18 .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)
19 .K DIC
20 I CHOICE="S" D
21 .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)
22 .K DIC
23 Q
24 ;
25SELECT(CHOICE,PARAM,DEFAULT,SELECT,OK) ; from FSCEB, FSCLMPC, FSCLMPCC, FSCLMPD, FSCLMPE, FSCLMPM, FSCLMPNB, FSCLMPNR, FSCLMPQR, FSCLMPQS, FSCLMPS, FSCNAS
26 ; select a list of numbers
27 ; ex. D ("1-7,15-22","S","","VALUES",.OK)
28 ; returns ^TMP("FSC SELECT",$J,SELECT)=entry
29 ; ^TMP("FSC SELECT",$J,SELECT,entry #)=""
30 ; OK = 1:valid, 0:invalid
31 N ENTRY,PROMPT,X K ^TMP("FSC SELECT",$J,"AVAIL"),^(SELECT) S OK=1
32 S PROMPT=$P(PARAM,U,2),PARAM=$P(PARAM,U)
33 I CHOICE=+CHOICE S ^TMP("FSC SELECT",$J,SELECT)=CHOICE,^(SELECT,CHOICE)="" Q
34 I $P(CHOICE,"-")=$P(CHOICE,"-",2,99) S ^TMP("FSC SELECT",$J,SELECT)=+CHOICE,^(SELECT,+CHOICE)="" Q
35 D NUMS(CHOICE,"AVAIL")
36 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)
37 .S:'$T X=U S:'$L(X) X=DEFAULT S:'$L(X) X=U I X[U S OK=0 Q
38 .I $E(X)'="?",$E(X)'=$E(+X) S OK="" W " invalid entry" Q
39 .I X["?" D Q
40 ..I X["???" D Q
41 ...W "HELP FRAME" ;***
42 ..I X="??" D Q
43 ...W "EXTENDED HELP" ;***
44 ..I PARAM["S" W " enter only a single number" Q
45 ..W " enter a number or number range (ex. 5,8-11)"
46 .S ENTRY=X
47 .K ^TMP("FSC SELECT",$J,SELECT)
48 .S ^TMP("FSC SELECT",$J,SELECT)=ENTRY
49 .I PARAM["S" D Q:'OK
50 ..S OK=1
51 ..I ENTRY'=+ENTRY W " enter a single number" S OK=""
52 .D NUMS(ENTRY,SELECT)
53 .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
54 .I OK Q
55 .W " enter an appropriate number"
56 .K ^TMP("FSC SELECT",$J,SELECT)
57 K ^TMP("FSC SELECT",$J,"AVAIL")
58 Q
59 ;
60NUMS(STRING,SUB) ;
61 Q:STRING="1-0" N CNT,UNIT,UNIT1,UNIT2
62 F CNT=1:1 S UNIT=$P(STRING,",",CNT) Q:'$L(UNIT) D
63 .I UNIT'["-" S ^TMP("FSC SELECT",$J,SUB,UNIT)="" Q
64 .S UNIT1=+UNIT,UNIT2=+$P(UNIT,"-",2),^TMP("FSC SELECT",$J,SUB,UNIT1)="",^TMP("FSC SELECT",$J,SUB,UNIT2)=""
65 .F S UNIT1=UNIT1+1 Q:UNIT1'<UNIT2 S ^TMP("FSC SELECT",$J,SUB,UNIT1)=""
66 Q
Note: See TracBrowser for help on using the repository browser.