source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICATTDD.m@ 837

Last change on this file since 837 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1DICATTDD ;GFT;12:02 PM 8 Apr 2001; multiple fields
2 ;;22.0;VA FileMan;**42,76**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6MULMAKE(DICATTD,TYPE) ;DICATTD=sub-dictionary number, TYPE 1-9
7 ;only called from DICATTDE
8 N F,DA,DIK,I,J,DIC
9 S F=$$G(1),^DD(DICATTD,0)=F_" SUB-FIELD^^.01^1"
10 S ^(0,"UP")=DICATTA,^("NM",F)=""
11 S ^DD(DICATTD,.01,0)=F_"^^^0;1"
12 I TYPE-5 D ;build a "B" x-ref unless this is a W-P multiple
13 .S ^DD(DICATTD,.01,1,0)="^.1",^(1,0)=DICATTD_"^B"
14 .S:+DICATT4S'=DICATT4S DICATT4S=""""_DICATT4S_""""
15 .S DIK=DICATT4S_",""B"",$E(X,1,30),DA)"
16 .D IJ^DIUTL(DICATTA) S I=$O(I(""),-1)
17 .F DA=I:-1:0 S DIK=I(DA)_$E(",",''DA)_"DA("_(I+1-DA)_"),"_DIK
18 .S ^DD(DICATTD,.01,1,1,1)="S "_DIK_"=""""",^(2)="K "_DIK
19 .I TYPE=8 S ^(3)="Required for Variable Pointer"
20 S DA=.01,DA(1)=DICATTD,(DIC,DIK)="^DD("_DICATTD_","
21 D IX1^DIK
22 S $P(^DD(DICATTA,DICATTF,0),U,2)=DICATTD ;K DICATT2N
23 S ^DD(DICATTA,"SB",DICATTD,DICATTF)=""
24 Q
25 ;
26MULEDIT S G=$$G(1) I G="" G ^DICATTDK:$D(DICATTDK) S DDSBR=1,DDSERROR=1 Q
27 S $P(^DD(+DICATT2,0),U)=G_" SUB-FIELD" K ^(0,"NM") S ^("NM",G)=""
28 S DR=".01////"_G F X=5,7,8 D 0
29DIE S DICATTED=1,DA=DICATTF,DA(1)=DICATTA,(DIC,DIE)="^DD(DICATTA,"
30 D ^DIE
31 D FILEWORD^DICATTD0 Q
32 ;
330 S T=$T(@X),G=$TR($$G(X),";") Q:G="@" S:G="" G="@" S DR=DR_$P(T,";",2,3)_"////"_G Q
345 ;;8
357 ;;9
368 ;;10
37 ;
38G(I) N X Q $$GET^DDSVALF(I,"DICATT MUL",10,"I","")
Note: See TracBrowser for help on using the repository browser.