DIP31.m

DIP31 ;SFISC/TKW-ASK USER QUESTIONS ABOUT HEADING ;7:19 AM  27 May 1999

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

 ;

HQ N DISAVX,Y,DA,DIZ S DISAVX=X K DIR,DTOUT,DUOUT,DIRUT

 G:$D(DISUPNO)!($D(DIPCRIT)) HQ1 S DISUPNO=0,DIPCRIT=0

 I $D(DIS)>9 S DIZ(1)=$$EZBLD^DIALOG(8006),DIZ(2)=$$EZBLD^DIALOG(8038)

 E  S DIZ(1)=$$EZBLD^DIALOG(8007),DIZ(2)=$$EZBLD^DIALOG(8037)

 S DIR("A")=$$EZBLD^DIALOG(8008) D BLD^DIALOG(8005,.DIZ,"","DIR(""?"")")

 S DIR("B")=X,DIR(0)="FOU" D ^DIR K DIR G Q:$D(DIRUT)

 Q:X=""  I "SC"'[X,"CS"'[X Q

 W ! I X["S" S DISUPNO=1 D BLD^DIALOG(8010,.DIZ,"","DIR") W !,"  ",DIR

 I X["C" S DIPCRIT=1,DIZ=DIZ(2) D BLD^DIALOG(8011,DIZ,"","DIR") W !,"  ",DIR

 W !!

HQ1 D BLD^DIALOG(8009,"","","DIR(""?"")")

 S DIR("A")=$$EZBLD^DIALOG(8012),DIR("B")=DISAVX,DIR(0)="FOU^^K:X]""""&(""SC""[X!(""CS""[X)) X" D ^DIR K DIR G Q

 ;

Q S:$D(DUOUT)!($D(DTOUT)) X="^" Q

 ;DIALOG #8005  'There are two different options:'

 ;       #8006  'Number of Matches from the search'

 ;       #8007  'heading when there are no records to print'

 ;       #8008  'Heading/S/C'

 ;       #8009  'Accept default heading or enter a custom heading...'

 ;       #8010  '** Suppress the...'

 ;       #8011  '** Print...criteria in heading.'

 ;       #8012  'Heading'

 ;       #8037 'sort'

 ;       #8038  'search'

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DIP31   1577     printed  Apr 09, 2024@21:49:22                                                                                                                                                                                                       Page 2

DIP31     ;SFISC/TKW-ASK USER QUESTIONS ABOUT HEADING ;7:19 AM  27 May 1999

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

HQ         NEW DISAVX,Y,DA,DIZ

           SET DISAVX=X

           KILL DIR,DTOUT,DUOUT,DIRUT

 +1        if $DATA(DISUPNO)!($DATA(DIPCRIT))

               GOTO HQ1

           SET DISUPNO=0

           SET DIPCRIT=0

 +2        IF $DATA(DIS)>9

               SET DIZ(1)=$$EZBLD^DIALOG(8006)

               SET DIZ(2)=$$EZBLD^DIALOG(8038)

 +3       IF '$TEST

               SET DIZ(1)=$$EZBLD^DIALOG(8007)

               SET DIZ(2)=$$EZBLD^DIALOG(8037)

 +4        SET DIR("A")=$$EZBLD^DIALOG(8008)

           DO BLD^DIALOG(8005,.DIZ,"","DIR(""?"")")

 +5        SET DIR("B")=X

           SET DIR(0)="FOU"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO Q

 +6        if X=""

               QUIT 

           IF "SC"'[X

               IF "CS"'[X

                   QUIT 

 +7        WRITE !

           IF X["S"

               SET DISUPNO=1

               DO BLD^DIALOG(8010,.DIZ,"","DIR")

               WRITE !,"  ",DIR

 +8        IF X["C"

               SET DIPCRIT=1

               SET DIZ=DIZ(2)

               DO BLD^DIALOG(8011,DIZ,"","DIR")

               WRITE !,"  ",DIR

 +9        WRITE !!

HQ1        DO BLD^DIALOG(8009,"","","DIR(""?"")")

 +1        SET DIR("A")=$$EZBLD^DIALOG(8012)

           SET DIR("B")=DISAVX

           SET DIR(0)="FOU^^K:X]""""&(""SC""[X!(""CS""[X)) X"

           DO ^DIR

           KILL DIR

           GOTO Q

 +2       ;

Q          if $DATA(DUOUT)!($DATA(DTOUT))

               SET X="^"

           QUIT 

 +1       ;DIALOG #8005  'There are two different options:'

 +2       ;       #8006  'Number of Matches from the search'

 +3       ;       #8007  'heading when there are no records to print'

 +4       ;       #8008  'Heading/S/C'

 +5       ;       #8009  'Accept default heading or enter a custom heading...'

 +6       ;       #8010  '** Suppress the...'

 +7       ;       #8011  '** Print...criteria in heading.'

 +8       ;       #8012  'Heading'

 +9       ;       #8037 'sort'

 +10      ;       #8038  'search'