- DIR3 ;SFISC/DCM,RDS-READER-MAID (PROCESS RANGE/LIST) ;6/28/2009
- ;;22.0;VA FileMan;**30,164**;Mar 30, 1999;Build 21
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;12364;2913754;3396;
- ;
- 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:"")
- I $G(%E) K Y S Y="" Q ; Prevent Erroneous Data
- S Y=Y(0)
- Q
- ;
- LL ; handle uncompressed lists & screened compressed lists
- 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
- ;
- ; check one list element
- ;%A = $P#1 "^" of DIR(0)
- ;%B = $P#2 "^" of DIR(0)
- ;%B1 = $P#1 ":" Low Value
- ;%B2 = $P#2 ":" High Value
- ;%B3 = $P#3 ":" Number of Decimals; Null If Undefined
- ;%X = Range Entered, i.e. 2-4
- ;% = End of Range Entered i.e. 4
- LCK I %X["-" D Q
- . N % S %=$P(%X,"-",2) I '% S %E=4 Q
- . I %A'["I",%<+%X S %E=4 Q
- . I %A["I",%<+%X N %3 S %3=%,%=+%X,$P(%X,"-",2)=%,$P(%X,"-")=%3
- . I %<%B1!(+%X>%B2) S %E=1 Q
- . I +%X<%B1 S %E=1 Q
- . I +%>%B2 S %E=1 Q
- . I $L($P(+%X,".",2))>%B3!($L($P(+%,".",2))>%B3) S %E=2 Q
- I +%X<%B1!(+%X>%B2) S %E=1 Q
- I %B3,$L($P(+%X,".",2))>%B3 S %E=2 Q
- Q
- ;
- LCD ; determine increment size for ranges (handle decimals)
- S %1="." I %B3>1 F %=1:1:%B3-1 S %1=%1_"0"
- S %I2=%1_2,%I1=%1_1
- Q
- ;
- LC ; handle unscreened compressed lists (no DIR("S"))
- ; LC to LIST checks the user's list in X, building ^TMP($J,"DIR")
- I %B3 D LCD
- F %=1:1:$L(X,",") S %1=$P(X,",",%) D LC0 Q:%E
- Q:'$D(^TMP($J,"DIR"))
- LIST ; transfer output list from ^TMP($J,"DIR") to Y
- S %1="",Y(%C)="" D
- . F S %1=$O(^TMP($J,"DIR",%1)) 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 S Y(%C)=Y(%C)_$O(^TMP($J,"DIR",%1,""))_"-"_%1_","
- I Y(%C)="" D Q:%E
- . I %C=0 S %E=4
- . E K Y(%C) S %C=%C-1
- K ^TMP($J,"DIR")
- Q
- LC0 ; check one list element, calls LC1 to put it in ^TMP($J,"DIR")
- S %E=0,%X=%1 D LCK Q:%E S (%1,%2)=%X
- I %1["-" S %1=+%1,%2=+$P(%2,"-",2)
- S %1=+%1,%2=+%2
- D LC1
- Q
- LC1 ; modify ^TMP($J,"DIR") to incorporate a list element, handle overlap
- S %3=$O(^TMP($J,"DIR",%1-%I2)) I %3]"",%3<%2 D
- . I $D(^(%3))=1,%1-%I1=%3 S %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]"" D
- . I $D(^(%3))=1,%2+%I1=%3 S %2=%3
- . I $D(^(%3))>9 S %4=$O(^(%3,"")) S:%4'>(%2+%I1) %2=%3 S:%4<%1 %1=%4
- S %3=%1-%I1 F S %3=$O(^TMP($J,"DIR",%3)) Q:%3=""!(%3>%2) K ^(%3)
- I %1'=%2 S ^TMP($J,"DIR",%2,%1)=""
- E S ^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
- DIR3 ;SFISC/DCM,RDS-READER-MAID (PROCESS RANGE/LIST) ;6/28/2009
- +1 ;;22.0;VA FileMan;**30,164**;Mar 30, 1999;Build 21
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;12364;2913754;3396;
- +4 ;
- L ; LIST OR RANGE
- +1 NEW %I,%I1,%I2,%BA,%X,%C,%1,%2,%3,%4,%
- +2 KILL ^TMP($JOB,"DIR")
- +3 SET Y(0)=""
- SET %C=0
- SET %I1=1
- SET %I2=2
- SET %BA=$SELECT($DATA(DIR("S")):DIR("S"),1:"I 1")
- +4 FOR %I=1:1
- SET %X=$PIECE(X,",",%I)
- IF %E!'$LENGTH($PIECE(X,",",%I,999))
- QUIT
- Begin DoDot:1
- +5 IF %X'?.".".N.".".N."-".N.".".N
- SET %E=4
- QUIT
- +6 IF $EXTRACT(%X)="-"
- SET %E=3
- QUIT
- +7 IF $LENGTH($PIECE(%X,"."))>24
- SET %E=1
- QUIT
- +8 IF '%B3
- IF $LENGTH($PIECE(+%X,".",2))
- SET %E=2
- End DoDot:1
- +9 IF '%E
- DO @$SELECT(%A["C"&'$DATA(DIR("S")):"LC",%A["C"&$DATA(DIR("S")):"LL",1:"LL")
- +10 IF '%E
- IF Y(%C)=""
- SET %E=4
- +11 IF $GET(%E)
- IF '%N
- Begin DoDot:1
- +12 SET %W=$PIECE($TEXT(@(%E)),";;",2)
- +13 IF %W[";"
- IF %E=1
- SET %W=$PIECE(%W,";")_+%B1_$PIECE(%W,";",2)_" "_%B2
- +14 IF %W[";"
- IF %E=2
- SET %W=$PIECE(%W,";")_+%B3_$PIECE(%W,";",2)_$SELECT(%B3>1:"s",1:"")
- End DoDot:1
- +15 ; Prevent Erroneous Data
- IF $GET(%E)
- KILL Y
- SET Y=""
- QUIT
- +16 SET Y=Y(0)
- +17 QUIT
- +18 ;
- LL ; handle uncompressed lists & screened compressed lists
- +1 IF %B3
- DO LCD
- +2 FOR %I=1:1
- SET %X=$PIECE(X,",",%I)
- IF %E!'$LENGTH($PIECE(X,",",%I,999))
- QUIT
- DO L0
- +3 IF %E
- QUIT
- +4 IF %A["C"
- DO LIST
- +5 QUIT
- L0 NEW %J
- +1 DO LCK
- +2 IF %E
- QUIT
- IF %X?.N!(%X?1N.".".N)
- SET %J=+%X
- GOTO L1
- +3 IF %B3
- Begin DoDot:1
- +4 SET %J=+%X
- DO L1
- SET $PIECE(%X,"-")=%X+%I1
- +5 FOR %J=+%X:%I1:$PIECE(%X,"-",2)
- DO L1
- End DoDot:1
- QUIT
- +6 FOR %J=$PIECE(%X,"-"):1:$PIECE(%X,"-",2)
- DO L1
- +7 QUIT
- L1 IF %A["C"
- Begin DoDot:1
- +1 SET Y=%J
- XECUTE %BA
- IF '$TEST
- QUIT
- +2 SET (%1,%2)=%J
- +3 DO LC1
- End DoDot:1
- QUIT
- +4 IF $LENGTH(Y(%C)_%J)>220
- SET %C=%C+1
- SET Y(%C)=""
- +5 FOR %=0:1:%C
- IF ","_Y(%)_","[(","_%J_",")
- SET %=-1
- QUIT
- +6 IF %'<0
- SET Y=%J
- XECUTE %BA
- IF $TEST
- SET Y(%C)=Y(%C)_%J_","
- +7 QUIT
- +8 ;
- +9 ; check one list element
- +10 ;%A = $P#1 "^" of DIR(0)
- +11 ;%B = $P#2 "^" of DIR(0)
- +12 ;%B1 = $P#1 ":" Low Value
- +13 ;%B2 = $P#2 ":" High Value
- +14 ;%B3 = $P#3 ":" Number of Decimals; Null If Undefined
- +15 ;%X = Range Entered, i.e. 2-4
- +16 ;% = End of Range Entered i.e. 4
- LCK IF %X["-"
- Begin DoDot:1
- +1 NEW %
- SET %=$PIECE(%X,"-",2)
- IF '%
- SET %E=4
- QUIT
- +2 IF %A'["I"
- IF %<+%X
- SET %E=4
- QUIT
- +3 IF %A["I"
- IF %<+%X
- NEW %3
- SET %3=%
- SET %=+%X
- SET $PIECE(%X,"-",2)=%
- SET $PIECE(%X,"-")=%3
- +4 IF %<%B1!(+%X>%B2)
- SET %E=1
- QUIT
- +5 IF +%X<%B1
- SET %E=1
- QUIT
- +6 IF +%>%B2
- SET %E=1
- QUIT
- +7 IF $LENGTH($PIECE(+%X,".",2))>%B3!($LENGTH($PIECE(+%,".",2))>%B3)
- SET %E=2
- QUIT
- End DoDot:1
- QUIT
- +8 IF +%X<%B1!(+%X>%B2)
- SET %E=1
- QUIT
- +9 IF %B3
- IF $LENGTH($PIECE(+%X,".",2))>%B3
- SET %E=2
- QUIT
- +10 QUIT
- +11 ;
- LCD ; determine increment size for ranges (handle decimals)
- +1 SET %1="."
- IF %B3>1
- FOR %=1:1:%B3-1
- SET %1=%1_"0"
- +2 SET %I2=%1_2
- SET %I1=%1_1
- +3 QUIT
- +4 ;
- LC ; handle unscreened compressed lists (no DIR("S"))
- +1 ; LC to LIST checks the user's list in X, building ^TMP($J,"DIR")
- +2 IF %B3
- DO LCD
- +3 FOR %=1:1:$LENGTH(X,",")
- SET %1=$PIECE(X,",",%)
- DO LC0
- IF %E
- QUIT
- +4 IF '$DATA(^TMP($JOB,"DIR"))
- QUIT
- LIST ; transfer output list from ^TMP($J,"DIR") to Y
- +1 SET %1=""
- SET Y(%C)=""
- Begin DoDot:1
- +2 FOR
- SET %1=$ORDER(^TMP($JOB,"DIR",%1))
- IF %1=""
- QUIT
- Begin DoDot:2
- +3 IF $DATA(^(%1))=1
- SET Y(%C)=Y(%C)_%1_","
- +4 IF $LENGTH(Y(%C))>220
- SET %C=%C+1
- SET Y(%C)=""
- +5 IF $DATA(^(%1))=10
- SET Y(%C)=Y(%C)_$ORDER(^TMP($JOB,"DIR",%1,""))_"-"_%1_","
- End DoDot:2
- End DoDot:1
- +6 IF Y(%C)=""
- Begin DoDot:1
- +7 IF %C=0
- SET %E=4
- +8 IF '$TEST
- KILL Y(%C)
- SET %C=%C-1
- End DoDot:1
- IF %E
- QUIT
- +9 KILL ^TMP($JOB,"DIR")
- +10 QUIT
- LC0 ; check one list element, calls LC1 to put it in ^TMP($J,"DIR")
- +1 SET %E=0
- SET %X=%1
- DO LCK
- IF %E
- QUIT
- SET (%1,%2)=%X
- +2 IF %1["-"
- SET %1=+%1
- SET %2=+$PIECE(%2,"-",2)
- +3 SET %1=+%1
- SET %2=+%2
- +4 DO LC1
- +5 QUIT
- LC1 ; modify ^TMP($J,"DIR") to incorporate a list element, handle overlap
- +1 SET %3=$ORDER(^TMP($JOB,"DIR",%1-%I2))
- IF %3]""
- IF %3<%2
- Begin DoDot:1
- +2 IF $DATA(^(%3))=1
- IF %1-%I1=%3
- SET %1=%3
- +3 IF $DATA(^(%3))>9
- SET %4=$ORDER(^(%3,""))
- IF %4<%1
- SET %1=%4
- End DoDot:1
- +4 SET %3=$ORDER(^TMP($JOB,"DIR",%2-$SELECT(%B3:%I1,1:1)))
- IF %3]""
- Begin DoDot:1
- +5 IF $DATA(^(%3))=1
- IF %2+%I1=%3
- SET %2=%3
- +6 IF $DATA(^(%3))>9
- SET %4=$ORDER(^(%3,""))
- IF %4'>(%2+%I1)
- SET %2=%3
- IF %4<%1
- SET %1=%4
- End DoDot:1
- +7 SET %3=%1-%I1
- FOR
- SET %3=$ORDER(^TMP($JOB,"DIR",%3))
- IF %3=""!(%3>%2)
- QUIT
- KILL ^(%3)
- +8 IF %1'=%2
- SET ^TMP($JOB,"DIR",%2,%1)=""
- +9 IF '$TEST
- SET ^TMP($JOB,"DIR",%1)=""
- +10 QUIT
- +11 ;
- 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
