source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDGFORD.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1DDGFORD ;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 ;
10EN(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
Note: See TracBrowser for help on using the repository browser.