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

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1DDS10 ;SFISC/MKO-BLOCK SETUP ;21SEP2006
2 ;;22.0;VA FileMan;**147,151**;Mar 30, 1999;Build 10
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5SET(DDS1B,DDS1E,DA,DDP,DIE,DL,DDSDA) ;Get values for pointed-to block
6 ;In:
7 ; DDS1B = Block number or [Block name] (by ref)
8 ; DDS1E = 1, if we're loading a pointed-to block and we want
9 ; interactive dialog (DIC(0)["E") in the lookup
10 ; DA = Record array
11 ;Returns:
12 ; DDS1B = Block number
13 ; DDP = File number of block
14 ; DIE = Global root based on DDP and DA
15 ; DL = Level number (top=0)
16 ; DDSDA = DA,DA(1),...,
17 ;
18 D BK(.DDS1B,.DDP) Q:$G(DIERR)
19 D GDA(DDS1B,DDS1E,.DA) Q:$G(DIERR)
20 D GL(DDP,.DA,.DIE,.DL,.DDSDA,$P($G(^DIST(.403,+DDS,40,+$G(DDSPG),40,DDS1B,0)),U,4)'="d") Q:$G(DIERR) ;Don't LOCK record if block is display-only
21 Q
22 ;
23BK(DDSBK,DDP) ;Lookup block, get file number
24 ;Input:
25 ; DDSBK = Block number or [Block name] (by ref)
26 ;Returns:
27 ; DDSBK = Block number
28 ; DDP = File number
29 ; DIERR
30 ;
31 I DDSBK=+$P(DDSBK,"E") D Q
32 . I $D(^DIST(.404,DDSBK,0))[0 D BLD^DIALOG(3051,"#"_DDSBK) Q
33 . S DDP=+$P(^DIST(.404,DDSBK,0),U,2)
34 I DDSBK?1"["1.E1"]" D Q
35 . N X,Y,DIC
36 . S X=$E(DDSBK,2,$L(DDSBK)-1),DIC="^DIST(.404,",DIC(0)="FZ"
37 . D ^DIC I Y<0 D BLD^DIALOG(3051,"named "_X) Q
38 . S DDSBK=+Y,DDP=+$P(Y(0),U,2)
39 D BLD^DIALOG(3051,"#"_DDSBK)
40 Q
41 ;
42GDA(DDS1B,DDS1E,DA) ;Find new DA
43 ;Input:
44 ; DDS1B = Block number
45 ; DDS1E = 1:Interactive lookup
46 ; DDSDAORG = Original DA array
47 ; DDSDLORG = Original DL
48 ; DDSPG
49 ;Returns:
50 ; DA = Record number
51 ; DIERR
52 ;
53 N DDSDA,DDSI,X
54 ;
55 ;Set DA array to its original value
56 S DA=DDSDAORG
57 F DDSI=1:1:DDSDLORG S DA(DDSI)=DDSDAORG(DDSI)
58 D DDSDA(.DA,DDSDLORG,.DDSDA)
59 ;
60 ;Xecute each PTB node
61 F DDSI=1:1 Q:DA=""!'$D(@DDSREFS@(DDSPG,DDS1B,"PTB",DDSI)) X ^(DDSI) S:$G(X)'>0 DA=""
62 ;
63 ;Kill descendants of DA
64 I '$G(DIERR) S DDSI=DA K DA S DA=DDSI
65 S:DA'>0!$G(DIERR) DA=""
66 Q
67 ;
68GL(F,DA,DIE,DL,DDSDA,DDSL) ;Get global root, level, and IEN
69 ;Input variables:
70 ; F = file #
71 ; DA = array
72 ; DDSL = flag to lock record
73 ;Returns:
74 ; DIE = global root of file (null if error)
75 ; DL = level (top=0) (null if error)
76 ; DDSDA = IEN
77 ; DIERR = Error flag
78 ;
79 I '$D(^DD(F)) D BLD^DIALOG(401,F) S (DIE,DL)="" Q
80 I $D(^DIC(F,0,"GL"))#2 S DIE=^("GL"),DL=0
81 E D SUBGL Q:$G(DIERR)
82 ;
83 I '$G(DA) S DDSDA="0," Q
84 D DDSDA(.DA,DL,.DDSDA)
85 ;
86 N DDSP S DDSP("FILE")=F,DDSP("IEN")=DDSDA
87 ;
88 I $D(@(DIE_DA_",0)"))[0 D BLD^DIALOG(601,"",.DDSP)
89 I $D(@(DIE_DA_",-9)")) D BLD^DIALOG(602,"",.DDSP)
90 ;
91 I $G(DDSL),$D(^TMP("DDS",$J,"LOCK",DIE_DA_")"))[0 D Q:$G(DIERR)
92 . D LOCK^DILF(DIE_DA_")") E D BLD^DIALOG(110,"",.DDSP) Q ;**147
93 . S ^TMP("DDS",$J,"LOCK",DIE_DA_")")=""
94 Q
95 ;
96SUBGL ;Get root and level for subfile
97 N D,I,S,U1
98 S D=F
99 F DL=0:1 Q:$D(^DD(D,0,"UP"))[0 S U1=^("UP") G:'$D(^DD(U1,"SB",D)) SUBER G:$D(^DD(U1,$O(^(D,"")),0))[0 SUBER S S(DL+1)=""""_$P($P(^(0),U,4),";")_"""",D=U1
100 G:$D(^DIC(D,0,"GL"))[0 SUBER S DIE=^("GL")
101 F I=DL:-1:1 G:$D(DA(I))[0 SUBER S DIE=DIE_DA(I)_","_S(I)_","
102 Q
103 ;
104SUBER ;Come here if an error is encountered in GL
105 S (DIE,DL)=""
106 D BLD^DIALOG(309)
107 Q
108 ;
109DDSDA(DA,DL,DDSDA) ;Determine DDSDA
110 ;Input:
111 ; DA = Record array
112 ; DL = Level number (top=0)
113 ;Output:
114 ; DDSDA = DA,DA(1),...,
115 ;
116 N I
117 I DA="" S DDSDA="" Q
118 S DDSDA=DA_"," F I=1:1:DL S DDSDA=DDSDA_DA(I)_","
119 Q
Note: See TracBrowser for help on using the repository browser.