DDGFORD ;SFISC/MKO-REORDER THE FIELDS ON BLOCK ;07:13 AM 25 May 1994
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
;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()
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGFORD 1465 printed Apr 09, 2024@21:44:16 Page 2
DDGFORD ;SFISC/MKO-REORDER THE FIELDS ON BLOCK ;07:13 AM 25 May 1994
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ;In: DDGFBK = Block number
+8 ; DDGFPG = Page number
+9 ; DDGFFM = Form number^Form name
+10 ; DDGFREF = Global reference
+11 ;
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
