[613] | 1 | PRC0A ;WISC/PLT-General Questions Utility ; 24-Aug-1994 10:34 AM
|
---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | QUIT ;invalid entry
|
---|
| 5 | ;the following are for DIR call for data type D,E,F,L,N,P,S,Y,#
|
---|
| 6 | ;A for DIR("A") - prompt text.
|
---|
| 7 | ;B for DIR(0) without 1st characters - input modifiers^parameters^transform.
|
---|
| 8 | ; modifiers A: prompt not append, O:response optional
|
---|
| 9 | ; set of codes X: exact match, B: code listed horizontally
|
---|
| 10 | ; M: mix case match without X
|
---|
| 11 | ; free text U: if '^' allowed in free text
|
---|
| 12 | ;C for DIR("B") - default response
|
---|
| 13 | ;.x(1...) for DIR("A") propmt array or value returned
|
---|
| 14 | ;.y(1...) for DIR("?") array or value returned
|
---|
| 15 | ;
|
---|
| 16 | ;date
|
---|
| 17 | ;B is ^1=A, O or "", ^2=mini date:maximum date, ^3=mumps code
|
---|
| 18 | DT(X,Y,A,B,C) N DIR,D S DIR(0)="D"_B,DIR("A")=A S:$G(C)]"" DIR("B")=C
|
---|
| 19 | S DIR("?")="Enter a date",D=$P(B,U,2,3)
|
---|
| 20 | I $P(D,":")]"" S Y=$P(D,":") D DD^%DT S Y=$S($P(D,":",2)]"":" between ",1:" after ")_Y,DIR("?")=DIR("?")_Y
|
---|
| 21 | 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
|
---|
| 22 | D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR
|
---|
| 23 | QUIT
|
---|
| 24 | ;
|
---|
| 25 | ;end of page
|
---|
| 26 | ;B is ^1= A OR "", ^2="", ^3=""
|
---|
| 27 | EOP(X,Y,A,B,C) N DIR S DIR(0)="E"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
|
---|
| 28 | S DIR("?")="Enter 'return' to continue or '^' to exit."
|
---|
| 29 | D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR
|
---|
| 30 | QUIT
|
---|
| 31 | ;
|
---|
| 32 | ;free text
|
---|
| 33 | ;B is ^1=A, O or U, ^2=minimum legth:maximum length, ^3=mumps code
|
---|
| 34 | FT(X,Y,A,B,C) N DIR S DIR(0)="F"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
|
---|
| 35 | D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR
|
---|
| 36 | QUIT
|
---|
| 37 | ;
|
---|
| 38 | ;list of range
|
---|
| 39 | ;B is ^1=A, O or "", ^2=mini value:maxi value, ^3=mumps code
|
---|
| 40 | LR(X,Y,A,B,C) N DIR S DIR(0)="L"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
|
---|
| 41 | D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR
|
---|
| 42 | QUIT
|
---|
| 43 | ;
|
---|
| 44 | ;numeric
|
---|
| 45 | ;B is ^1=A, O or "", ^2=mini value:maxi value:maxi decimals, ^3=mumps code
|
---|
| 46 | NUM(X,Y,A,B,C) N DIR S DIR(0)="N"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
|
---|
| 47 | D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR
|
---|
| 48 | QUIT
|
---|
| 49 | ;
|
---|
| 50 | ;pointer
|
---|
| 51 | ;B is ^1=A, O or "", ^2=file #/subfile root:dic(0) data, ^3=mumps code
|
---|
| 52 | PTR(X,Y,A,B,C) N DIR S DIR(0)="P"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
|
---|
| 53 | D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR
|
---|
| 54 | QUIT
|
---|
| 55 | ;
|
---|
| 56 | ;set of codes
|
---|
| 57 | ;B is ^1=A,O,X,B, or M, ^2=code:description;code:description;..., ^3=mumps code
|
---|
| 58 | SC(X,Y,A,B,C) N DIR S DIR(0)="S"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
|
---|
| 59 | D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR
|
---|
| 60 | QUIT
|
---|
| 61 | ;
|
---|
| 62 | ;yes/no
|
---|
| 63 | ;B is ^1=A, O or "", ^2"", ^3=""
|
---|
| 64 | YN(X,Y,A,B,C) N DIR S DIR(0)="Y"_B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
|
---|
| 65 | S DIR("?")="Enter 'Y' for yes, 'N' for no."
|
---|
| 66 | D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR
|
---|
| 67 | QUIT
|
---|
| 68 | ;
|
---|
| 69 | ;data field definition
|
---|
| 70 | ;B is ^1=(sub)file number,field numberAO, ^2="", ^3=""
|
---|
| 71 | DD(X,Y,A,B,C) N DIR S DIR(0)=B S:A]"" DIR("A")=A S:$G(C)]"" DIR("B")=C
|
---|
| 72 | D DIRA:$D(X(1)),DIRQ:$D(Y(1)),^DIR
|
---|
| 73 | QUIT
|
---|
| 74 | ;
|
---|
| 75 | DIRA N A S A=0 F S A=$O(X(A)) Q:A="" S DIR("A",A)=X(A)
|
---|
| 76 | K X
|
---|
| 77 | QUIT
|
---|
| 78 | DIRQ N A F A=1:1 Q:'$D(Y(A)) S DIR("?",A)=Y(A)
|
---|
| 79 | S DIR("?")=Y(A-1) K DIR("?",A-1)
|
---|
| 80 | K Y
|
---|
| 81 | QUIT
|
---|
| 82 | ;
|
---|
| 83 | ;.x user typed value, .y=-1 if invalid, yymmdd.hhmmss
|
---|
| 84 | ;A=prompt text, B=^1:fault value (external form), ^2=[-]fm date
|
---|
| 85 | ;C=string of AEFNPRST, any combination
|
---|
| 86 | ; A for ask, E for echo, F for future assum, N for pure num not allowed
|
---|
| 87 | ; P for past assum, R time required, S seconds required
|
---|
| 88 | ; T time is optional
|
---|
| 89 | ;D= Y if year only, YM if year and month only, YMD if date[@time] only
|
---|
| 90 | YMDT(X,Y,A,B,C,D) ;reader for year/month/date/time
|
---|
| 91 | N %DT,DTOUT
|
---|
| 92 | YMDT1 S %DT("A")=A,%DT("B")=$P(B,"^") S:$P(B,"^",2)]"" %DT(0)=$P(B,"^",2)
|
---|
| 93 | S %DT=C S:$G(D)="YMD" %DT=%DT_"X"
|
---|
| 94 | D ^%DT
|
---|
| 95 | I Y'=-1,$G(D)="Y",Y#10000'=0 W " Enter year only!" G YMDT1
|
---|
| 96 | I Y'=-1,$G(D)="YM",Y#100'=0 W " Enter month and year only!" G YMDT1
|
---|
| 97 | QUIT
|
---|