DICATTDD.m

DICATTDD ;GFT;12:02 PM  8 Apr 2001; multiple fields [ 12/09/2003  4:25 PM ]

 ;;22.0;VA FileMan;**42,76,1002**;Mar 30, 1999

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

 ;

 ;

MULMAKE(DICATTD,TYPE) ;DICATTD=sub-dictionary number, TYPE 1-9

 ;only called from DICATTDE

 N F,DA,DIK,I,J,DIC

 S F=$$G(1),^DD(DICATTD,0)=F_" SUB-FIELD^^.01^1"

 S ^(0,"UP")=DICATTA,^("NM",F)=""

 S ^DD(DICATTD,.01,0)=F_"^^^0;1"

 I TYPE-5 D  ;build a "B" x-ref unless this is a W-P multiple

 .S ^DD(DICATTD,.01,1,0)="^.1",^(1,0)=DICATTD_"^B"

 .S:+DICATT4S'=DICATT4S DICATT4S=""""_DICATT4S_""""

 .S DIK=DICATT4S_",""B"",$E(X,1,30),DA)"

 .D IJ^DIUTL(DICATTA) S I=$O(I(""),-1)

 .F DA=I:-1:0 S DIK=I(DA)_$E(",",''DA)_"DA("_(I+1-DA)_"),"_DIK

 .S ^DD(DICATTD,.01,1,1,1)="S "_DIK_"=""""",^(2)="K "_DIK

 .I TYPE=8 S ^(3)="Required for Variable Pointer"

 S DA=.01,DA(1)=DICATTD,(DIC,DIK)="^DD("_DICATTD_","

 D IX1^DIK

 S $P(^DD(DICATTA,DICATTF,0),U,2)=DICATTD ;K DICATT2N

 S ^DD(DICATTA,"SB",DICATTD,DICATTF)=""

 Q

 ;

MULEDIT S G=$$G(1) I G="" G ^DICATTDK:$D(DICATTDK) S DDSBR=1,DDSERROR=1 Q

 S $P(^DD(+DICATT2,0),U)=G_" SUB-FIELD" K ^(0,"NM") S ^("NM",G)=""

 S DR=".01////"_G F X=5,7,8 D 0

DIE S DICATTED=1,DA=DICATTF,DA(1)=DICATTA,(DIC,DIE)="^DD(DICATTA,"

 D ^DIE

 D FILEWORD^DICATTD0 Q

 ;

0 S T=$T(@X),G=$TR($$G(X),";") Q:G="@"  S:G="" G="@" S DR=DR_$P(T,";",2,3)_"////"_G Q

5 ;;8

7 ;;9

8 ;;10

 ;

G(I) N X Q $$GET^DDSVALF(I,"DICATT MUL",10,"I","")

DICATTDD  ;GFT;12:02 PM  8 Apr 2001; multiple fields [ 12/09/2003  4:25 PM ]

 +1       ;;22.0;VA FileMan;**42,76,1002**;Mar 30, 1999

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

 +3       ;

 +4       ;

MULMAKE(DICATTD,TYPE) ;DICATTD=sub-dictionary number, TYPE 1-9

 +1       ;only called from DICATTDE

 +2        NEW F,DA,DIK,I,J,DIC

 +3        SET F=$$G(1)

           SET ^DD(DICATTD,0)=F_" SUB-FIELD^^.01^1"

 +4        SET ^(0,"UP")=DICATTA

           SET ^("NM",F)=""

 +5        SET ^DD(DICATTD,.01,0)=F_"^^^0;1"

 +6       ;build a "B" x-ref unless this is a W-P multiple

           IF TYPE-5

               Begin DoDot:1

 +7                SET ^DD(DICATTD,.01,1,0)="^.1"

                   SET ^(1,0)=DICATTD_"^B"

 +8                IF +DICATT4S'=DICATT4S

                       SET DICATT4S=""""_DICATT4S_""""

 +9                SET DIK=DICATT4S_",""B"",$E(X,1,30),DA)"

 +10               DO IJ^DIUTL(DICATTA)

                   SET I=$ORDER(I(""),-1)

 +11               FOR DA=I:-1:0

                       SET DIK=I(DA)_$EXTRACT(",",''DA)_"DA("_(I+1-DA)_"),"_DIK

 +12               SET ^DD(DICATTD,.01,1,1,1)="S "_DIK_"="""""

                   SET ^(2)="K "_DIK

 +13               IF TYPE=8

                       SET ^(3)="Required for Variable Pointer"

               End DoDot:1

 +14       SET DA=.01

           SET DA(1)=DICATTD

           SET (DIC,DIK)="^DD("_DICATTD_","

 +15       DO IX1^DIK

 +16      ;K DICATT2N

           SET $PIECE(^DD(DICATTA,DICATTF,0),U,2)=DICATTD

 +17       SET ^DD(DICATTA,"SB",DICATTD,DICATTF)=""

 +18       QUIT 

 +19      ;

MULEDIT    SET G=$$G(1)

           IF G=""

               IF $DATA(DICATTDK)

                   GOTO ^DICATTDK

               SET DDSBR=1

               SET DDSERROR=1

               QUIT 

 +1        SET $PIECE(^DD(+DICATT2,0),U)=G_" SUB-FIELD"

           KILL ^(0,"NM")

           SET ^("NM",G)=""

 +2        SET DR=".01////"_G

           FOR X=5,7,8

               DO 0

DIE        SET DICATTED=1

           SET DA=DICATTF

           SET DA(1)=DICATTA

           SET (DIC,DIE)="^DD(DICATTA,"

 +1        DO ^DIE

 +2        DO FILEWORD^DICATTD0

           QUIT 

 +3       ;

0          SET T=$TEXT(@X)

           SET G=$TRANSLATE($$G(X),";")

           IF G="@"

               QUIT 

           IF G=""

               SET G="@"

           SET DR=DR_$PIECE(T,";",2,3)_"////"_G

           QUIT 

5         ;;8

7         ;;9

8         ;;10

 +1       ;

G(I)       NEW X

           QUIT $$GET^DDSVALF(I,"DICATT MUL",10,"I","")