Return to DIR3.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIR3	;SFISC/DCM,RDS-READER-MAID (PROCESS RANGE/LIST);12/6/94  10:54
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: L	; LIST OR RANGE
    6: 	N %I,%I1,%I2,%BA,%X,%C,%1,%2,%3,%4,%
    7: 	K ^TMP($J,"DIR")
    8: 	S Y(0)="",%C=0,%I1=1,%I2=2,%BA=$S($D(DIR("S")):DIR("S"),1:"I 1")
    9: 	F %I=1:1 S %X=$P(X,",",%I) Q:%E!'$L($P(X,",",%I,999))  D
   10: 	.I %X'?.".".N.".".N."-".N.".".N S %E=4 Q
   11: 	.I $E(%X)="-" S %E=3 Q
   12: 	.I $L($P(%X,"."))>24 S %E=1 Q
   13: 	.I '%B3,$L($P(+%X,".",2)) S %E=2
   14: 	I '%E D @$S(%A["C"&'$D(DIR("S")):"LC",%A["C"&$D(DIR("S")):"LL",1:"LL")
   15: 	I '%E,Y(%C)="" S %E=4
   16: 	I $G(%E),'%N D
   17: 	.S %W=$P($T(@(%E)),";;",2)
   18: 	.I %W[";",%E=1 S %W=$P(%W,";")_+%B1_$P(%W,";",2)_" "_%B2
   19: 	.I %W[";",%E=2 S %W=$P(%W,";")_+%B3_$P(%W,";",2)_$S(%B3>1:"s",1:"")
   20: 	S Y=Y(0)
   21: 	Q
   22: 	;
   23: LL	I %B3 D LCD
   24: 	F %I=1:1 S %X=$P(X,",",%I) Q:%E!'$L($P(X,",",%I,999))  D L0
   25: 	Q:%E
   26: 	I %A["C" D LIST
   27: 	Q
   28: L0	N %J
   29: 	D LCK
   30: 	Q:%E  I %X?.N!(%X?1N.".".N) S %J=+%X G L1
   31: 	I %B3 D  Q
   32: 	.S %J=+%X D L1 S $P(%X,"-")=%X+%I1
   33: 	.F %J=+%X:%I1:$P(%X,"-",2) D L1
   34: 	F %J=$P(%X,"-"):1:$P(%X,"-",2) D L1
   35: 	Q
   36: L1	I %A["C" D  Q
   37: 	.S Y=%J X %BA Q:'$T
   38: 	.S (%1,%2)=%J
   39: 	.D LC1
   40: 	I $L(Y(%C)_%J)>220 S %C=%C+1,Y(%C)=""
   41: 	F %=0:1:%C I ","_Y(%)_","[(","_%J_",") S %=-1 Q
   42: 	I %'<0 S Y=%J X %BA S:$T Y(%C)=Y(%C)_%J_","
   43: 	Q
   44: 	;
   45: LCK	N %
   46: 	I %X["-",'%B3 D
   47: 	.I +%X<%B1 S $P(%X,"-")=%B1
   48: 	.I +%X>%B2 S $P(%X,"-")=%B2
   49: 	I +%X<%B1!(+%X>%B2) S %E=1 Q
   50: 	I %B3,$L($P(+%X,".",2))>%B3 S %E=2 Q
   51: 	I %X["-" S %=$P(%X,"-",2) D
   52: 	.I '% S %E=4 Q
   53: 	.I +%>%B2 S $P(%X,"-",2)=%B2
   54: 	.I +%<%X S %E=4 Q
   55: 	.I $L($P(+%,".",2))>%B3 S %E=2 Q
   56: 	Q
   57: 	;
   58: LCD	;
   59: 	S %1="." I %B3>1 F %=1:1:%B3-1 S %1=%1_"0"
   60: 	S %I2=%1_2,%I1=%1_1
   61: 	Q
   62: 	;
   63: LC	I %B3 D LCD
   64: 	F %=1:1:$L(X,",") S %1=$P(X,",",%) D LC0 Q:%E
   65: 	Q:%E
   66: LIST	S %1="",Y(%C)="" D 
   67: 	.F  S %1=$O(^TMP($J,"DIR",%1)),%2="" Q:%1=""  D
   68: 	..S:$D(^(%1))=1 Y(%C)=Y(%C)_%1_","
   69: 	..S:$L(Y(%C))>220 %C=%C+1,Y(%C)=""
   70: 	..I $D(^(%1))=10 F  S %2=$O(^TMP($J,"DIR",%1,%2)) Q:%2=""  S Y(%C)=Y(%C)_%2_"-"_%1_","
   71: 	I Y(%C)="" S %E=4 Q
   72: 	K ^TMP($J,"DIR")
   73: 	Q
   74: LC0	S (%2,%X)=%1 D LCK Q:%E
   75: 	I %1["-" S %1=+%1,%2=+$P(%2,"-",2)
   76: 	I %1>%2 S %3=%1,%1=%2,%2=%3
   77: 	S %1=+%1,%2=+%2
   78: 	D LC1
   79: 	Q
   80: LC1	S %3=$O(^TMP($J,"DIR",%1-%I2)) I %3]"",%3<%2 S:$D(^(%3))=1&(%1-%I1=%3) %1=%3 I $D(^(%3))>9 S %4=$O(^(%3,"")) I %4<%1 S %1=%4
   81: 	S %3=$O(^TMP($J,"DIR",%2-$S(%B3:%I1,1:1))) I %3]"" S:$D(^(%3))=1&(%2+%I1=%3) %2=%3 I $D(^(%3))>9 S %4=$O(^(%3,"")) I %4'>(%2+%I1) S %2=%3
   82: 	S %3=%1-%I1 F  S %3=$O(^TMP($J,"DIR",%3)) Q:%3=""!(%3>%2)  D:%3=%2  Q:%3=%2  K ^TMP($J,"DIR",%3)
   83: 	.Q:$D(^TMP($J,"DIR",%3))=1  S %4=$O(^(%3,""))
   84: 	.I %4>%1 K ^TMP($J,"DIR",%3)
   85: 	.I %4<%1 S %1=%4
   86: 	S:%1'=%2 ^TMP($J,"DIR",%2,%1)="" S:%1=%2 ^TMP($J,"DIR",%1)="" Q
   87: 	;
   88: 1	;;Response should be no less than ; and no greater than
   89: 2	;;Response must be no more than ; decimal digit
   90: 3	;;Response must be a positive number
   91: 4	;;Invalid number or range