93 lines
4.1 KiB
Mathematica
93 lines
4.1 KiB
Mathematica
QAQSELCT ;HISC/DAD-GENERIC FILE ENTRY SELECTOR ;2/11/94 12:29
|
|
;;1.7;QM Integration Module;;07/25/1995
|
|
;
|
|
;*** SELECTS A GROUP OF RECORDS FROM A FILE ***
|
|
;
|
|
;REQUIRES:
|
|
; QAQDIC = FILE NUMBER OR GLOBAL ROOT
|
|
; QAQDIC(0) = DIC(0) STRING
|
|
; QAQUTIL = NODE TO STORE DATA UNDER IN ^UTILITY($J,QAQUTIL,
|
|
;OPTIONAL:
|
|
; QAQDIC("A") = DIC("A") STRING
|
|
; QAQDIC("B") = DIC("B") STRING
|
|
; QAQDIC("S") = DIC("S") STRING
|
|
; QAQDIC("W") = DIC("W") STRING
|
|
;RETURNS:
|
|
; QAQQUIT = $S(UP_ARROW_OUT:1 , NOTHING_SELECTED:1 , 1:0)
|
|
; ^UTILITY($J,QAQUTIL,EXTERNAL_.01_FIELD_DATA,IEN) = ""
|
|
EN1 ;
|
|
S QAQQUIT=0 I ($D(QAQDIC)[0)!($D(QAQDIC(0))[0)!($D(QAQUTIL)[0) S QAQQUIT=1 G EXIT
|
|
I (QAQDIC="")!(QAQDIC(0)="")!(QAQUTIL="") S QAQQUIT=1 G EXIT
|
|
D K S DIC=QAQDIC I DIC S (QAQDIC,DIC)=$S($D(^DIC(DIC,0,"GL"))#2:^("GL"),1:"") I DIC="" S QAQQUIT=1 G EXIT
|
|
S DIC(0)=QAQDIC(0),DIC(0)=$TR(DIC(0),"AL") S:DIC(0)'["Z" DIC(0)=DIC(0)_"Z" S QAQDIC(0)=DIC(0)
|
|
D DO^DIC1 S QAQFNUM=+DO(2),QAQFNAME=$P(DO,"^"),QAQFLD01=$P(^DD(QAQFNUM,.01,0),"^"),QAQFSCR=$S($D(DO("SCR"))#2:DO("SCR"),1:"") K DO
|
|
S QAQFLD01("S")=QAQFLD01_$S($E(QAQFLD01,$L(QAQFLD01))?1L:"s",1:"S")
|
|
F X="A","B","S","W" S QAQDIC(X)=$S($D(QAQDIC(X))#2:QAQDIC(X),1:"")
|
|
S:QAQDIC("A")="" QAQDIC("A")="Select "_QAQFNAME_" "_QAQFLD01_": "
|
|
S QAQALL=0,QAQNUM=1 K ^UTILITY($J,QAQUTIL) D HOME^%ZIS
|
|
1 D SETDIC W !!,$S(QAQNUM>1:"Another one: ",1:DIC("A")),$S((QAQNUM=1)&(QAQDIC("B")]""):QAQDIC("B")_"// ",1:"")
|
|
R X:DTIME S:('$T)!($E(X)="^") QAQQUIT=1 G:QAQQUIT EXIT S:(QAQNUM=1)&(X="")&(QAQDIC("B")]"") X=QAQDIC("B") G:X="" EXIT S QAQDSEL=$S(X?1"-"1.E:1,1:0) S:QAQDSEL X=$E(X,2,$L(X))
|
|
I $L(X),$L(X)<4,"Aa"[$E(X),"Ll"[$E(X,2),"Ll"[$E(X,3) D ALL G EXIT:QAQQUIT,1:QAQALL
|
|
D HELP:$E(X)="?",^DIC K DIC G:+Y'>0 1
|
|
I $$CHKFLD(QAQFNUM)["D" D
|
|
. N %DT,X
|
|
. S QAQD0=Y,X=Y(0,0),%DT="ST" D ^%DT S Y(0,0)=Y,Y=QAQD0
|
|
. Q
|
|
I 'QAQDSEL,'$D(^UTILITY($J,QAQUTIL,$E(Y(0,0),1,63),+Y)) S ^(+Y)="",QAQNUM=QAQNUM+1
|
|
I QAQDSEL,$D(^UTILITY($J,QAQUTIL,$E(Y(0,0),1,63),+Y)) K ^(+Y) S QAQNUM=QAQNUM-$S(QAQNUM>0:1,1:0)
|
|
G 1
|
|
EXIT ;
|
|
S QAQQUIT=$S(QAQQUIT:1,$O(^UTILITY($J,QAQUTIL,""))="":1,1:0) K QAQDIC,QAQUTIL
|
|
K K %,C,D0,DA,DIC,DIK,DIR,DO,QAQ,QAQALL,QAQD0,QAQDSEL,QAQDT,QAQFLD01,QAQFNAME,QAQFNUM,QAQFSCR,QAQLINE,QAQNUM,X,Y
|
|
Q
|
|
ALL ;
|
|
S QAQ="By '"_X_"' do you mean all "_$S($G(QAQFSCR)]"":"",$G(QAQDIC("S"))]"":"",1:$P(@(QAQDIC_"0)"),"^",4)_" ")_QAQFNAME_" "_QAQFLD01("S") D WRAP
|
|
S %=1 D YN^DICN S QAQALL=$S(%=1:1,1:0) S:%=-1 QAQQUIT=1 I '% W !?7,"Answer Y(es) if you want all of the ",QAQFLD01("S"),",",!?7,"otherwise answer N(o)" G ALL
|
|
I QAQQUIT!'QAQALL W:'QAQQUIT !!,X Q
|
|
N X F QAQD0=0:0 S QAQD0=$O(@(QAQDIC_"QAQD0)")) Q:QAQD0'>0 D AL
|
|
W:QAQNUM=1 " ??",*7
|
|
Q
|
|
AL I QAQFSCR]"" D SETDIC I $D(@(QAQDIC_"QAQD0,0)"))#2 S (D0,DA,Y)=QAQD0 X QAQFSCR Q:'$T
|
|
I QAQDIC("S")]"" D SETDIC I $D(@(QAQDIC_"QAQD0,0)"))#2 S (D0,DA,Y)=QAQD0 X DIC("S") Q:'$T
|
|
S Y=$P($G(@(QAQDIC_"QAQD0,0)")),"^"),C=$P(^DD(QAQFNUM,.01,0),"^",2) Q:Y=""
|
|
D Y^DIQ
|
|
I $$CHKFLD(QAQFNUM)["D" D
|
|
. N %DT,X
|
|
. S X=Y,%DT="ST" D ^%DT
|
|
. Q
|
|
S ^UTILITY($J,QAQUTIL,$E(Y,1,63),QAQD0)="",QAQNUM=QAQNUM+1
|
|
Q
|
|
HELP ;
|
|
N X S QAQ="Select a "_QAQFNAME_" "_QAQFLD01_" from the displayed list." D WRAP
|
|
W !?5,"To deselect a ",QAQFLD01," type a minus sign (-)",!?5,"in front of it, e.g. -",QAQFLD01,".",!?5,"To get all ",QAQFLD01("S")," type ALL."
|
|
G:$O(^UTILITY($J,QAQUTIL,""))="" HLP
|
|
SHOW S QAQLINE=$Y,QAQ="" W !!,"You have already selected:"
|
|
F S QAQ=$O(^UTILITY($J,QAQUTIL,QAQ)) Q:QAQ=""!QAQQUIT F QAQD0=0:0 S QAQD0=$O(^UTILITY($J,QAQUTIL,QAQ,QAQD0)) Q:QAQD0'>0!QAQQUIT D SHO
|
|
HLP W ! S QAQQUIT=0
|
|
Q
|
|
SHO S QAQ(0)=QAQ
|
|
I $$CHKFLD(QAQFNUM)["D" D
|
|
. N Y
|
|
. S Y=QAQ(0) X ^DD("DD") S QAQ(0)=Y
|
|
. Q
|
|
I QAQDIC(0)["N" W !?3,QAQD0,?15,QAQ(0)
|
|
E W !?3,QAQ(0)
|
|
D SETDIC I $D(DIC("W"))#2,DIC("W")]"",$D(@(QAQDIC_"QAQD0,0)"))#2 S (D0,DA,Y)=QAQD0 X DIC("W")
|
|
I $Y>(IOSL+QAQLINE-3) D PAUSE S QAQLINE=$Y
|
|
Q
|
|
WRAP ;
|
|
W ! F S Y=$L($E(QAQ,1,IOM-20)," ") W !?5,$P(QAQ," ",1,Y) S QAQ=$P(QAQ," ",Y+1,999) Q:QAQ=""
|
|
Q
|
|
PAUSE ;
|
|
K DIR S DIR(0)="E" D ^DIR K DIR S QAQQUIT=$S(Y:0,1:1)
|
|
Q
|
|
SETDIC ;
|
|
K DIC,DO S DIC=QAQDIC
|
|
F X="0","A","B","S","W" I QAQDIC(X)]"" S DIC(X)=QAQDIC(X)
|
|
D DO^DIC1
|
|
Q
|
|
CHKFLD(X) ;
|
|
N A S A=$P($G(^DD(X,.01,0)),"^",2)
|
|
I A["P" F S A=$$CHKFLD($TR(A,$TR(A,".0123456789"))) Q:A'["P"
|
|
Q A
|