DICATTDD ;GFT/GFT - Multiple Fields;12:02 PM 8 Apr 2001
;;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.
;
;
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","")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICATTDD 1645 printed Nov 22, 2024@17:55:42 Page 2
DICATTDD ;GFT/GFT - Multiple Fields;12:02 PM 8 Apr 2001
+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 ;
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","")
