File:  [Coherent Logic Development] / freem_fileman / USER / DIR3.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (5 weeks, 4 days ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

DIR3	;SFISC/DCM,RDS-READER-MAID (PROCESS RANGE/LIST);12/6/94  10:54
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	;
L	; LIST OR RANGE
	N %I,%I1,%I2,%BA,%X,%C,%1,%2,%3,%4,%
	K ^TMP($J,"DIR")
	S Y(0)="",%C=0,%I1=1,%I2=2,%BA=$S($D(DIR("S")):DIR("S"),1:"I 1")
	F %I=1:1 S %X=$P(X,",",%I) Q:%E!'$L($P(X,",",%I,999))  D
	.I %X'?.".".N.".".N."-".N.".".N S %E=4 Q
	.I $E(%X)="-" S %E=3 Q
	.I $L($P(%X,"."))>24 S %E=1 Q
	.I '%B3,$L($P(+%X,".",2)) S %E=2
	I '%E D @$S(%A["C"&'$D(DIR("S")):"LC",%A["C"&$D(DIR("S")):"LL",1:"LL")
	I '%E,Y(%C)="" S %E=4
	I $G(%E),'%N D
	.S %W=$P($T(@(%E)),";;",2)
	.I %W[";",%E=1 S %W=$P(%W,";")_+%B1_$P(%W,";",2)_" "_%B2
	.I %W[";",%E=2 S %W=$P(%W,";")_+%B3_$P(%W,";",2)_$S(%B3>1:"s",1:"")
	S Y=Y(0)
	Q
	;
LL	I %B3 D LCD
	F %I=1:1 S %X=$P(X,",",%I) Q:%E!'$L($P(X,",",%I,999))  D L0
	Q:%E
	I %A["C" D LIST
	Q
L0	N %J
	D LCK
	Q:%E  I %X?.N!(%X?1N.".".N) S %J=+%X G L1
	I %B3 D  Q
	.S %J=+%X D L1 S $P(%X,"-")=%X+%I1
	.F %J=+%X:%I1:$P(%X,"-",2) D L1
	F %J=$P(%X,"-"):1:$P(%X,"-",2) D L1
	Q
L1	I %A["C" D  Q
	.S Y=%J X %BA Q:'$T
	.S (%1,%2)=%J
	.D LC1
	I $L(Y(%C)_%J)>220 S %C=%C+1,Y(%C)=""
	F %=0:1:%C I ","_Y(%)_","[(","_%J_",") S %=-1 Q
	I %'<0 S Y=%J X %BA S:$T Y(%C)=Y(%C)_%J_","
	Q
	;
LCK	N %
	I %X["-",'%B3 D
	.I +%X<%B1 S $P(%X,"-")=%B1
	.I +%X>%B2 S $P(%X,"-")=%B2
	I +%X<%B1!(+%X>%B2) S %E=1 Q
	I %B3,$L($P(+%X,".",2))>%B3 S %E=2 Q
	I %X["-" S %=$P(%X,"-",2) D
	.I '% S %E=4 Q
	.I +%>%B2 S $P(%X,"-",2)=%B2
	.I +%<%X S %E=4 Q
	.I $L($P(+%,".",2))>%B3 S %E=2 Q
	Q
	;
LCD	;
	S %1="." I %B3>1 F %=1:1:%B3-1 S %1=%1_"0"
	S %I2=%1_2,%I1=%1_1
	Q
	;
LC	I %B3 D LCD
	F %=1:1:$L(X,",") S %1=$P(X,",",%) D LC0 Q:%E
	Q:%E
LIST	S %1="",Y(%C)="" D 
	.F  S %1=$O(^TMP($J,"DIR",%1)),%2="" Q:%1=""  D
	..S:$D(^(%1))=1 Y(%C)=Y(%C)_%1_","
	..S:$L(Y(%C))>220 %C=%C+1,Y(%C)=""
	..I $D(^(%1))=10 F  S %2=$O(^TMP($J,"DIR",%1,%2)) Q:%2=""  S Y(%C)=Y(%C)_%2_"-"_%1_","
	I Y(%C)="" S %E=4 Q
	K ^TMP($J,"DIR")
	Q
LC0	S (%2,%X)=%1 D LCK Q:%E
	I %1["-" S %1=+%1,%2=+$P(%2,"-",2)
	I %1>%2 S %3=%1,%1=%2,%2=%3
	S %1=+%1,%2=+%2
	D LC1
	Q
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
	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
	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)
	.Q:$D(^TMP($J,"DIR",%3))=1  S %4=$O(^(%3,""))
	.I %4>%1 K ^TMP($J,"DIR",%3)
	.I %4<%1 S %1=%4
	S:%1'=%2 ^TMP($J,"DIR",%2,%1)="" S:%1=%2 ^TMP($J,"DIR",%1)="" Q
	;
1	;;Response should be no less than ; and no greater than
2	;;Response must be no more than ; decimal digit
3	;;Response must be a positive number
4	;;Invalid number or range

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>