DIR3 ;SFISC/DCM,RDS-READER-MAID (PROCESS RANGE/LIST) ;3MAY2010
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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
EGP .N I S %W=$P($T(@(%E)),";;",3) ;**CCO/NI thru next 3 lines GET ERROR MESSAGE
.I %E=1 S I(1)=+%B1,I(2)=%B2
.I %E=2 S I(1)=+%B3
.S %W=$$EZBLD^DIALOG(%W,.I)
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;;212;;**CCO/NI thru 4 ERROR MESSAGES
2 ;;Response must be no more than ; decimal digit;;211
3 ;;Response must be a positive number;;210
4 ;;Invalid number or range;;208
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIR3 3883 printed Dec 13, 2024@02:53:55 Page 2
DIR3 ;SFISC/DCM,RDS-READER-MAID (PROCESS RANGE/LIST) ;3MAY2010
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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
EGP ;**CCO/NI thru next 3 lines GET ERROR MESSAGE
NEW I
SET %W=$PIECE($TEXT(@(%E)),";;",3)
+1 IF %E=1
SET I(1)=+%B1
SET I(2)=%B2
+2 IF %E=2
SET I(1)=+%B3
+3 SET %W=$$EZBLD^DIALOG(%W,.I)
End DoDot:1
+4 ; Prevent Erroneous Data
IF $GET(%E)
KILL Y
SET Y=""
QUIT
+5 SET Y=Y(0)
+6 QUIT
+7 ;
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;;212;;**CCO/NI thru 4 ERROR MESSAGES
2 ;;Response must be no more than ; decimal digit;;211
3 ;;Response must be a positive number;;210
4 ;;Invalid number or range;;208
