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 Oct 16, 2024@18:53:19 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'