- 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 ---[H[J[2J[HDIP31 1577 printed Jan 18, 2025@03:53:45 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'