source: FOIAVistA/trunk/r/LIBRARY-LBR-LBRS/LBRYET1.m@ 1452

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1LBRYET1 ;ISC2/DJM-INPUT TRANSFORMS FOR 680.9 FILE ;[ 09/02/94 10:20 AM ]
2 ;;2.5;Library;;Mar 11, 1996
3 ;INPUT TRANSFORM FOR MONTH FIELD
4 I $E(X)'="," S X=","_X
5E2 K:$P(X,",",14)]""!($L(X)>28) X Q:'$D(X)
6 F I=2:1 S X2=$P(X,",",I) G:X2="" ORDER K:X2'=+X2!(X2<1)!(X2>12)!(X2?.E1"."1N.N) X Q:'$D(X)
7 Q
8EN1 ;INPUT TRANSFORM FOR VOLUME INCREMENT, ISSUE CHANGE AND ISSUE INCREMENT FIELDS
9 G:$E(X,1)="+" E3 K:+X'=X!(X<1)!(X>99999)!(X?.E1"."1N.N) X Q
10E3 S X2=$E(X,2,99) K:X2'=+X2!(X2<1)!(X2>9999)!(X2?.E1"."1N.N) X Q
11EN2 ;INPUT TRANSFORM FOR CHANGE MONTH FIELD
12 I $E(X)'="," S X=","_X
13 G E2
14EN3 ;INPUT TRANSFORM FOR WEEK-OF-MONTH/DAY-OF-WEEK (WOM/DOW) FIELD
15 I $E(X)'="," S X=","_X
16E5 K:$P(X,",",33)]""!($L(X)<5)!($L(X)>125) X Q:'$D(X)
17 F I=2:1 S XP=$P(X,",",I) G:XP="" ORDER K:XP'?1N1"/"1N X Q:'$D(X) S X1=$P(XP,"/",1),X2=$P(XP,"/",2) K:X1<1!(X1>5)!(X2<0)!(X2>6) X Q:'$D(X)
18 Q
19EN5 ;INPUT TRANSFORM FOR DAY-OF-MONTH FIELD
20 I $E(X)'="," S X=","_X
21E8 K:$P(X,",",33)]""!($L(X)<1)!($L(X)>85) X Q:'$D(X)
22 F I=2:1 S X2=$P(X,",",I) G:X2="" ORDER K:X2'=+X2!(X2<1)!(X2>31)!(X2?.E1"."1N.N) X Q:'$D(X)
23 Q
24EN6 ;HELP PROMPT FOR WOM/DOW FIELD
25 W !!,"If the pattern states that copies will have a date based on a week"
26 W !,"of the month and a day of the week enter separate entries for each"
27 W !,"combination separated with a ',' between entries. Each entry will"
28 W !,"consist of two parts. The first part will be the week-of-the-month from"
29 W !,"1 to 5. The second part will be the day-of the-week from 0 for Sunday"
30 W !,"to 6 for Saturday. The two parts will be separated with a '/'."
31 W !!,"For example the pattern states that copies will arrive on the"
32 W !,"1st and 3rd Fridays of the month. This should be expanded and entered as"
33 W !,"week 1-Friday = 1/5 and week 3-Friday = 3/5 so the complete"
34 W !,"entry would be '1/5,3/5'.",!!
35 Q
36ORDER K LBX S C="," F I=2:1 S X1=$P(X,C,I) G:X1="" S2 S LBX(X1)=""
37S2 S LBY=0,XZ="" F S LBY=$O(LBX(LBY)) G:LBY="" S3 S XZ=XZ_C_LBY
38S3 S X=XZ_C Q
Note: See TracBrowser for help on using the repository browser.