DICLGFT.m

DICLGFT ;GFT/GFT- USE ANY SORT VALUES FOR LISTER;21MAR2013

 ;;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.

 ;

DICL ;FROM ^DICL  RETURN TO BADQ^DICL WITH DIERR DEFINED OR ELSE WE HAVE DINDEX SET UP CORRECTLY TO GET SORTED OUTPUT

 N X,I,DITEMP,DICLGFT

 D TMPB^DICUIX1(.DITEMP,DIFILE) ;SETS DITEMP=something like "^TMP("DICLB",2,3188"

 S DIGFTEMP=DITEMP_")" ;so we can remember to KILL the temporary array

BACKWARD I $G(DINDEX("WAY","REVERSE"))=1 D

 .S X=$$SORT(DIFILE,DINDEX,DIGFTEMP,,.DIFROM)

 E  D

 .S X=$$SORT(DIFILE,DINDEX,DIGFTEMP,.DIFROM)

 S DIFROM(1)="" I X D BLD^DIALOG(-X,$P(X,U,2)) K @DIGFTEMP Q  ;We have already done the sort, so "FROM" can be the beginning

 ;now we have the answers in @DITEMP.

 ;D COMMON1^DICUIX2  probably need some of this

 S DICLGFT=$P(X,U,2),DINDEX("#")=DICLGFT ;NUMBER OF LEVELS IN OUR SORT

 S DINDEX("IXTYPE")="["

 F I=1:1:DICLGFT+1 S DINDEX(I,"WAY")=DINDEX("WAY")

 S DINDEX(1,"ROOT")=DITEMP_")",X=DITEMP

 F I=1:1:DICLGFT S X=X_",DINDEX("_(I)_")",DINDEX(I+1,"ROOT")=X_")"

 F I=1:1:DICLGFT S DINDEX(I,"FILE")=DIFILE

 ;S DINDEX(1,"GET")="DIVAL=ZZZ" ;????????

 S DINDEX(1,"TYPE")="[",DINDEX("AT")=1

 F I=1:1:DICLGFT S DINDEX(I)=$G(DIFROM(I)) ;FROM VALUES

 S DINDEX(DICLGFT+1)=0

 Q

 ;

 ;

 ;

 ;

SORT(DIFILE,BY,DICLARAY,FR,TO) ;SORT FILE BY TEMPLATE OR FIELD(S), AND PUT RESULTS IN 'DICLARAY' ARRAY

 ;EXTRINSIC FUNCTION RETURNS

 ;"OK^n" IF SUCCESSFUL, where 'n' is number of levels

 ;

 N L,DIC,FLDS,DHD,DIASKHD,DIPCRIT,PG,DHIT,DIOEND,DIOBEG,DCOPIES,IOP,DQTIME,DIS,DISTOP,DISPAR,DIFIXPTH,DISH,DIS0

 N D0,D1,D2,D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13

 N DIQUIET,DISUPNO S DIQUIET=1,DISUPNO=1

 N X

 N DIOSL S DIOSL=9999999 ;NORMALLY SET IN DIP5 OR DIARR

 N DIFIXPT S DIFIXPT=1,DHD="@@" ;TRICK TO AVOID DEVICE SELECTION!

 S DIOBEG="K ^UTILITY($J,""H"") S DISH=1,IOT="""",$X=0,$Y=0" ;TRICK TO SUPPRESS SUBHEADERS IN SORT TEMPLATE, WHETHER OR NOT THERE IS A PRE-SORT

 I '$D(^DIC(DIFILE,0,"GL")) Q "401^"_DIFILE

 S DIC=^("GL")

 ;

 N DICLGFT S DICLGFT=1

 ;

 I "@"[$G(BY) Q "-202^SORT VALUE"

DIBT S X=0 I $G(BY)?1"[".E1"]" S X=$O(^DIBT("F"_DIFILE,$TR(BY,"[]"),0)) I X&$O(^(X))!'X Q "-202^SORT TEMPLATE '"_BY_"'" ;MUST HAVE EXACTLY ONE TEMPLATE OF THAT NAME

 I X S L=$O(^DIBT(X,2,999),-1) I L S DICLGFT=L D  G A:$D(X) Q "-202^SORT TEMPLATE '"_BY_"'" ;NUMBER OF LEVELS

 .F L=1:1:L I $G(^DIBT(X,2,L,"ASK")) K X Q  ;NONE OF THE LEVELS MUST ASK

 ;I X,'L S DICLGFT0=1

 ;

FIELD N DICLGFTX,DD S DICLGFTX=$G(BY),DICLGFT=$L(DICLGFTX,",") ;SORT BY FIELD

 S:$D(FR)[0 FR=",,,,,,,,,,,," S:$D(TO)[0 TO=",,,,,,,,,,"

 S DD=DIFILE F  S FLDS=$P(DICLGFTX,","),DICLGFTX=$P(DICLGFTX,",",2) Q:FLDS=""  D

 .S FLDS=$P(FLDS,";") I $D(^DD(DD,FLDS,0))

 .E  S FLDS=$O(^DD(DD,"B",FLDS,0)) Q:'FLDS

 .S L=+$P(^DD(DD,FLDS,0),U,2) I L S DD=L,DICLGFT=DICLGFT-1 ;GOING DOWN INTO A MULTIPLE, SO LEVEL OF SORT IS 1 LESS THAN WE THOT

 ;

A I DICLARAY["^",DICLARAY'["(" Q "-202^BAD ARRAY "_DICLARAY

 K ^UTILITY("DICLGFT",$J),@DICLARAY

 ;

DHIT S DHIT="" ;I $G(DICLGFT0) S DHIT="1," ;IF IT IS JUST A LIST

 F L=1:1:DICLGFT S X="DIOO"_L,DHIT="$S($G("_X_")]"""":"_X_",1:1),"_DHIT

 S DHIT="("_DHIT_"D0)",DHIT="S @DICLARAY@"_DHIT_"=""""" ;CREATES SOMETHING LIKE DHIT = S @DICLARAY@($S($G(DIOO2)]"":DIOO2,1:1),$S($G(DIOO1)]"":DIOO1,1:1),D0)=""

 ;

 S L=0,FLDS="X ""QUIT"";X"

 S $X=0,$Y=0 ;,IOP="NULL"

DIP D EN1^DIP ;HERE IS THE BIG CALL TO FILEMAN'S PRINT MODULE!

 Q "OK^"_DICLGFT  ;EXIT WITH 'DICLGFT' DEFINED AS THE NUMBER OF LEVELS

 ;

 ;

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DICLGFT   3740     printed  Apr 23, 2025@19:00:31                                                                                                                                                                                                     Page 2

DICLGFT   ;GFT/GFT- USE ANY SORT VALUES FOR LISTER;21MAR2013

 +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       ;

DICL      ;FROM ^DICL  RETURN TO BADQ^DICL WITH DIERR DEFINED OR ELSE WE HAVE DINDEX SET UP CORRECTLY TO GET SORTED OUTPUT

 +1        NEW X,I,DITEMP,DICLGFT

 +2       ;SETS DITEMP=something like "^TMP("DICLB",2,3188"

           DO TMPB^DICUIX1(.DITEMP,DIFILE)

 +3       ;so we can remember to KILL the temporary array

           SET DIGFTEMP=DITEMP_")"

BACKWARD   IF $GET(DINDEX("WAY","REVERSE"))=1

               Begin DoDot:1

 +1                SET X=$$SORT(DIFILE,DINDEX,DIGFTEMP,,.DIFROM)

               End DoDot:1

 +2       IF '$TEST

               Begin DoDot:1

 +3                SET X=$$SORT(DIFILE,DINDEX,DIGFTEMP,.DIFROM)

               End DoDot:1

 +4       ;We have already done the sort, so "FROM" can be the beginning

           SET DIFROM(1)=""

           IF X

               DO BLD^DIALOG(-X,$PIECE(X,U,2))

               KILL @DIGFTEMP

               QUIT 

 +5       ;now we have the answers in @DITEMP.

 +6       ;D COMMON1^DICUIX2  probably need some of this

 +7       ;NUMBER OF LEVELS IN OUR SORT

           SET DICLGFT=$PIECE(X,U,2)

           SET DINDEX("#")=DICLGFT

 +8        SET DINDEX("IXTYPE")="["

 +9        FOR I=1:1:DICLGFT+1

               SET DINDEX(I,"WAY")=DINDEX("WAY")

 +10       SET DINDEX(1,"ROOT")=DITEMP_")"

           SET X=DITEMP

 +11       FOR I=1:1:DICLGFT

               SET X=X_",DINDEX("_(I)_")"

               SET DINDEX(I+1,"ROOT")=X_")"

 +12       FOR I=1:1:DICLGFT

               SET DINDEX(I,"FILE")=DIFILE

 +13      ;S DINDEX(1,"GET")="DIVAL=ZZZ" ;????????

 +14       SET DINDEX(1,"TYPE")="["

           SET DINDEX("AT")=1

 +15      ;FROM VALUES

           FOR I=1:1:DICLGFT

               SET DINDEX(I)=$GET(DIFROM(I))

 +16       SET DINDEX(DICLGFT+1)=0

 +17       QUIT 

 +18      ;

 +19      ;

 +20      ;

 +21      ;

SORT(DIFILE,BY,DICLARAY,FR,TO) ;SORT FILE BY TEMPLATE OR FIELD(S), AND PUT RESULTS IN 'DICLARAY' ARRAY

 +1       ;EXTRINSIC FUNCTION RETURNS

 +2       ;"OK^n" IF SUCCESSFUL, where 'n' is number of levels

 +3       ;

 +4        NEW L,DIC,FLDS,DHD,DIASKHD,DIPCRIT,PG,DHIT,DIOEND,DIOBEG,DCOPIES,IOP,DQTIME,DIS,DISTOP,DISPAR,DIFIXPTH,DISH,DIS0

 +5        NEW D0,D1,D2,D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13

 +6        NEW DIQUIET,DISUPNO

           SET DIQUIET=1

           SET DISUPNO=1

 +7        NEW X

 +8       ;NORMALLY SET IN DIP5 OR DIARR

           NEW DIOSL

           SET DIOSL=9999999

 +9       ;TRICK TO AVOID DEVICE SELECTION!

           NEW DIFIXPT

           SET DIFIXPT=1

           SET DHD="@@"

 +10      ;TRICK TO SUPPRESS SUBHEADERS IN SORT TEMPLATE, WHETHER OR NOT THERE IS A PRE-SORT

           SET DIOBEG="K ^UTILITY($J,""H"") S DISH=1,IOT="""",$X=0,$Y=0"

 +11       IF '$DATA(^DIC(DIFILE,0,"GL"))

               QUIT "401^"_DIFILE

 +12       SET DIC=^("GL")

 +13      ;

 +14       NEW DICLGFT

           SET DICLGFT=1

 +15      ;

 +16       IF "@"[$GET(BY)

               QUIT "-202^SORT VALUE"

DIBT      ;MUST HAVE EXACTLY ONE TEMPLATE OF THAT NAME

           SET X=0

           IF $GET(BY)?1"[".E1"]"

               SET X=$ORDER(^DIBT("F"_DIFILE,$TRANSLATE(BY,"[]"),0))

               IF X&$ORDER(^(X))!'X

                   QUIT "-202^SORT TEMPLATE '"_BY_"'"

 +1       ;NUMBER OF LEVELS

           IF X

               SET L=$ORDER(^DIBT(X,2,999),-1)

               IF L

                   SET DICLGFT=L

                   Begin DoDot:1

 +2       ;NONE OF THE LEVELS MUST ASK

                       FOR L=1:1:L

                           IF $GET(^DIBT(X,2,L,"ASK"))

                               KILL X

                               QUIT 

                   End DoDot:1

                   if $DATA(X)

                       GOTO A

                   QUIT "-202^SORT TEMPLATE '"_BY_"'"

 +3       ;I X,'L S DICLGFT0=1

 +4       ;

FIELD     ;SORT BY FIELD

           NEW DICLGFTX,DD

           SET DICLGFTX=$GET(BY)

           SET DICLGFT=$LENGTH(DICLGFTX,",")

 +1        if $DATA(FR)[0

               SET FR=",,,,,,,,,,,,"

           if $DATA(TO)[0

               SET TO=",,,,,,,,,,"

 +2        SET DD=DIFILE

           FOR 

               SET FLDS=$PIECE(DICLGFTX,",")

               SET DICLGFTX=$PIECE(DICLGFTX,",",2)

               if FLDS=""

                   QUIT 

               Begin DoDot:1

 +3                SET FLDS=$PIECE(FLDS,";")

                   IF $DATA(^DD(DD,FLDS,0))

 +4               IF '$TEST

                       SET FLDS=$ORDER(^DD(DD,"B",FLDS,0))

                       if 'FLDS

                           QUIT 

 +5       ;GOING DOWN INTO A MULTIPLE, SO LEVEL OF SORT IS 1 LESS THAN WE THOT

                   SET L=+$PIECE(^DD(DD,FLDS,0),U,2)

                   IF L

                       SET DD=L

                       SET DICLGFT=DICLGFT-1

               End DoDot:1

 +6       ;

A          IF DICLARAY["^"

               IF DICLARAY'["("

                   QUIT "-202^BAD ARRAY "_DICLARAY

 +1        KILL ^UTILITY("DICLGFT",$JOB),@DICLARAY

 +2       ;

DHIT      ;I $G(DICLGFT0) S DHIT="1," ;IF IT IS JUST A LIST

           SET DHIT=""

 +1        FOR L=1:1:DICLGFT

               SET X="DIOO"_L

               SET DHIT="$S($G("_X_")]"""":"_X_",1:1),"_DHIT

 +2       ;CREATES SOMETHING LIKE DHIT = S @DICLARAY@($S($G(DIOO2)]"":DIOO2,1:1),$S($G(DIOO1)]"":DIOO1,1:1),D0)=""

           SET DHIT="("_DHIT_"D0)"

           SET DHIT="S @DICLARAY@"_DHIT_"="""""

 +3       ;

 +4        SET L=0

           SET FLDS="X ""QUIT"";X"

 +5       ;,IOP="NULL"

           SET $X=0

           SET $Y=0

DIP       ;HERE IS THE BIG CALL TO FILEMAN'S PRINT MODULE!

           DO EN1^DIP

 +1       ;EXIT WITH 'DICLGFT' DEFINED AS THE NUMBER OF LEVELS

           QUIT "OK^"_DICLGFT

 +2       ;

 +3       ;

 +4       ;