1 | DDGFORD ;SFISC/MKO-REORDER THE FIELDS ON BLOCK ;07:13 AM 25 May 1994
|
---|
2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ;In: DDGFBK = Block number
|
---|
6 | ; DDGFPG = Page number
|
---|
7 | ; DDGFFM = Form number^Form name
|
---|
8 | ; DDGFREF = Global reference
|
---|
9 | ;
|
---|
10 | EN(DDGFBK) ;
|
---|
11 | N DDO,DA,DIK
|
---|
12 | N DDGFLN,DDGFLIST,DDGFR,DDGFC,DDGFN,DDGFO
|
---|
13 | ;
|
---|
14 | D MSG^DDGF("Reordering ...")
|
---|
15 | ;Loop through all fields in DDGFREF and put into DDGFLIST array
|
---|
16 | S DDO="" F S DDO=$O(@DDGFREF@("F",DDGFPG,DDGFBK,DDO)) Q:DDO="" D
|
---|
17 | . S DDGFLN=@DDGFREF@("F",DDGFPG,DDGFBK,DDO)
|
---|
18 | . I $P(DDGFLN,U,8)>0 S DDGFLIST(+$P(DDGFLN,U,5),+$P(DDGFLN,U,6),DDO)=""
|
---|
19 | . E I $P(DDGFLN,U,4)]"" S DDGFLIST(+$P(DDGFLN,U),+$P(DDGFLN,U,2),DDO)=""
|
---|
20 | ;
|
---|
21 | K ^DIST(.404,DDGFBK,40,"B")
|
---|
22 | S DDGFN=0
|
---|
23 | S DDGFR="" F S DDGFR=$O(DDGFLIST(DDGFR)) Q:DDGFR="" D
|
---|
24 | . S DDGFC="" F S DDGFC=$O(DDGFLIST(DDGFR,DDGFC)) Q:DDGFC="" D
|
---|
25 | .. S DDO="" F S DDO=$O(DDGFLIST(DDGFR,DDGFC,DDO)) Q:DDO="" D
|
---|
26 | ... S DDGFN=DDGFN+1
|
---|
27 | ... S DDGFO=$P(^DIST(.404,DDGFBK,40,DDO,0),U)
|
---|
28 | ... S:DDGFO'=DDGFN $P(^DIST(.404,DDGFBK,40,DDO,0),U)=DDGFN
|
---|
29 | ;
|
---|
30 | S DIK="^DIST(.404,DDGFBK,40,",DA(1)=DDGFBK,DIK(1)=".01^B"
|
---|
31 | D ENALL^DIK
|
---|
32 | D MSG^DDGF("Reordering completed.") H 1
|
---|
33 | D MSG^DDGF()
|
---|
34 | Q
|
---|