[613] | 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
|
---|