source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRC0A.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1PRC0A ;WISC/PLT-General Questions Utility ; 24-Aug-1994 10:34 AM
2V ;;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
18DT(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=""
27EOP(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
34FT(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
40LR(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
46NUM(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
52PTR(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
58SC(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=""
64YN(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=""
71DD(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 ;
75DIRA N A S A=0 F S A=$O(X(A)) Q:A="" S DIR("A",A)=X(A)
76 K X
77 QUIT
78DIRQ 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
90YMDT(X,Y,A,B,C,D) ;reader for year/month/date/time
91 N %DT,DTOUT
92YMDT1 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
Note: See TracBrowser for help on using the repository browser.