DIQQQ.m

DIQQQ ;SFISC/GFT,XAK-MORE HELP ;21FEB2005

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

 ;

DICATT W !,"IF YOU WANT THE SAME ANSWER ALLOWED FOR ",F,!,"AS FOR " Q

 ;

DICATT1 W !,"ENTER GLOBAL SUBSCRIPT NAME AT WHICH ",F," WILL BE STORED"

 W !,"   ALREADY ASSIGNED: " S Y="",T=0 F  S Y=$O(^DD(A,"GL",Y)) Q:Y=""  W $J(Y,9) W:$X>66 !

 S Y=-1 G SUB^DICATT1

 ;

DIS ;

 D  W !! Q  ;**CCO/NI (next 8 lines) HELP FOR SEARCHING

 .N DIP

 .S DIP(1)=O(DC),DIP(2)=$P("NOT ",U,DN]"")_$P("^CONTAIN^MATCH^BE LESS THAN^EQUAL^EXCEED^FOLLOW",U,+DQ),DIP(3)=$C(DC+64)

 .D BLD^DIALOG(9079,.DIP),MSG^DIALOG("WH")

 .W:+DQ=3 !?8,"(I.E., ENTER WHAT WOULD FOLLOW THE MUMPS '?' OPERATOR)",!

 .I E["S" W !! D EN^DIQQ1(DK,DU,"?")

 ;

DISC ;

 D BLD^DIALOG(9075),MSG^DIALOG("WH") G C^DIS

 ;

DIP1 ;

 W $C(7) D BLD^DIALOG(8145),MSG^DIALOG("WE") G Q^DIP ;**CCO/NI 'YOU'VE ASKED FOR THE SAME SORT FIELD TWICE!'

 ;

DIP3 W !,$$EZBLD^DIALOG(9086) G ^DIP3

 ;

DIA ;

 W ! D BLD^DIALOG(9131),MSG^DIALOG("WH") ;**CCO/NI HELP FOR 'EDIT WHICH FIELD:'

 G 2^DIA

 ;

DIA3 ;

 W ! D BLD^DIALOG(8147),MSG^DIALOG("WE") W ! G 2^DIA ;**CCO/NI 'CAPTIONS CANNOT CONTAIN...'

 ;

DIP21 ;

 D BLD^DIALOG(9083),MSG^DIALOG("WH") ;**CCO/NI HELP FOR THE 'SUPPRESS SUBHEADERS?' QUERY

 G SUB^DIP21

 ;

DICOMPW W ! D BLD^DIALOG(9121,Y),MSG^DIALOG("WH") Q  ;**CCO/NI HELP FOR RELATIONAL-JUMP QUERY IN CREATING A COMPUTED EXPRESSION

 ;

XPDIP21 ;from XPUT^DIP21

 W !!,$C(7),"You must choose a template to store the fields selected for export."

 W !,"If you do not want to save the selections, use the '^'.",! Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DIQQQ   1833     printed  Sep 02, 2024@19:39:02                                                                                                                                                                                                       Page 2

DIQQQ     ;SFISC/GFT,XAK-MORE HELP ;21FEB2005

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

DICATT     WRITE !,"IF YOU WANT THE SAME ANSWER ALLOWED FOR ",F,!,"AS FOR "

           QUIT 

 +1       ;

DICATT1    WRITE !,"ENTER GLOBAL SUBSCRIPT NAME AT WHICH ",F," WILL BE STORED"

 +1        WRITE !,"   ALREADY ASSIGNED: "

           SET Y=""

           SET T=0

           FOR 

               SET Y=$ORDER(^DD(A,"GL",Y))

               if Y=""

                   QUIT 

               WRITE $JUSTIFY(Y,9)

               if $X>66

                   WRITE !

 +2        SET Y=-1

           GOTO SUB^DICATT1

 +3       ;

DIS       ;

 +1       ;**CCO/NI (next 8 lines) HELP FOR SEARCHING

           Begin DoDot:1

 +2            NEW DIP

 +3            SET DIP(1)=O(DC)

               SET DIP(2)=$PIECE("NOT ",U,DN]"")_$PIECE("^CONTAIN^MATCH^BE LESS THAN^EQUAL^EXCEED^FOLLOW",U,+DQ)

               SET DIP(3)=$CHAR(DC+64)

 +4            DO BLD^DIALOG(9079,.DIP)

               DO MSG^DIALOG("WH")

 +5            if +DQ=3

                   WRITE !?8,"(I.E., ENTER WHAT WOULD FOLLOW THE MUMPS '?' OPERATOR)",!

 +6            IF E["S"

                   WRITE !!

                   DO EN^DIQQ1(DK,DU,"?")

           End DoDot:1

           WRITE !!

           QUIT 

 +7       ;

DISC      ;

 +1        DO BLD^DIALOG(9075)

           DO MSG^DIALOG("WH")

           GOTO C^DIS

 +2       ;

DIP1      ;

 +1       ;**CCO/NI 'YOU'VE ASKED FOR THE SAME SORT FIELD TWICE!'

           WRITE $CHAR(7)

           DO BLD^DIALOG(8145)

           DO MSG^DIALOG("WE")

           GOTO Q^DIP

 +2       ;

DIP3       WRITE !,$$EZBLD^DIALOG(9086)

           GOTO ^DIP3

 +1       ;

DIA       ;

 +1       ;**CCO/NI HELP FOR 'EDIT WHICH FIELD:'

           WRITE !

           DO BLD^DIALOG(9131)

           DO MSG^DIALOG("WH")

 +2        GOTO 2^DIA

 +3       ;

DIA3      ;

 +1       ;**CCO/NI 'CAPTIONS CANNOT CONTAIN...'

           WRITE !

           DO BLD^DIALOG(8147)

           DO MSG^DIALOG("WE")

           WRITE !

           GOTO 2^DIA

 +2       ;

DIP21     ;

 +1       ;**CCO/NI HELP FOR THE 'SUPPRESS SUBHEADERS?' QUERY

           DO BLD^DIALOG(9083)

           DO MSG^DIALOG("WH")

 +2        GOTO SUB^DIP21

 +3       ;

DICOMPW   ;**CCO/NI HELP FOR RELATIONAL-JUMP QUERY IN CREATING A COMPUTED EXPRESSION

           WRITE !

           DO BLD^DIALOG(9121,Y)

           DO MSG^DIALOG("WH")

           QUIT 

 +1       ;

XPDIP21   ;from XPUT^DIP21

 +1        WRITE !!,$CHAR(7),"You must choose a template to store the fields selected for export."

 +2        WRITE !,"If you do not want to save the selections, use the '^'.",!

           QUIT