| 1 | DIDX ;SFISC/XAK-BRIEF DD ;06:18 PM 20 Mar 2001
|
|---|
| 2 | ;;22.0;VA FileMan;**76**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S D1=D0,DINM=1,DDRG=1,DDL1=14,DDL2=32 G B
|
|---|
| 5 | ;
|
|---|
| 6 | L S DJ(Z)=0
|
|---|
| 7 | A I DIDX D G:D1>0 A:^DD(F(Z),"B",DJ(Z),D1)
|
|---|
| 8 | . S DJ(Z)=$O(^DD(F(Z),"B",DJ(Z))) S:DJ(Z)="" D1="" Q:DJ(Z)="" S D1=$O(^(DJ(Z),0))
|
|---|
| 9 | . Q
|
|---|
| 10 | E S (D1,DJ(Z))=$O(^DD(F(Z),DJ(Z)))
|
|---|
| 11 | I D1'>0 W ! S Z=Z-1 Q
|
|---|
| 12 | B I $D(DIGR),D1-.01!'DID X DIGR E G END
|
|---|
| 13 | S N=^DD(F(Z),D1,0) D HD:$Y+9>IOSL Q:M=U W !!?Z+Z-2,$P(N,U,1),?30,S,F(Z),",",D1,S,S
|
|---|
| 14 | S X=$P(N,U,2) I X W ?M,$J(+X,8) I $D(^DD(+X,.01,0)),$P(^(0),U,2)["W" W " WORD-PROCESSING" S X=""
|
|---|
| 15 | W ?M,S,S F W="BOOLEAN","COMPUTED","FREE TEXT","SET","DATE","NUMBER","POINTER","VARIABLE POINTER","K","p" I X[$E(W) S:W="K" W="MUMPS" S:W="p" W="POINTER" D W1 I X["V" D VP0
|
|---|
| 16 | G T:X'["P"!X S Y=$P(N,U,3) I Y]"",@("$D(^"_Y_"0))") S W="TO "_$P(^(0),U,1)_" FILE (#"_+$P(X,"P",2)_")" D W1 G T
|
|---|
| 17 | S W="***** TO A FILE THAT IS UNDEFINED *******" D W1
|
|---|
| 18 | T ;
|
|---|
| 19 | S W=0
|
|---|
| 20 | H ;
|
|---|
| 21 | W ! I $D(^DD(F(Z),D1,.1))#2 W ?(Z*2),^(.1)," ",?M
|
|---|
| 22 | I X["S" S N=$P(N,U,3) F I=1:1 S Y=$P(N,";",I) Q:Y="" S W="'"_$P(Y,":")_"' FOR "_$P(Y,":",2)_";" W ?M," "_W,!
|
|---|
| 23 | I $D(^DD(F(Z),D1,3))#2 S W=^(3) W ?M D W1
|
|---|
| 24 | RD ;
|
|---|
| 25 | I X S Z=Z+1,DDL1=DDL1+2,DDL2=DDL2+2,F(Z)=+X,W=" Multiple" D W1,L
|
|---|
| 26 | END S X="" G:M'=U A:Z>1 Q
|
|---|
| 27 | ;
|
|---|
| 28 | W1 W:$X+$L(W)+3>IOM !,?$S(IOM-$L(W)-5<M:IOM-5-$L(W),1:M),S S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1),S I %Y]"" S W=%Y G W1
|
|---|
| 29 | D:$Y>IOSL HD Q
|
|---|
| 30 | ;
|
|---|
| 31 | HD S DC=DC+1 D ^DIDH
|
|---|
| 32 | Q
|
|---|
| 33 | VP ;Variable Pointer
|
|---|
| 34 | W ?50,W S D1=DJ(Z)
|
|---|
| 35 | VP0 I '$D(^DD(F(Z),D1,"V",0)) S W="" Q
|
|---|
| 36 | S DID1=0,DIMU=0,DID2=0 I '$D(DDRG) D RT
|
|---|
| 37 | S W="FILE ORDER PREFIX LAYGO MESSAGE" W !?(Z+Z+12),W G Q:M=U
|
|---|
| 38 | VP1 S DID2=$O(^DD(F(Z),D1,"V",DID2)) S:DID2="" DID2=-1 G:DID2'>0 VP2 S DIDV=^(DID2,0) I '$D(^DIC(+DIDV,0)) S DIDV(+DIDV)=""
|
|---|
| 39 | S DIVP=$P(DIDV,U),DDLF=(Z+Z+15) I $L(DIVP)>4 W !?(DDLF-$L(DIVP))+1,DIVP
|
|---|
| 40 | E W !?DDLF,DIVP
|
|---|
| 41 | W ?(DDLF+5),$P(DIDV,U,3),?(DDLF+10),$P(DIDV,U,4),?(DDLF+23),$P(DIDV,U,6) S DDL3=DDL2,DDL2=DDLF+27,W=$P(DIDV,U,2) D W1^DIDH1 S DDL2=DDL3 S:$P(DIDV,U,5)["y" DIMU=1 D:$Y+4>IOSL HD G ND^DID1:M=U,VP1
|
|---|
| 42 | VP2 I DIMU S DIDVI=0 F S DIDVI=$O(^DD(F(Z),D1,"V",DIDVI)) Q:DIDVI'>0 I $D(^(DIDVI,1)) S %=^(0) D VP3 Q:M=U
|
|---|
| 43 | S DIDV=0 F S DIDV=$O(DIDV(DIDV)) Q:DIDV'>0 S W="!! FILE "_DIDV_" DOES NOT EXIST !!" D W^DID1 Q:M=U
|
|---|
| 44 | Q W ! K DID2,DIMU,DID1,DIDV,DIDVI S W="" Q
|
|---|
| 45 | VP3 ;
|
|---|
| 46 | W !?(Z+Z+12),"SCREEN"_$S('$D(DINM):" ON FILE "_$P(%,U)_":",1:" EXPLANATION ON FILE "_$P(%,U)_":") S W=" "_$S('$D(DINM):^(1),1:$S($D(^(2)):^(2),1:"")) D W^DID1:'$D(DINM),W^DIDH:$D(DINM)
|
|---|
| 47 | Q
|
|---|
| 48 | RT F W="Required","Add New Entry without Asking","Multiply asked","audited" I X[$E(W,1) S W=" ("_W_")" W:($L(W)+$X)'<IOM ! D W^DID1 G ND^DID1:M=U
|
|---|
| 49 | I $D(^DD("KEY","F",F(Z),DJ(Z))) S W=" (Key field)" W:($L(W)+$X)'<IOM ! D W^DID1 G ND^DID1:M=U
|
|---|
| 50 | W ! I $D(^DD(F(Z),DJ(Z),.1)),^(.1)]"" W !?(Z+Z+12),^(.1)," ",?M
|
|---|
| 51 | Q
|
|---|
| 52 | AH W !,"ALPHABETICALLY BY LABEL" D YN^DICN Q:%<0 S:%=1 DIDX=1,BY="@.01"
|
|---|
| 53 | I '% W !?5,"Enter YES to list the fields ALPHABETICALLY BY LABEL.",!?5,"Enter NO to list the fields by NUMBER." S %=2 G AH
|
|---|
| 54 | Q
|
|---|
