XBDR1 ; IHS/ADC/GTH - XBDR SUBROUTINE; [ 10/29/2002 7:42 AM ]
;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Prevent <LINER>
;
; Part of XBDR
;
TYPE ;
S DIR("A")="Input data type"
S DIR(0)="S^D:DATE;E:END-OF-PAGE;F:FREE TEXT;L:LIST OR RANGE;N:NUMERIC;S:SET;Y:YES/NO;Z:FILEMAN"
D ^DIR KILL DIR
I $D(DIRUT) S XBDRQUIT="" Q
;S XBDRTYPE=X;IHS/SET/GTH XB*3*9 10/29/2002
S (XBDRTYPE,X)=$$UP^XLFSTR(X) ;IHS/SET/GTH XB*3*9 10/29/2002
D @X
I $D(XBDRQUIT) Q
I XBDRTYPE'?1.4U Q
S DIR("A")="Is this query mandatory",DIR("B")="NO",DIR(0)="Y"
D ^DIR KILL DIR
X XBDROUT
I S XBDRQUIT="" Q
I "yY"'[$E(X) S XBDRTYPE=XBDRTYPE_"O"
Q
;
E ;
Y ;
Q
;
MINMAX ;
S DIR("A")="Minimum "_Z_" allowed",DIR(0)="NO^::7"
D ^DIR
KILL DIR
X XBDROUT
I S XBDRQUIT="" Q
S XBDRMIN=X,DIR("A")="Maximum "_Z_" allowed",DIR(0)="NO^::7"
D ^DIR
KILL DIR
X XBDROUT
I S XBDRQUIT="" Q
S XBDRMAX=X
Q
;
F ;
S Z="length"
D MINMAX
Q
;
L ;
S Z="value"
D MINMAX
Q
;
N ;
S Z="value"
D MINMAX
S DIR("A")="Maximum number of decimal places",DIR(0)="NO^0:9"
D ^DIR
KILL DIR
X XBDROUT
I S XBDRQUIT="" Q
S XBDRSPEC=X
Q
;
S ;
S XBDRMIN=""
F L=0:0 D S1 Q:X=""
I XBDRMIN="" S XBDRQUIT="" Q
I '$D(XBDRQUIT) D S2
Q
;
S1 ;
W !
S DIR("A")="Code",DIR(0)="FO"
D ^DIR
KILL DIR
X XBDROUT
I S XBDRQUIT="",X="" Q
I X="" Q
S Z=X,DIR("A")="Stands for",DIR(0)="F"
D ^DIR
KILL DIR
X XBDROUT
I S XBDRQUIT="",X="" Q
S:XBDRMIN]"" XBDRMIN=XBDRMIN_";"
S XBDRMIN=XBDRMIN_Z_":"_X
I $L(XBDRMIN)>240 W *7," DIR STRING TOO LONG...SESSION ABORTED" S XBDRQUIT="",X=""
Q
;
S2 ;
S DIR("A")="Possible choices should be listed which format"
S DIR("B")="VERTICAL"
S DIR(0)="SB^H:HORIZONTAL;V:VERTICAL;"
W !
D ^DIR
KILL DIR
X XBDROUT
I S XBDRQUIT=""
I $E(X)="H" S XBDRTYPE=XBDRTYPE_"B"
Q
;
D ;
S DIR("A")="Enter earliest date",DIR(0)="DO^::ETS"
D ^DIR
KILL DIR
X XBDROUT
I S XBDRQUIT="" Q
S XBDRMIN=Y
S DIR("A")="Enter maximum date",DIR(0)="DO^"_XBDRMIN_"::ETS"
D ^DIR
KILL DIR
X XBDROUT
I S XBDRQUIT="" Q
S XBDRMAX=Y
DTS ;
W !!!,"Enter the %DT string using as many of the following as you wish:",!!
S X="F;Future dates assumed^N;Numeric input not allowed^P;Past dates assumed^R;Time required^T;Time allowed^X;Exact time required^S;Seconds allowed"
F I=1:1 S Y=$P(X,U,I) Q:Y="" W $P(Y,";")," ",$P(Y,";",2),!
ADTS ;
S DIR("A")="%DT String",DIR(0)="FO"
D ^DIR
KILL DIR
X XBDROUT
I S XBDRQUIT="" Q
I X="" S XBDRSPEC="E" Q
I X'?1.9U W *7," ??" G ADTS
S XBDRSPEC="E"_X
Q
;
Z ;
S DIC=1,DIC(0)="AEQ",DIC("A")="Enter FILE name: "
W !
D ^DIC
KILL DIC
I Y=-1 S XBDRQUIT="" Q
S Z=+Y,DIC="^DD("_+Y_",",DIC(0)="AEQ",DIC("A")="Enter FIELD name: "
D ^DIC
KILL DIC
I Y=-1 S XBDRQUIT="" Q
S XBDRTYPE=Z_","_+Y,XBDRRUN=5
Q
;
XBDR1 ; IHS/ADC/GTH - XBDR SUBROUTINE; [ 10/29/2002 7:42 AM ]
+1 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
+2 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Prevent <LINER>
+3 ;
+4 ; Part of XBDR
+5 ;
TYPE ;
+1 SET DIR("A")="Input data type"
+2 SET DIR(0)="S^D:DATE;E:END-OF-PAGE;F:FREE TEXT;L:LIST OR RANGE;N:NUMERIC;S:SET;Y:YES/NO;Z:FILEMAN"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET XBDRQUIT=""
QUIT
+5 ;S XBDRTYPE=X;IHS/SET/GTH XB*3*9 10/29/2002
+6 ;IHS/SET/GTH XB*3*9 10/29/2002
SET (XBDRTYPE,X)=$$UP^XLFSTR(X)
+7 DO @X
+8 IF $DATA(XBDRQUIT)
QUIT
+9 IF XBDRTYPE'?1.4U
QUIT
+10 SET DIR("A")="Is this query mandatory"
SET DIR("B")="NO"
SET DIR(0)="Y"
+11 DO ^DIR
KILL DIR
+12 XECUTE XBDROUT
+13 IF $TEST
SET XBDRQUIT=""
QUIT
+14 IF "yY"'[$EXTRACT(X)
SET XBDRTYPE=XBDRTYPE_"O"
+15 QUIT
+16 ;
E ;
Y ;
+1 QUIT
+2 ;
MINMAX ;
+1 SET DIR("A")="Minimum "_Z_" allowed"
SET DIR(0)="NO^::7"
+2 DO ^DIR
+3 KILL DIR
+4 XECUTE XBDROUT
+5 IF $TEST
SET XBDRQUIT=""
QUIT
+6 SET XBDRMIN=X
SET DIR("A")="Maximum "_Z_" allowed"
SET DIR(0)="NO^::7"
+7 DO ^DIR
+8 KILL DIR
+9 XECUTE XBDROUT
+10 IF $TEST
SET XBDRQUIT=""
QUIT
+11 SET XBDRMAX=X
+12 QUIT
+13 ;
F ;
+1 SET Z="length"
+2 DO MINMAX
+3 QUIT
+4 ;
L ;
+1 SET Z="value"
+2 DO MINMAX
+3 QUIT
+4 ;
N ;
+1 SET Z="value"
+2 DO MINMAX
+3 SET DIR("A")="Maximum number of decimal places"
SET DIR(0)="NO^0:9"
+4 DO ^DIR
+5 KILL DIR
+6 XECUTE XBDROUT
+7 IF $TEST
SET XBDRQUIT=""
QUIT
+8 SET XBDRSPEC=X
+9 QUIT
+10 ;
S ;
+1 SET XBDRMIN=""
+2 FOR L=0:0
DO S1
IF X=""
QUIT
+3 IF XBDRMIN=""
SET XBDRQUIT=""
QUIT
+4 IF '$DATA(XBDRQUIT)
DO S2
+5 QUIT
+6 ;
S1 ;
+1 WRITE !
+2 SET DIR("A")="Code"
SET DIR(0)="FO"
+3 DO ^DIR
+4 KILL DIR
+5 XECUTE XBDROUT
+6 IF $TEST
SET XBDRQUIT=""
SET X=""
QUIT
+7 IF X=""
QUIT
+8 SET Z=X
SET DIR("A")="Stands for"
SET DIR(0)="F"
+9 DO ^DIR
+10 KILL DIR
+11 XECUTE XBDROUT
+12 IF $TEST
SET XBDRQUIT=""
SET X=""
QUIT
+13 IF XBDRMIN]""
SET XBDRMIN=XBDRMIN_";"
+14 SET XBDRMIN=XBDRMIN_Z_":"_X
+15 IF $LENGTH(XBDRMIN)>240
WRITE *7," DIR STRING TOO LONG...SESSION ABORTED"
SET XBDRQUIT=""
SET X=""
+16 QUIT
+17 ;
S2 ;
+1 SET DIR("A")="Possible choices should be listed which format"
+2 SET DIR("B")="VERTICAL"
+3 SET DIR(0)="SB^H:HORIZONTAL;V:VERTICAL;"
+4 WRITE !
+5 DO ^DIR
+6 KILL DIR
+7 XECUTE XBDROUT
+8 IF $TEST
SET XBDRQUIT=""
+9 IF $EXTRACT(X)="H"
SET XBDRTYPE=XBDRTYPE_"B"
+10 QUIT
+11 ;
D ;
+1 SET DIR("A")="Enter earliest date"
SET DIR(0)="DO^::ETS"
+2 DO ^DIR
+3 KILL DIR
+4 XECUTE XBDROUT
+5 IF $TEST
SET XBDRQUIT=""
QUIT
+6 SET XBDRMIN=Y
+7 SET DIR("A")="Enter maximum date"
SET DIR(0)="DO^"_XBDRMIN_"::ETS"
+8 DO ^DIR
+9 KILL DIR
+10 XECUTE XBDROUT
+11 IF $TEST
SET XBDRQUIT=""
QUIT
+12 SET XBDRMAX=Y
DTS ;
+1 WRITE !!!,"Enter the %DT string using as many of the following as you wish:",!!
+2 SET X="F;Future dates assumed^N;Numeric input not allowed^P;Past dates assumed^R;Time required^T;Time allowed^X;Exact time required^S;Seconds allowed"
+3 FOR I=1:1
SET Y=$PIECE(X,U,I)
IF Y=""
QUIT
WRITE $PIECE(Y,";")," ",$PIECE(Y,";",2),!
ADTS ;
+1 SET DIR("A")="%DT String"
SET DIR(0)="FO"
+2 DO ^DIR
+3 KILL DIR
+4 XECUTE XBDROUT
+5 IF $TEST
SET XBDRQUIT=""
QUIT
+6 IF X=""
SET XBDRSPEC="E"
QUIT
+7 IF X'?1.9U
WRITE *7," ??"
GOTO ADTS
+8 SET XBDRSPEC="E"_X
+9 QUIT
+10 ;
Z ;
+1 SET DIC=1
SET DIC(0)="AEQ"
SET DIC("A")="Enter FILE name: "
+2 WRITE !
+3 DO ^DIC
+4 KILL DIC
+5 IF Y=-1
SET XBDRQUIT=""
QUIT
+6 SET Z=+Y
SET DIC="^DD("_+Y_","
SET DIC(0)="AEQ"
SET DIC("A")="Enter FIELD name: "
+7 DO ^DIC
+8 KILL DIC
+9 IF Y=-1
SET XBDRQUIT=""
QUIT
+10 SET XBDRTYPE=Z_","_+Y
SET XBDRRUN=5
+11 QUIT
+12 ;
