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

PRSU1A.m

Go to the documentation of this file. 
  1. PRSU1A ;WOIFO/PLT-General Questions Utility ; 24-Aug-2005 10:34 AM
  1.  ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  QUIT  ;invalid entry
  1.  ;the followoings are DIR calls for data type D,E,F,L,N,P,S,Y,#,#
  1.  ; D-date, E-end of page, F-free-text, L-list or range, N-numeric
  1.  ; P- pointer, S-set of codes, Y-yes/no, #,#- dd data dictionary
  1.  ;A for DIR("A") - prompt text.
  1.  ;B for DIR(0) 2nd character to end - input modifiers^[parameters]^[transform.]
  1.  ; modifiers     A: prompt not appended, O: response optional
  1.  ;               r: no replace-with for the defalut response
  1.  ; set of codes  B: code listed horizontally, X: exact match
  1.  ; free text     U: if '^' allowed in free text
  1.  ; list or range C: compress y array, not y-array returned
  1.  ;C for DIR("B") - default response
  1.  ;.x(1...) for DIR("A") prompt array or value returned
  1.  ;.y(1...) for DIR("?") array or value returned 
  1.  ;
  1.  ;date
  1.  ;B is ^1=A,O or "", ^2=mini date:maximum date, ^3=mumps code
  1. DT(X,Y,A,B,C) N DIR,D S DIR(0)="D"_B,DIR("A")=A S:$G(C)]"" DIR("B")=C
  1.  S DIR("?")="Enter a date",D=$P(B,U,2,3)
  1.  I $P(D,":")]"" S Y=$P(D,":") D DD^%DT S Y=$S($P(D,":",2)]"":" between ",1:" after ")_Y,DIR("?")=DIR("?")_Y
  1.  I $P(D,":",2)]"" S Y=$P(B,":",2) D DD^%DT S Y=$S($P(D,":",1)="":" before ",1:" and ")_Y,DIR("?")=DIR("?")_Y
  1.  D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S Y="^" K DTOUT,DUOUT,DIROUT
  1.  QUIT
  1.  ;
  1.  ;end of page
  1.  ;B is ^1= A or "", ^2="", ^3=""
  1. EOP(X,Y,A,B,C) N DIR S DIR(0)="E"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
  1.  S DIR("?")="Enter 'return' to continue or '^' to exit."
  1.  D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S Y="^" K DTOUT,DUOUT,DIROUT
  1.  QUIT
  1.  ;
  1.  ;free text
  1.  ;B is ^1=A,O,U, ^2=minimum legth:maximum length, ^3=mumps code
  1. FT(X,Y,A,B,C) N DIR S DIR(0)="F"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
  1.  D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S Y="^" K DTOUT,DUOUT,DIROUT
  1.  QUIT
  1.  ;
  1.  ;list of range
  1.  ;B is ^1=A,O or "", ^2=mini value:maxi value, ^3=mumps code
  1. LR(X,Y,A,B,C) N DIR S DIR(0)="L"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
  1.  D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S Y="^" K DTOUT,DUOUT,DIROUT
  1.  QUIT
  1.  ;
  1.  ;numeric
  1.  ;B is ^1=A,O or "", ^2=mini value:maxi value:maxi decimals, ^3=mumps code
  1. NUM(X,Y,A,B,C) N DIR S DIR(0)="N"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
  1.  D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S Y="^" K DTOUT,DUOUT,DIROUT
  1.  QUIT
  1.  ;
  1.  ;pointer
  1.  ;B is ^1=A,O or "", ^2=file #/subfile root:dic(0) data, ^3=mumps code
  1. PTR(X,Y,A,B,C) N DIR S DIR(0)="P"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
  1.  D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S Y="^" K DTOUT,DUOUT,DIROUT
  1.  QUIT
  1.  ;
  1.  ;set of codes
  1.  ;B is ^1=A,O,X,B, or M, ^2=code:description;code:description;..., ^3=mumps code
  1. SC(X,Y,A,B,C) N DIR S DIR(0)="S"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
  1.  D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S Y="^" K DTOUT,DUOUT,DIROUT
  1.  QUIT
  1.  ;
  1.  ;yes/no
  1.  ;B is ^1=A,O or "", ^2="", ^3=""
  1. YN(X,Y,A,B,C) N DIR S DIR(0)="Y"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
  1.  S DIR("?")="Enter 'Y' for yes, 'N' for no."
  1.  D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S Y="^" K DTOUT,DUOUT,DIROUT
  1.  QUIT
  1.  ;
  1.  ;data field definition
  1.  ;B is ^1=(sub)file number,field numberAO, ^2="", ^3=""
  1. DD(X,Y,A,B,C) N DIR S DIR(0)=B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
  1.  D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S Y="^" K DTOUT,DUOUT,DIROUT
  1.  QUIT
  1.  ;
  1. DIRA N A S A=0 F  S A=$O(X(A)) Q:A=""  S DIR("A",A)=X(A)
  1.  K X
  1.  QUIT
  1. DIRQ N A F A=1:1 Q:'$D(Y(A))  S DIR("?",A)=Y(A)
  1.  S DIR("?")=Y(A-1) K DIR("?",A-1)
  1.  K Y
  1.  QUIT
  1.  ;
  1.  ;.x user typed value
  1.  ;.y=-1 if invalid, cyymmdd.hhmmss
  1.  ;A=prompt text
  1.  ;B=^1:default value (external form), ^2=[-]fm date, [before]after date
  1.  ;C=string of AEFNPRST, any combination
  1.  ;  A for ask, E for echo
  1.  ;  F for future assumed, N for pure num not allowed
  1.  ;  P for past assumed, R time required
  1.  ;  S seconds required, T time is optional
  1.  ;D= Y if year only, YM if year and month only, YMD if date[@time] only
  1. YMDT(X,Y,A,B,C,D) ;reader for year/month/date/time
  1.  N %DT,DTOUT
  1. YMDT1 S %DT("A")=A,%DT("B")=$P(B,"^") S:$P(B,"^",2)]"" %DT(0)=$P(B,"^",2)
  1.  S %DT=C S:$G(D)="YMD" %DT=%DT_"X"
  1.  D ^%DT
  1.  I Y'=-1,$G(D)="Y",Y#10000'=0 W "   Enter year only!" G YMDT1
  1.  I Y'=-1,$G(D)="YM",Y#100'=0 W "   Enter month and year only!" G YMDT1
  1.  QUIT