| 1 | DDBR3 ;SFISC/DCL-SELECT FILE & WP FIELD TO BROWSE ;NOV 04, 1996@13:48
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | LIST(DDBLIST) ;DDBLIST=Target array for file number,ien,field,...
|
|---|
| 5 | S DDBLIST=-1 ;no selection
|
|---|
| 6 | EN ;
|
|---|
| 7 | N %,%H,%ZISOS,A,D,D0,D1,DA,DDBB,DDBDDF,DDBDIC,DDBFRCD,DDBIEN,DDBRCR,DDBX,DIC,DICS,DIW,DIWF,DIWL,DIWR,DIWT,DK,DL,DN,DX,I,POP,S,X,Y
|
|---|
| 8 | ;S DIC=1,DIC(0)="AEMQ" D ^DIC Q:+Y'>0 ;Select file
|
|---|
| 9 | D ^DICRW Q:Y'>0
|
|---|
| 10 | S DIC="^DD("_+Y_",",DIC(0)="AEMQ"
|
|---|
| 11 | M S DIC("W")="I $P(^(0),U,2) W $S($P(^DD(+$P(^(0),U,2),.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"")"
|
|---|
| 12 | S DIC("S")="I $P(^(0),U,2)"
|
|---|
| 13 | D ^DIC I +Y'>0,$D(@(DIC_"0,""UP"")")) S DIC="^DD("_+^("UP")_"," G M ;Select field/back out of multiples
|
|---|
| 14 | Q:+Y'>0
|
|---|
| 15 | I $P(@(DIC_+Y_",0)"),U,2) S DIC="^DD("_+$P(^(0),U,2)_",",Y=.01 G D:$P(^DD(+$P(^(0),U,2),.01,0),U,2)["W",M
|
|---|
| 16 | D ;
|
|---|
| 17 | K DIC("S")
|
|---|
| 18 | S DDBDIC=$$UP^DIQGU(+$P(DIC,"^DD(",2),.DDBDIC),(DDBX,DDBIEN)=""
|
|---|
| 19 | S DDBFRCD=$$GET^DIQGDD(DDBDIC,"","NAME")_":[",DDBB=0
|
|---|
| 20 | F S DDBX=$O(DDBDIC(DDBX)) Q:DDBX'<0 D Q:$G(Y)'>0
|
|---|
| 21 | .K DA D IEN(","_DDBIEN,.DA)
|
|---|
| 22 | .S DIC=$$ROOT^DIQGU(+DDBDIC(DDBX),","_DDBIEN),DIC(0)="AEMQ" Q:DIC']""
|
|---|
| 23 | .S DDBRCR=$$CREF^DILF(DIC)
|
|---|
| 24 | .I $P($G(@DDBRCR@(0)),U,4)'>0 D K DDBIEN Q
|
|---|
| 25 | ..W $C(7),!!,"No Records at "_$S(DDBDIC=+DDBDIC(DDBX):"FILE",1:$P(^DD(+DDBDIC(DDBX),.01,0),U))_" Level.",!
|
|---|
| 26 | ..Q
|
|---|
| 27 | .D ^DIC I Y'>0 K DDBIEN Q
|
|---|
| 28 | .S DDBIEN=+Y_","_DDBIEN
|
|---|
| 29 | .S DDBFRCD=DDBFRCD_$S(DDBB:"\",1:"")_$$GET^DIQG(+DDBDIC(DDBX),DDBIEN,.01),DDBB=1
|
|---|
| 30 | .K DA D IEN(DDBIEN,.DA)
|
|---|
| 31 | .Q
|
|---|
| 32 | DISP ;
|
|---|
| 33 | S DDBDDF=$O(^DD(+DDBDIC(-1),"SB",+DDBDIC(0),"")) Q:'DDBDDF
|
|---|
| 34 | S DDBFRCD=DDBFRCD_"] (wp): "_$P(^DD(DDBDIC(0),.01,0),"^")
|
|---|
| 35 | I $D(DDBIEN) D Q
|
|---|
| 36 | .N DDBX S DDBX=$P($$GET^DIQG(+DDBDIC(-1),DDBIEN,DDBDDF,"B"),"$CREF$",2)
|
|---|
| 37 | .S DDBLIST=$D(@DDBX)
|
|---|
| 38 | .S DDBLIST(1)=+DDBDIC(-1)
|
|---|
| 39 | .S DDBLIST(2)=DDBIEN
|
|---|
| 40 | .S DDBLIST(3)=DDBDDF
|
|---|
| 41 | .S DDBLIST(4)="N"
|
|---|
| 42 | .S DDBLIST(5)=DDBFRCD
|
|---|
| 43 | .S DDBLIST(6)=DDBX
|
|---|
| 44 | .Q
|
|---|
| 45 | Q
|
|---|
| 46 | IEN(IEN,DA) S DA=$P(IEN,",") N I F I=2:1 Q:$P(IEN,",",I)="" S DA(I-1)=$P(IEN,",",I)
|
|---|
| 47 | Q
|
|---|
