Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XBDR1

XBDR1.m

Go to the documentation of this file. 
  1. XBDR1 ; IHS/ADC/GTH - XBDR SUBROUTINE; [ 10/29/2002   7:42 AM ]
  1.  ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
  1.  ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Prevent <LINER>
  1.  ;
  1.  ; Part of XBDR
  1.  ;
  1. TYPE ;
  1.  S DIR("A")="Input data type"
  1.  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"
  1.  D ^DIR KILL DIR
  1.  I $D(DIRUT) S XBDRQUIT="" Q
  1.  ;S XBDRTYPE=X;IHS/SET/GTH XB*3*9 10/29/2002
  1.  S (XBDRTYPE,X)=$$UP^XLFSTR(X) ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  D @X
  1.  I $D(XBDRQUIT) Q
  1.  I XBDRTYPE'?1.4U Q
  1.  S DIR("A")="Is this query mandatory",DIR("B")="NO",DIR(0)="Y"
  1.  D ^DIR KILL DIR
  1.  X XBDROUT
  1.  I  S XBDRQUIT="" Q
  1.  I "yY"'[$E(X) S XBDRTYPE=XBDRTYPE_"O"
  1.  Q
  1.  ;
  1. E ;
  1. Y ;
  1.  Q
  1.  ;
  1. MINMAX ;
  1.  S DIR("A")="Minimum "_Z_" allowed",DIR(0)="NO^::7"
  1.  D ^DIR
  1.  KILL DIR
  1.  X XBDROUT
  1.  I  S XBDRQUIT="" Q
  1.  S XBDRMIN=X,DIR("A")="Maximum "_Z_" allowed",DIR(0)="NO^::7"
  1.  D ^DIR
  1.  KILL DIR
  1.  X XBDROUT
  1.  I  S XBDRQUIT="" Q
  1.  S XBDRMAX=X
  1.  Q
  1.  ;
  1. F ;
  1.  S Z="length"
  1.  D MINMAX
  1.  Q
  1.  ;
  1. L ;
  1.  S Z="value"
  1.  D MINMAX
  1.  Q
  1.  ;
  1. N ;
  1.  S Z="value"
  1.  D MINMAX
  1.  S DIR("A")="Maximum number of decimal places",DIR(0)="NO^0:9"
  1.  D ^DIR
  1.  KILL DIR
  1.  X XBDROUT
  1.  I  S XBDRQUIT="" Q
  1.  S XBDRSPEC=X
  1.  Q
  1.  ;
  1. S ;
  1.  S XBDRMIN=""
  1.  F L=0:0 D S1 Q:X=""
  1.  I XBDRMIN="" S XBDRQUIT="" Q
  1.  I '$D(XBDRQUIT) D S2
  1.  Q
  1.  ;
  1. S1 ;
  1.  W !
  1.  S DIR("A")="Code",DIR(0)="FO"
  1.  D ^DIR
  1.  KILL DIR
  1.  X XBDROUT
  1.  I  S XBDRQUIT="",X="" Q
  1.  I X="" Q
  1.  S Z=X,DIR("A")="Stands for",DIR(0)="F"
  1.  D ^DIR
  1.  KILL DIR
  1.  X XBDROUT
  1.  I  S XBDRQUIT="",X="" Q
  1.  S:XBDRMIN]"" XBDRMIN=XBDRMIN_";"
  1.  S XBDRMIN=XBDRMIN_Z_":"_X
  1.  I $L(XBDRMIN)>240 W *7,"  DIR STRING TOO LONG...SESSION ABORTED" S XBDRQUIT="",X=""
  1.  Q
  1.  ;
  1. S2 ;
  1.  S DIR("A")="Possible choices should be listed which format"
  1.  S DIR("B")="VERTICAL"
  1.  S DIR(0)="SB^H:HORIZONTAL;V:VERTICAL;"
  1.  W !
  1.  D ^DIR
  1.  KILL DIR
  1.  X XBDROUT
  1.  I  S XBDRQUIT=""
  1.  I $E(X)="H" S XBDRTYPE=XBDRTYPE_"B"
  1.  Q
  1.  ;
  1. D ;
  1.  S DIR("A")="Enter earliest date",DIR(0)="DO^::ETS"
  1.  D ^DIR
  1.  KILL DIR
  1.  X XBDROUT
  1.  I  S XBDRQUIT="" Q
  1.  S XBDRMIN=Y
  1.  S DIR("A")="Enter maximum date",DIR(0)="DO^"_XBDRMIN_"::ETS"
  1.  D ^DIR
  1.  KILL DIR
  1.  X XBDROUT
  1.  I  S XBDRQUIT="" Q
  1.  S XBDRMAX=Y
  1. DTS ;
  1.  W !!!,"Enter the %DT string using as many of the following as you wish:",!!
  1.  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"
  1.  F I=1:1 S Y=$P(X,U,I) Q:Y=""  W $P(Y,";"),"   ",$P(Y,";",2),!
  1. ADTS ;
  1.  S DIR("A")="%DT String",DIR(0)="FO"
  1.  D ^DIR
  1.  KILL DIR
  1.  X XBDROUT
  1.  I  S XBDRQUIT="" Q
  1.  I X="" S XBDRSPEC="E" Q
  1.  I X'?1.9U W *7,"  ??" G ADTS
  1.  S XBDRSPEC="E"_X
  1.  Q
  1.  ;
  1. Z ;
  1.  S DIC=1,DIC(0)="AEQ",DIC("A")="Enter FILE name: "
  1.  W !
  1.  D ^DIC
  1.  KILL DIC
  1.  I Y=-1 S XBDRQUIT="" Q
  1.  S Z=+Y,DIC="^DD("_+Y_",",DIC(0)="AEQ",DIC("A")="Enter FIELD name: "
  1.  D ^DIC
  1.  KILL DIC
  1.  I Y=-1 S XBDRQUIT="" Q
  1.  S XBDRTYPE=Z_","_+Y,XBDRRUN=5
  1.  Q
  1.  ;