Routine: DDGFORD

DDGFORD ;SFISC/MKO-REORDER THE FIELDS ON BLOCK ;07:13 AM  25 May 1994

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;In: DDGFBK   = Block number

 ;    DDGFPG   = Page number

 ;    DDGFFM   = Form number^Form name

 ;    DDGFREF  = Global reference

EN(DDGFBK) ;

 N DDO,DA,DIK

 N DDGFLN,DDGFLIST,DDGFR,DDGFC,DDGFN,DDGFO

 D MSG^DDGF("Reordering ...")

 ;Loop through all fields in DDGFREF and put into DDGFLIST array

 S DDO="" F  S DDO=$O(@DDGFREF@("F",DDGFPG,DDGFBK,DDO)) Q:DDO=""  D

 . S DDGFLN=@DDGFREF@("F",DDGFPG,DDGFBK,DDO)

 . I $P(DDGFLN,U,8)>0 S DDGFLIST(+$P(DDGFLN,U,5),+$P(DDGFLN,U,6),DDO)=""

 . E  I $P(DDGFLN,U,4)]"" S DDGFLIST(+$P(DDGFLN,U),+$P(DDGFLN,U,2),DDO)=""

 K ^DIST(.404,DDGFBK,40,"B")

 S DDGFN=0

 S DDGFR="" F  S DDGFR=$O(DDGFLIST(DDGFR)) Q:DDGFR=""  D

 . S DDGFC="" F  S DDGFC=$O(DDGFLIST(DDGFR,DDGFC)) Q:DDGFC=""  D

 .. S DDO="" F  S DDO=$O(DDGFLIST(DDGFR,DDGFC,DDO)) Q:DDO=""  D

 ... S DDGFN=DDGFN+1

 ... S DDGFO=$P(^DIST(.404,DDGFBK,40,DDO,0),U)

 ... S:DDGFO'=DDGFN $P(^DIST(.404,DDGFBK,40,DDO,0),U)=DDGFN

 S DIK="^DIST(.404,DDGFBK,40,",DA(1)=DDGFBK,DIK(1)=".01^B"

 D ENALL^DIK

 D MSG^DDGF("Reordering completed.") H 1

 D MSG^DDGF()

DDGFORD   ;SFISC/MKO-REORDER THE FIELDS ON BLOCK ;07:13 AM  25 May 1994

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;In: DDGFBK   = Block number

 +5       ;    DDGFPG   = Page number

 +6       ;    DDGFFM   = Form number^Form name

 +7       ;    DDGFREF  = Global reference

 +8       ;

EN(DDGFBK) ;

 +1        NEW DDO,DA,DIK

 +2        NEW DDGFLN,DDGFLIST,DDGFR,DDGFC,DDGFN,DDGFO

 +3       ;

 +4        DO MSG^DDGF("Reordering ...")

 +5       ;Loop through all fields in DDGFREF and put into DDGFLIST array

 +6        SET DDO=""

FOR

               SET DDO=$ORDER(@DDGFREF@("F",DDGFPG,DDGFBK,DDO))

               IF DDO=""

                   QUIT

               Begin DoDot:1

 +7                SET DDGFLN=@DDGFREF@("F",DDGFPG,DDGFBK,DDO)

 +8                IF $PIECE(DDGFLN,U,8)>0

                       SET DDGFLIST(+$PIECE(DDGFLN,U,5),+$PIECE(DDGFLN,U,6),DDO)=""

 +9               IF '$TEST

                       IF $PIECE(DDGFLN,U,4)]""

                           SET DDGFLIST(+$PIECE(DDGFLN,U),+$PIECE(DDGFLN,U,2),DDO)=""

               End DoDot:1

 +10      ;

 +11       KILL ^DIST(.404,DDGFBK,40,"B")

 +12       SET DDGFN=0

 +13       SET DDGFR=""

FOR

               SET DDGFR=$ORDER(DDGFLIST(DDGFR))

               IF DDGFR=""

                   QUIT

               Begin DoDot:1

 +14               SET DDGFC=""

FOR

                       SET DDGFC=$ORDER(DDGFLIST(DDGFR,DDGFC))

                       IF DDGFC=""

                           QUIT

                       Begin DoDot:2

 +15                       SET DDO=""

FOR

                               SET DDO=$ORDER(DDGFLIST(DDGFR,DDGFC,DDO))

                               IF DDO=""

                                   QUIT

                               Begin DoDot:3

 +16                               SET DDGFN=DDGFN+1

 +17                               SET DDGFO=$PIECE(^DIST(.404,DDGFBK,40,DDO,0),U)

 +18                               IF DDGFO'=DDGFN

                                       SET $PIECE(^DIST(.404,DDGFBK,40,DDO,0),U)=DDGFN

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +19      ;

 +20       SET DIK="^DIST(.404,DDGFBK,40,"

           SET DA(1)=DDGFBK

           SET DIK(1)=".01^B"

 +21       DO ENALL^DIK

 +22       DO MSG^DDGF("Reordering completed.")

           HANG 1

 +23       DO MSG^DDGF()

 +24       QUIT

DDGFORD.m