1 | DICATTD3 ;GFT;09:06 AM 21 Jan 1999;SET OF CODES
|
---|
2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | Y(ORDER,CM) ;
|
---|
6 | S Y=$P($P(DICATT3,";",ORDER),":",CM) Q
|
---|
7 | C ;
|
---|
8 | N C
|
---|
9 | F C=":",";","=","""" I X[C D HLP^DDSUTL("SORRY -- '"_C_"' NOT ALLOWED IN SET VALUES!") K X Q
|
---|
10 | Q
|
---|
11 | ;
|
---|
12 | POST3 ;
|
---|
13 | N I,X,F
|
---|
14 | K DDSBR,DDSERROR
|
---|
15 | S F=$$GET^DDSVALF(1,"DICATT",1,"I","") ;we need FIELD LABEL to check total length of "0" node
|
---|
16 | S DICATTLN=1,DICATT3N=""
|
---|
17 | F X=35:2:59 S I=$$G(X) D I $D(DDSERROR) G ERROR
|
---|
18 | .I I="" Q:$$G(X+1)="" S DDSERROR=1,DDSBR=X D H("THERE MUST BE A CODE FOR '"_$$G(X+1)_"'!") Q
|
---|
19 | .I $D(F(I)) S DDSERROR=1,DDSBR=X D H("CAN'T HAVE TWO IDENTICAL CODES!") Q
|
---|
20 | .S X(X)=I,F(I)=""
|
---|
21 | .I $L(I)>DICATTLN S DICATTLN=$L(I)
|
---|
22 | .S I=$$G(X+1) I I="" S DDSERROR=1,DDSBR=X+1 D H("'"_X(X)_"' MUST MEAN SOMETHING!") Q
|
---|
23 | .I $L(DICATT3N)+$L(X(X))+$L(I)+$L(F)>235 S DDSERROR=1,DDSBR=X D H("TOO MUCH!! TO STORE THAT MUCH, BUILD A NEW FILE AND USE A POINTER!") Q
|
---|
24 | .S DICATT3N=DICATT3N_X(X)_":"_I_";"
|
---|
25 | S DICATT2N="S",DICATT5N="Q"
|
---|
26 | S DICATTMN=$$GET^DDSVALF(98,"DICATT",1,"I","") ;says we have a change
|
---|
27 | BRANCH I '$D(DICATTSC),DUZ(0)="@" S DICATTSC=3,DDSBR="65^DICATT SCREEN^6" Q
|
---|
28 | D SCREEN
|
---|
29 | Q
|
---|
30 | ;
|
---|
31 | G(I) N X Q $$GET^DDSVALF(I,"DICATT3",2.3,"I","")
|
---|
32 | ;
|
---|
33 | H(I) N X S X(1)=I,X(2)="$$EOP"
|
---|
34 | D HLP^DDSUTL(.X)
|
---|
35 | Q
|
---|
36 | ;
|
---|
37 | ERROR S DDSBR=DDSBR_"^DICATT3^2.3" Q
|
---|
38 | ;
|
---|
39 | SCREEN ;
|
---|
40 | I DUZ(0)'="@" Q
|
---|
41 | I $$S(66)]"" S DICATT5N(12.1)=$$S(66),DICATT5N(12)=$$S(67),DICATT2N="*"_DICATT2N
|
---|
42 | Q
|
---|
43 | ;
|
---|
44 | S(I) Q $$GET^DDSVALF(I,"DICATT SCREEN",6,"I","")
|
---|