Return to DDGFORD.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDGFORD.m, revision 1.1.1.1

1.1       snw         1: DDGFORD        ;SFISC/MKO-REORDER THE FIELDS ON BLOCK ;07:13 AM  25 May 1994
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      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