- DIQQ ;SFISC/GFT-VARIOUS HELPS ;11:05 AM 9 Aug 2002
- ;;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.
- ;
- DIP ;**CCO/NI EVERYTHING THRU TAG '11' CHANGED
- D BLD^DIALOG(9070),MSG^DIALOG("WH") ;*CCO/NI TYPE '-' ...
- I $G(DDXP)'=4 D BLD^DIALOG(9071),MSG^DIALOG("WH") ;*CCO/NI '=', '#', ETC
- I DJ=1 D BLD^DIALOG(9072),MSG^DIALOG("WH") ;**CCO/NI '[TEMPLATE NAME]'
- I DUZ(0)="@",DJ=1 D BLD^DIALOG(9073),MSG^DIALOG("WH") ;**CCO/NI 'BY(0)'
- Q
- ;
- DIP3 ;
- D BLD^DIALOG(9085,IO),MSG^DIALOG("WH") ;**CCO/NI 'YOU CAN FREE THIS TERMINAL'
- G FREE^DIP3
- ;
- DIP1(FT) ;from DIR reader -- FROM or TO help
- I X'["??" D
- .N DIP S DIP(1)=DE,DIP(2)=DIPR
- .D BLD^DIALOG(9080+FT,.DIP),MSG^DIALOG("WH") ;**CCO/NI
- .I $G(DIR("B"))]"" S %=$P("FIRST^LAST",U,FT) I %'=DIR("B") W !?5,"OR ENTER '",%,"' TO ",$P("START FROM THE FIRST^GO THRU THE LAST",U,FT)," VALUE"
- 11 I $P(DPP(DJ),U) S %=$P(DPP(DJ),U,2)+$P($P(DPP(DJ),U,4),"""",2) I % W ! D EN^DIQQ1($P(DPP(DJ),U),%,$S(X["??":"??",1:"?"))
- Q
- ;
- DICATT3 W "TYPE FIELD NAMES, OPERATORS(+-\/*), DIGITS, OR FUNCTIONS",!,"FOR FUNCTIONS,"
- S D="B",DZ="??",DIC("W")="W:$D(^(9)) "" ("",^(9),"")""",DIC="^DD(""FUNC"",",DIC(0)="" D DQ^DICQ G 6^DICATT3
- ;
- DICATT31 W !,"ENTER THE NUMBER OF DIGITS THAT SHOULD NORMALLY APPEAR TO THE"
- W !,"RIGHT OF THE DECIMAL POINT WHEN '",F,"' IS DISPLAYED" G DEC^DICATT3
- ;
- DIP2 ;
- I $G(DDXP)=2 D G F^DIP2
- .W !!?5,"YOU CAN ALSO ENTER A COMPUTED EXPRESSION."
- .W:DE="" !?5,"ENTER '[TEMPLATE NAME]' TO USE AN EXISTING SELECTED EXPORT FIELDS TEMPLATE."
- .W !
- I $P(DU,U,4)>1 D BLD^DIALOG(9076,$P(DU,U)),MSG^DIALOG("WH") ;**CCO/NI 'TYPE 'ALL''
- D BLD^DIALOG(9077),MSG^DIALOG("WH") ;**CCO/NI 'TYPE '&' ETC'
- I DE="" D BLD^DIALOG(9078),MSG^DIALOG("WH") ;**CCO/NI 'TYPE [TEMPLATE NAME]'
- G F^DIP2
- ;
- DICE2 ;
- W !!,"YOU MAY USE '@' TO INDICATE THAT '",DNEW,"' IS TO BE DELETED",!,"IF YOU SIMPLY WANT TO MOVE THE VALUE OF '",DOLD,"' OVER,",!," JUST ENTER '",DOLD,"'"
- G C^DICE2
- DIARQ ;ARCHIVING ERROR MESSAGES
- FER W !,$C(7),"Less than 'FROM SELECT CRITERIA VALUE'.",$P(DIARS,U,2) Q
- FER1 W !,$C(7),$$EZBLD^DIALOG(1511) Q ;**CCO/NI 'START WITH' > 'GO TO'
- TER W !,$C(7),"Less than 'TO SELECT CRITERIA VALUE'.",$P(DIARE,U,2) Q
- TER1 W !,$C(7),"Less than 'TO' value." Q
- ;
- ENTT W !!,"_____________________________________________________________________________",!!,$C(7),"A field in the 'SELECT CRITERIA TEMPLATE being used does NOT MATCH."
- W !,"the field at the SAME LEVEL in the BASE SELECT CRITERIA SORT TEMPLATE"
- W !,"specified for this file. There must be a one to one correspondence"
- W !,"between the fields in the template you want to use and the"
- W !,"BASIC SELECT CRITERIA SORT TEMPLATE, until all the fields in the"
- W !,"BASIC SELECT CRITERIA SORT TEMPLATE have been satisfied. More"
- W !,"CRITERIA may exist after that. See the development staff of the Package"
- W !,"or the ARCHIVING DOCUMENTATION where this process is explained further"
- W !,"for more information."
- W !,"_____________________________________________________________________________"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIQQ 3324 printed Jan 18, 2025@03:54:41 Page 2
- DIQQ ;SFISC/GFT-VARIOUS HELPS ;11:05 AM 9 Aug 2002
- +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 ;
- DIP ;**CCO/NI EVERYTHING THRU TAG '11' CHANGED
- +1 ;*CCO/NI TYPE '-' ...
- DO BLD^DIALOG(9070)
- DO MSG^DIALOG("WH")
- +2 ;*CCO/NI '=', '#', ETC
- IF $GET(DDXP)'=4
- DO BLD^DIALOG(9071)
- DO MSG^DIALOG("WH")
- +3 ;**CCO/NI '[TEMPLATE NAME]'
- IF DJ=1
- DO BLD^DIALOG(9072)
- DO MSG^DIALOG("WH")
- +4 ;**CCO/NI 'BY(0)'
- IF DUZ(0)="@"
- IF DJ=1
- DO BLD^DIALOG(9073)
- DO MSG^DIALOG("WH")
- +5 QUIT
- +6 ;
- DIP3 ;
- +1 ;**CCO/NI 'YOU CAN FREE THIS TERMINAL'
- DO BLD^DIALOG(9085,IO)
- DO MSG^DIALOG("WH")
- +2 GOTO FREE^DIP3
- +3 ;
- DIP1(FT) ;from DIR reader -- FROM or TO help
- +1 IF X'["??"
- Begin DoDot:1
- +2 NEW DIP
- SET DIP(1)=DE
- SET DIP(2)=DIPR
- +3 ;**CCO/NI
- DO BLD^DIALOG(9080+FT,.DIP)
- DO MSG^DIALOG("WH")
- +4 IF $GET(DIR("B"))]""
- SET %=$PIECE("FIRST^LAST",U,FT)
- IF %'=DIR("B")
- WRITE !?5,"OR ENTER '",%,"' TO ",$PIECE("START FROM THE FIRST^GO THRU THE LAST",U,FT)," VALUE"
- End DoDot:1
- 11 IF $PIECE(DPP(DJ),U)
- SET %=$PIECE(DPP(DJ),U,2)+$PIECE($PIECE(DPP(DJ),U,4),"""",2)
- IF %
- WRITE !
- DO EN^DIQQ1($PIECE(DPP(DJ),U),%,$SELECT(X["??":"??",1:"?"))
- +1 QUIT
- +2 ;
- DICATT3 WRITE "TYPE FIELD NAMES, OPERATORS(+-\/*), DIGITS, OR FUNCTIONS",!,"FOR FUNCTIONS,"
- +1 SET D="B"
- SET DZ="??"
- SET DIC("W")="W:$D(^(9)) "" ("",^(9),"")"""
- SET DIC="^DD(""FUNC"","
- SET DIC(0)=""
- DO DQ^DICQ
- GOTO 6^DICATT3
- +2 ;
- DICATT31 WRITE !,"ENTER THE NUMBER OF DIGITS THAT SHOULD NORMALLY APPEAR TO THE"
- +1 WRITE !,"RIGHT OF THE DECIMAL POINT WHEN '",F,"' IS DISPLAYED"
- GOTO DEC^DICATT3
- +2 ;
- DIP2 ;
- +1 IF $GET(DDXP)=2
- Begin DoDot:1
- +2 WRITE !!?5,"YOU CAN ALSO ENTER A COMPUTED EXPRESSION."
- +3 if DE=""
- WRITE !?5,"ENTER '[TEMPLATE NAME]' TO USE AN EXISTING SELECTED EXPORT FIELDS TEMPLATE."
- +4 WRITE !
- End DoDot:1
- GOTO F^DIP2
- +5 ;**CCO/NI 'TYPE 'ALL''
- IF $PIECE(DU,U,4)>1
- DO BLD^DIALOG(9076,$PIECE(DU,U))
- DO MSG^DIALOG("WH")
- +6 ;**CCO/NI 'TYPE '&' ETC'
- DO BLD^DIALOG(9077)
- DO MSG^DIALOG("WH")
- +7 ;**CCO/NI 'TYPE [TEMPLATE NAME]'
- IF DE=""
- DO BLD^DIALOG(9078)
- DO MSG^DIALOG("WH")
- +8 GOTO F^DIP2
- +9 ;
- DICE2 ;
- +1 WRITE !!,"YOU MAY USE '@' TO INDICATE THAT '",DNEW,"' IS TO BE DELETED",!,"IF YOU SIMPLY WANT TO MOVE THE VALUE OF '",DOLD,"' OVER,",!," JUST ENTER '",DOLD,"'"
- +2 GOTO C^DICE2
- DIARQ ;ARCHIVING ERROR MESSAGES
- FER WRITE !,$CHAR(7),"Less than 'FROM SELECT CRITERIA VALUE'.",$PIECE(DIARS,U,2)
- QUIT
- FER1 ;**CCO/NI 'START WITH' > 'GO TO'
- WRITE !,$CHAR(7),$$EZBLD^DIALOG(1511)
- QUIT
- TER WRITE !,$CHAR(7),"Less than 'TO SELECT CRITERIA VALUE'.",$PIECE(DIARE,U,2)
- QUIT
- TER1 WRITE !,$CHAR(7),"Less than 'TO' value."
- QUIT
- +1 ;
- ENTT WRITE !!,"_____________________________________________________________________________",!!,$CHAR(7),"A field in the 'SELECT CRITERIA TEMPLATE being used does NOT MATCH."
- +1 WRITE !,"the field at the SAME LEVEL in the BASE SELECT CRITERIA SORT TEMPLATE"
- +2 WRITE !,"specified for this file. There must be a one to one correspondence"
- +3 WRITE !,"between the fields in the template you want to use and the"
- +4 WRITE !,"BASIC SELECT CRITERIA SORT TEMPLATE, until all the fields in the"
- +5 WRITE !,"BASIC SELECT CRITERIA SORT TEMPLATE have been satisfied. More"
- +6 WRITE !,"CRITERIA may exist after that. See the development staff of the Package"
- +7 WRITE !,"or the ARCHIVING DOCUMENTATION where this process is explained further"
- +8 WRITE !,"for more information."
- +9 WRITE !,"_____________________________________________________________________________"
- +10 QUIT