DICATTD3.m

DICATTD3 ;GFT;09:06 AM  21 Jan 1999;SET OF CODES

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

Y(ORDER,CM) ;

 S Y=$P($P(DICATT3,";",ORDER),":",CM) Q

C ;

 N C

 F C=":",";","=","""" I X[C D HLP^DDSUTL("SORRY -- '"_C_"' NOT ALLOWED IN SET VALUES!") K X Q

 Q

 ;

POST3 ;

 N I,X,F

 K DDSBR,DDSERROR

 S F=$$GET^DDSVALF(1,"DICATT",1,"I","") ;we need FIELD LABEL to check total length of "0" node

 S DICATTLN=1,DICATT3N=""

 F X=35:2:59 S I=$$G(X) D  I $D(DDSERROR) G ERROR

 .I I="" Q:$$G(X+1)=""  S DDSERROR=1,DDSBR=X D H("THERE MUST BE A CODE FOR '"_$$G(X+1)_"'!") Q

 .I $D(F(I)) S DDSERROR=1,DDSBR=X D H("CAN'T HAVE TWO IDENTICAL CODES!") Q

 .S X(X)=I,F(I)=""

 .I $L(I)>DICATTLN S DICATTLN=$L(I)

 .S I=$$G(X+1) I I="" S DDSERROR=1,DDSBR=X+1 D H("'"_X(X)_"' MUST MEAN SOMETHING!") Q

 .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

 .S DICATT3N=DICATT3N_X(X)_":"_I_";"

 S DICATT2N="S",DICATT5N="Q"

 S DICATTMN=$$GET^DDSVALF(98,"DICATT",1,"I","") ;says we have a change

BRANCH I '$D(DICATTSC),DUZ(0)="@" S DICATTSC=3,DDSBR="65^DICATT SCREEN^6" Q

 D SCREEN

 Q

 ;

G(I) N X Q $$GET^DDSVALF(I,"DICATT3",2.3,"I","")

 ;

H(I) N X S X(1)=I,X(2)="$$EOP"

 D HLP^DDSUTL(.X)

 Q

 ;

ERROR S DDSBR=DDSBR_"^DICATT3^2.3" Q

 ;

SCREEN ;

 I DUZ(0)'="@" Q

 I $$S(66)]"" S DICATT5N(12.1)=$$S(66),DICATT5N(12)=$$S(67),DICATT2N="*"_DICATT2N

 Q

 ;

S(I) Q $$GET^DDSVALF(I,"DICATT SCREEN",6,"I","")

DICATTD3  ;GFT;09:06 AM  21 Jan 1999;SET OF CODES

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

Y(ORDER,CM) ;

 +1        SET Y=$PIECE($PIECE(DICATT3,";",ORDER),":",CM)

           QUIT 

C         ;

 +1        NEW C

 +2        FOR C=":",";","=",""""

               IF X[C

                   DO HLP^DDSUTL("SORRY -- '"_C_"' NOT ALLOWED IN SET VALUES!")

                   KILL X

                   QUIT 

 +3        QUIT 

 +4       ;

POST3     ;

 +1        NEW I,X,F

 +2        KILL DDSBR,DDSERROR

 +3       ;we need FIELD LABEL to check total length of "0" node

           SET F=$$GET^DDSVALF(1,"DICATT",1,"I","")

 +4        SET DICATTLN=1

           SET DICATT3N=""

 +5        FOR X=35:2:59

               SET I=$$G(X)

               Begin DoDot:1

 +6                IF I=""

                       IF $$G(X+1)=""

                           QUIT 

                       SET DDSERROR=1

                       SET DDSBR=X

                       DO H("THERE MUST BE A CODE FOR '"_$$G(X+1)_"'!")

                       QUIT 

 +7                IF $DATA(F(I))

                       SET DDSERROR=1

                       SET DDSBR=X

                       DO H("CAN'T HAVE TWO IDENTICAL CODES!")

                       QUIT 

 +8                SET X(X)=I

                   SET F(I)=""

 +9                IF $LENGTH(I)>DICATTLN

                       SET DICATTLN=$LENGTH(I)

 +10               SET I=$$G(X+1)

                   IF I=""

                       SET DDSERROR=1

                       SET DDSBR=X+1

                       DO H("'"_X(X)_"' MUST MEAN SOMETHING!")

                       QUIT 

 +11               IF $LENGTH(DICATT3N)+$LENGTH(X(X))+$LENGTH(I)+$LENGTH(F)>235

                       SET DDSERROR=1

                       SET DDSBR=X

                       DO H("TOO MUCH!!  TO STORE THAT MUCH, BUILD A NEW FILE AND USE A POINTER!")

                       QUIT 

 +12               SET DICATT3N=DICATT3N_X(X)_":"_I_";"

               End DoDot:1

               IF $DATA(DDSERROR)

                   GOTO ERROR

 +13       SET DICATT2N="S"

           SET DICATT5N="Q"

 +14      ;says we have a change

           SET DICATTMN=$$GET^DDSVALF(98,"DICATT",1,"I","")

BRANCH     IF '$DATA(DICATTSC)

               IF DUZ(0)="@"

                   SET DICATTSC=3

                   SET DDSBR="65^DICATT SCREEN^6"

                   QUIT 

 +1        DO SCREEN

 +2        QUIT 

 +3       ;

G(I)       NEW X

           QUIT $$GET^DDSVALF(I,"DICATT3",2.3,"I","")

 +1       ;

H(I)       NEW X

           SET X(1)=I

           SET X(2)="$$EOP"

 +1        DO HLP^DDSUTL(.X)

 +2        QUIT 

 +3       ;

ERROR      SET DDSBR=DDSBR_"^DICATT3^2.3"

           QUIT 

 +1       ;

SCREEN    ;

 +1        IF DUZ(0)'="@"

               QUIT 

 +2        IF $$S(66)]""

               SET DICATT5N(12.1)=$$S(66)

               SET DICATT5N(12)=$$S(67)

               SET DICATT2N="*"_DICATT2N

 +3        QUIT 

 +4       ;

S(I)       QUIT $$GET^DDSVALF(I,"DICATT SCREEN",6,"I","")