source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIDX.m@ 1394

Last change on this file since 1394 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1DIDX ;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 ;
6L S DJ(Z)=0
7A 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
12B 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
18T ;
19 S W=0
20H ;
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
24RD ;
25 I X S Z=Z+1,DDL1=DDL1+2,DDL2=DDL2+2,F(Z)=+X,W=" Multiple" D W1,L
26END S X="" G:M'=U A:Z>1 Q
27 ;
28W1 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 ;
31HD S DC=DC+1 D ^DIDH
32 Q
33VP ;Variable Pointer
34 W ?50,W S D1=DJ(Z)
35VP0 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
38VP1 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
42VP2 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
44Q W ! K DID2,DIMU,DID1,DIDV,DIDVI S W="" Q
45VP3 ;
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
48RT 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
52AH 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
Note: See TracBrowser for help on using the repository browser.