DICATTD4 ;GFT/GFT - FREE TEXT FIELDS;8JAN2013
;;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.
;
;
PRE4 ;PATTERN MATCH -- EXECUTABLE DEFAULT of Field 70
N I,Z,X,L,YY
S DICATT5P=" X",YY=0,I=0,L=1,Y="",Z=$P(DICATT5,")!'(",2,99) Q:Z=""
L S I=I+1,X=$E(Z,I) G L:X'?.P Q:X="" I X="""" S YY='YY G L
G L:YY I X="(" S L=L+1
G L:X'=")" S L=L-1 G L:L
S Y=$E(Z,1,I-1),DICATT5P=$E(Z,I+1,999) Q ;Y is default pattern-match
;
POST4 ;check FREE TEXT
N L,A1,A2 S L=$$G(69) Q:L="" ;get MAXIMUM LENGTH
D:'$D(DICATT5P) PRE4 ;DICATT5P may be UNDEFINED
E S A1=$P($P(DICATT4,";",2),"E",2) I A1 S A2=$P(A1,",",2) I A2,A2-A1+1<L S DDSERROR=1,DDSBR="69^DICATT4^2.4" D HLP^DDSUTL(" DATA IS STORED AS $E"_A1) Q
I DICATT2["X" D S L=L_"X" G FJ ;EDIT LENGTH, EVEN IF NOTHING ELSE
.S DICATTMN=$$GET^DDSVALF(98,"DICATT",1),Y="MAXIMUM LENGTH: " I DICATTMN=""!$P(DICATTMN,Y,2) S DICATTMN=Y_L D PUT^DDSVALF(98,"DICATT",1,DICATTMN)
S Y=$$G(68) Q:Y=""
I L<Y S DDSERROR=1,DDSBR="68^DICATT4^2.4" D HLP^DDSUTL("'MINIMUM' & 'MAXIMUM' ARE IN WRONG ORDER") Q
S X=$S(L=Y:L,1:Y_"-"_L),DICATTMN="Answer must be "_X_" character"_$E("s",X'=1)_" in length."
S X=$$G(70) I X]"" S X="!'("_X_")"
S DICATT5N="K:$L(X)>"_L_"!($L(X)<"_Y_")"_X_DICATT5P
D CHNG^DICATTD
FJ S DICATTLN=+L,DICATT2N="FJ"_L,DICATT3N=""
Q
;
G(I) N X Q $$GET^DDSVALF(I,"DICATT4",2.4)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICATTD4 1619 printed Sep 23, 2025@20:21:47 Page 2
DICATTD4 ;GFT/GFT - FREE TEXT FIELDS;8JAN2013
+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 ;
+7 ;
PRE4 ;PATTERN MATCH -- EXECUTABLE DEFAULT of Field 70
+1 NEW I,Z,X,L,YY
+2 SET DICATT5P=" X"
SET YY=0
SET I=0
SET L=1
SET Y=""
SET Z=$PIECE(DICATT5,")!'(",2,99)
if Z=""
QUIT
L SET I=I+1
SET X=$EXTRACT(Z,I)
if X'?.P
GOTO L
if X=""
QUIT
IF X=""""
SET YY='YY
GOTO L
+1 if YY
GOTO L
IF X="("
SET L=L+1
+2 if X'=")"
GOTO L
SET L=L-1
if L
GOTO L
+3 ;Y is default pattern-match
SET Y=$EXTRACT(Z,1,I-1)
SET DICATT5P=$EXTRACT(Z,I+1,999)
QUIT
+4 ;
POST4 ;check FREE TEXT
+1 ;get MAXIMUM LENGTH
NEW L,A1,A2
SET L=$$G(69)
if L=""
QUIT
+2 ;DICATT5P may be UNDEFINED
if '$DATA(DICATT5P)
DO PRE4
E SET A1=$PIECE($PIECE(DICATT4,";",2),"E",2)
IF A1
SET A2=$PIECE(A1,",",2)
IF A2
IF A2-A1+1<L
SET DDSERROR=1
SET DDSBR="69^DICATT4^2.4"
DO HLP^DDSUTL(" DATA IS STORED AS $E"_A1)
QUIT
+1 ;EDIT LENGTH, EVEN IF NOTHING ELSE
IF DICATT2["X"
Begin DoDot:1
+2 SET DICATTMN=$$GET^DDSVALF(98,"DICATT",1)
SET Y="MAXIMUM LENGTH: "
IF DICATTMN=""!$PIECE(DICATTMN,Y,2)
SET DICATTMN=Y_L
DO PUT^DDSVALF(98,"DICATT",1,DICATTMN)
End DoDot:1
SET L=L_"X"
GOTO FJ
+3 SET Y=$$G(68)
if Y=""
QUIT
+4 IF L<Y
SET DDSERROR=1
SET DDSBR="68^DICATT4^2.4"
DO HLP^DDSUTL("'MINIMUM' & 'MAXIMUM' ARE IN WRONG ORDER")
QUIT
+5 SET X=$SELECT(L=Y:L,1:Y_"-"_L)
SET DICATTMN="Answer must be "_X_" character"_$EXTRACT("s",X'=1)_" in length."
+6 SET X=$$G(70)
IF X]""
SET X="!'("_X_")"
+7 SET DICATT5N="K:$L(X)>"_L_"!($L(X)<"_Y_")"_X_DICATT5P
+8 DO CHNG^DICATTD
FJ SET DICATTLN=+L
SET DICATT2N="FJ"_L
SET DICATT3N=""
+1 QUIT
+2 ;
G(I) NEW X
QUIT $$GET^DDSVALF(I,"DICATT4",2.4)
