Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FSCUL

FSCUL.m

Go to the documentation of this file.
  1. FSCUL ;SLC/STAFF-NOIS Utilities Lists ;1/13/98 17:13
  1. ;;1.1;NOIS;;Sep 06, 1998
  1. ;
  1. EXPAND(CHOICE,OK,DEFAULT) ; from FSCLMPC, FSCLMPD
  1. N CNT,DIC,DIR,X,Y K DIC,DIR,Y
  1. S OK=1
  1. S DIR(0)="SA^BRIEF:BRIEF;DETAILED:DETAILED;CUSTOM:CUSTOM;FIELDS:FIELDS;STATISTIC:STATISTIC"
  1. S DIR("A")="Select (B)rief, (D)etailed, (C)ustom, (F)ields, or (S)tatistic: "
  1. S DIR("B")=$G(DEFAULT,"BRIEF")
  1. D ^DIR K DIR
  1. I $D(DUOUT)!$D(DTOUT) S OK=0,CHOICE=$G(CHOICE)
  1. I OK K CHOICE S CHOICE=Y
  1. S CHOICE=$S(CHOICE="BRIEF":"B",CHOICE="DETAILED":"D",CHOICE="CUSTOM":"F",CHOICE="FIELDS":"C",1:"S")
  1. Q:'OK
  1. I CHOICE="F" D
  1. .S DIC=7107.6,DIC(0)="AEMOQ",DIC("A")="Select Format: " D ^DIC K DIC S:Y<1 OK=0 S CHOICE("F")=Y
  1. I CHOICE="C" D
  1. .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)
  1. .K DIC
  1. I CHOICE="S" D
  1. .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)
  1. .K DIC
  1. Q
  1. ;
  1. 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
  1. ; ex. D ("1-7,15-22","S","","VALUES",.OK)
  1. ; returns ^TMP("FSC SELECT",$J,SELECT)=entry
  1. ; ^TMP("FSC SELECT",$J,SELECT,entry #)=""
  1. ; OK = 1:valid, 0:invalid
  1. N ENTRY,PROMPT,X K ^TMP("FSC SELECT",$J,"AVAIL"),^(SELECT) S OK=1
  1. S PROMPT=$P(PARAM,U,2),PARAM=$P(PARAM,U)
  1. I CHOICE=+CHOICE S ^TMP("FSC SELECT",$J,SELECT)=CHOICE,^(SELECT,CHOICE)="" Q
  1. I $P(CHOICE,"-")=$P(CHOICE,"-",2,99) S ^TMP("FSC SELECT",$J,SELECT)=+CHOICE,^(SELECT,+CHOICE)="" Q
  1. D NUMS(CHOICE,"AVAIL")
  1. 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)
  1. .S:'$T X=U S:'$L(X) X=DEFAULT S:'$L(X) X=U I X[U S OK=0 Q
  1. .I $E(X)'="?",$E(X)'=$E(+X) S OK="" W " invalid entry" Q
  1. .I X["?" D Q
  1. ..I X["???" D Q
  1. ...W "HELP FRAME" ;***
  1. ..I X="??" D Q
  1. ...W "EXTENDED HELP" ;***
  1. ..I PARAM["S" W " enter only a single number" Q
  1. ..W " enter a number or number range (ex. 5,8-11)"
  1. .S ENTRY=X
  1. .K ^TMP("FSC SELECT",$J,SELECT)
  1. .S ^TMP("FSC SELECT",$J,SELECT)=ENTRY
  1. .I PARAM["S" D Q:'OK
  1. ..S OK=1
  1. ..I ENTRY'=+ENTRY W " enter a single number" S OK=""
  1. .D NUMS(ENTRY,SELECT)
  1. .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
  1. .I OK Q
  1. .W " enter an appropriate number"
  1. .K ^TMP("FSC SELECT",$J,SELECT)
  1. K ^TMP("FSC SELECT",$J,"AVAIL")
  1. Q
  1. ;
  1. NUMS(STRING,SUB) ;
  1. Q:STRING="1-0" N CNT,UNIT,UNIT1,UNIT2
  1. F CNT=1:1 S UNIT=$P(STRING,",",CNT) Q:'$L(UNIT) D
  1. .I UNIT'["-" S ^TMP("FSC SELECT",$J,SUB,UNIT)="" Q
  1. .S UNIT1=+UNIT,UNIT2=+$P(UNIT,"-",2),^TMP("FSC SELECT",$J,SUB,UNIT1)="",^TMP("FSC SELECT",$J,SUB,UNIT2)=""
  1. .F S UNIT1=UNIT1+1 Q:UNIT1'<UNIT2 S ^TMP("FSC SELECT",$J,SUB,UNIT1)=""
  1. Q