| [613] | 1 | DGDEPU ;ALB/CAW/AMA - Dependent Utilities - Generic ;11/3/94
|
|---|
| 2 | ;;5.3;Registration;**45,733**;Aug 13, 1993;Build 15
|
|---|
| 3 | ;
|
|---|
| 4 | SEL ; -- select processing
|
|---|
| 5 | ;DG*5.3*733 -- added DIR to the list a vars to be NEW'ed
|
|---|
| 6 | N BG,LST,Y,DIR
|
|---|
| 7 | S BG=+$O(@VALMAR@("IDX",$S($G(BEG):BEG,1:1),0))
|
|---|
| 8 | S LST=+$O(@VALMAR@("IDX",$S($G(END):END,1:DGCNT),0))
|
|---|
| 9 | I 'BG W !!,*7,"There are no '",VALM("ENTITY"),"s' to select.",! S DIR(0)="E" D ^DIR K DIR D OUT G SELQ
|
|---|
| 10 | S Y=+$P($P(XQORNOD(0),U,4),"=",2)
|
|---|
| 11 | I 'Y S DIR(0)="N^"_BG_":"_LST,DIR("A")="Select "_VALM("ENTITY")_"(s)" D ^DIR K DIR I $D(DIRUT) D OUT G SELQ
|
|---|
| 12 | ;
|
|---|
| 13 | ; -- check was valid entries
|
|---|
| 14 | S DGERR=0,DGW=Y
|
|---|
| 15 | I DGW<BG!(DGW>LST) D
|
|---|
| 16 | . W !,*7,"Selection '",DGW,"' is not a valid choice."
|
|---|
| 17 | . D OUT,PAUSE^VALM1
|
|---|
| 18 | ;
|
|---|
| 19 | SELQ K DIRUT,DTOUT,DUOUT,DIROUT Q
|
|---|
| 20 | ;
|
|---|
| 21 | OUT ;
|
|---|
| 22 | S DGERR=1
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | LOOKUP ; Look up the tests that can be added to
|
|---|
| 26 | ;
|
|---|
| 27 | S DIC("S")="I $P(^(0),U,2)=DFN"
|
|---|
| 28 | W ! S DIC="^DGMT(408.31,",DIC(0)="EQZ",X=DFN,D="C" D IX^DIC K DIC G LOOKUPQ:$D(DTOUT)!($D(DUOUT))!(+Y<0)
|
|---|
| 29 | I ('$P($G(^DG(408.34,+$P(Y(0),"^",23),0)),U,2))!('$P($G(^DGMT(408.31,+Y,"PRIM")),"^")) W !?5,*7,"This means test is uneditable and cannot be added to." G LOOKUP
|
|---|
| 30 | S DGMTI=+Y,DGMT0=Y(0) K DIC,Y
|
|---|
| 31 | LOOKUPQ ;
|
|---|
| 32 | Q
|
|---|
