source: FOIAVistA/tag/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGUTDIC.m@ 913

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1RGUTDIC ;CAIRO/DKM - Encapsulated FileMan API;04-Sep-1998 11:26;DKM
2 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
3 ;=================================================================
4 ; Parameterized routine to add/edit/extract an entry in a
5 ; FileMan file. Encapsulates global structure info so no
6 ; need to specify this directly.
7 ; Inputs:
8 ; %RGDIC = Global root, file number, or bookmark
9 ; %RGCMD = n : IEN of entry to process
10 ; 0 : Process last IEN referenced
11 ; +n : Move down to subfile n
12 ; - : Move up to parent file
13 ; @n : Delete IEN #n (or last referenced if missing)
14 ; =x;y : Lookup y at current level using options in x
15 ; ?x;y ; Lookup y using RGUTLKP utility with options in x
16 ; >x;y : Read fields specified in y using options in x
17 ; <x;y : Write fields specified in y using options in x
18 ; ~x;y : Same as <, but creates new entry
19 ; %n : Force DINUM to n
20 ; Outputs:
21 ; Returns in the first piece the IEN of the entry or...
22 ; 0 = Entry was deleted
23 ; -1 = Entry was rejected
24 ; -2 = Entry locked by another process
25 ; -3 = Unexpected error
26 ;=================================================================
27ENTRY(%RGDIC,%RGCMD) ;
28 S %RGDIC(0)=+$G(DUZ)
29 N DUZ,DIC,DINUM,DIE,DIQ,DIQUIET,DIK,%RGX,%RGIEN,%RGARG,%RGN1,%RGN2,%RGZ,X,Y
30 N DA,DC,DD,DG,DH,DK,DL,DO,DQ,DR,DU,DV,DW,DY
31 S DUZ=%RGDIC(0),DUZ(0)="@",@$$TRAP^RGZOSF("ERROR^RGUTDIC"),%RGCMD=$G(%RGCMD),%RGIEN="",DIQUIET=1
32 ; Build the bookmark if a global reference or file # passed
33 I %RGDIC'[U D
34 .S:%RGDIC'=+%RGDIC %RGDIC=+$O(^DIC("B",%RGDIC,0))
35 .S %RGDIC=$$ROOT^DILFD(%RGDIC)_U_U_%RGDIC
36 I $P(%RGDIC,U,4)="" D
37 .S %RGZ=U_$P(%RGDIC,U,2),%RGZ=$E(%RGZ,1,$L(%RGZ)-1),%RGZ=%RGZ_$S(%RGZ["(":")",1:"")
38 .S $P(%RGDIC,U,4)=$P(@%RGZ@(0),U,2)
39 F %RGN1=1:1:$L(%RGCMD,"|") S %RGARG=$P(%RGCMD,"|",%RGN1),%RGZ=$E(%RGARG) D Q:%RGIEN<0
40 .S %RGN2=$F("-+=@><~?%",%RGZ)
41 .S:%RGN2 %RGN2=%RGN2-1,%RGARG=$E(%RGARG,2,999)
42 .D DA,@%RGN2
43 .S:%RGIEN>0 $P(%RGDIC,U,3)=%RGIEN
44 S $P(%RGDIC,U)=%RGIEN
45 Q %RGDIC
46 ; Set IEN
470 S:%RGARG'<0 %RGIEN=$S($D(@%RGDIC(2)@(+%RGARG)):+%RGARG,1:0),$P(%RGDIC,U,3)=%RGIEN
48 Q
49 ; Move up to parent file
501 N %RGX,%RGY
51 S $P(%RGDIC,U,4)=$P($P(%RGDIC,U,4),"|",2,999)
52 S %RGY=$P(%RGDIC,U,2),%RGX=$L(%RGY,"|"),$P(%RGDIC,U,2)=$P(%RGY,"|",1,%RGX-1)
53 S %RGIEN=+$P(%RGY,"|",%RGX),$P(%RGDIC,U,3)=%RGIEN
54 D DA
55 Q
56 ; Move down to subfile
572 N %RGX,%RGY,%RGZ
58 I $P(%RGDIC,U,3)'>0 S %RGIEN=-1 Q
59 S %RGY=+$P(%RGDIC,U,4)
60 S:%RGARG'=+%RGARG %RGARG=+$O(^DD(%RGY,"B",%RGARG,0)),%RGARG=+$P($G(^DD(%RGY,%RGARG,0)),U,2)
61 S %RGX=+%RGARG,%RGZ=+$O(^DD(%RGY,"SB",%RGX,0)),%RGZ=$P($P(^DD(%RGY,%RGZ,0),U,4),";"),%RGX=$P(^(0),U,2)
62 S:%RGZ'=+%RGZ %RGZ=""""_%RGZ_""""
63 S $P(%RGDIC,U,4)=%RGX_"|"_$P(%RGDIC,U,4),$P(%RGDIC,U,2)=$P(%RGDIC,U,2)_"|"_$P(%RGDIC,U,3)_","_%RGZ_","
64 S %RGIEN="",$P(%RGDIC,U,3)=""
65 D DA
66 Q
67 ; Lookup an entry
683 N X,Y
69 I %RGARG[";" S DIC(0)=$P(%RGARG,";"),%RGARG=$P(%RGARG,";",2,999)
70 E S DIC(0)="XMF"
71 S DIC=%RGDIC(1),X=%RGARG
72 D ^DIC
73 S %RGIEN=+Y
74 Q
75 ; Delete an entry
764 N X,Y
77 S:%RGARG DA=%RGARG
78 S DIK=%RGDIC(1),%RGIEN=0
79 D ^DIK
80 Q
81 ; Extract data
825 N %RGZ,%RGZ1,%RGX,%RGY
83 I '%RGIEN S %RGIEN=-1 Q
84 S DR=""
85 F %RGX=2:1:$L(%RGARG,";") D
86 .S %RGY=$P(%RGARG,";",%RGX)
87 .I %RGY["=" S %RGZ=$$FLD($P(%RGY,"=",2)),%RGZ1(%RGZ,$P(%RGY,"="))="",%RGY=%RGZ
88 .S DR=DR_$S($L(DR):";",1:"")_%RGY
89 S DIC=%RGDIC(1),DIQ(0)=$P(%RGARG,";")
90 S:DIQ(0)="" DIQ(0)="E"
91 K ^UTILITY("DIQ1",$J)
92 D
93 .N X,Y
94 .D EN^DIQ1
95 F %RGX=0:0 S %RGX=$O(%RGZ1(%RGX)),%RGZ="" Q:'%RGX D
96 .F S %RGZ=$O(%RGZ1(%RGX,%RGZ)),%RGZ1="" Q:%RGZ="" D
97 ..F %RGY="E","I" D
98 ...S:$D(^UTILITY("DIQ1",$J,+$P(%RGDIC,U,4),%RGIEN,%RGX,%RGY)) %RGZ1=%RGZ1_$S($L(%RGZ1):U,1:"")_^(%RGY)
99 ..S @%RGZ=%RGZ1
100 Q
101 ; Edit existing entry
1026 S DIC(0)=$P(%RGARG,";"),DIC("P")=$P($P(%RGDIC,U,4),"|"),%RGARG=$P(%RGARG,";",2,999)
103 I %RGIEN'>0 S %RGIEN=-1 Q
104 S DIE=%RGDIC(1),DR=%RGARG
105 L +@%RGDIC(2)@(%RGIEN):$S(DIC(0)["!":9999999,1:0)
106 E S %RGIEN=-2 Q
107 D ^DIE
108 L -@%RGDIC(2)@(%RGIEN)
109 S %RGIEN=+$G(DA)
110 Q
111 ; Create new entry
1127 N X,Y,DD,DO,DLAYGO
113 S DIC=%RGDIC(1),DIC(0)=$P(%RGARG,";")_"L",DIC("P")=$P($P(%RGDIC,U,4),"|"),Y=$P(%RGARG,";",2),%RGARG=DIC(0)_";"_$P(%RGARG,";",3,999),DLAYGO=DIC("P")\1
114 I +Y'=.01 S %RGIEN=-1 Q
115 S X=$P(Y,"/",4)
116 S:X="" X=$P(Y,"/",5)
117 X:$E(X)=U $E(X,2,999)
118 I $P(^DD(+DIC("P"),.01,0),U,2)["W" D
119 .D WP
120 E D ^DIC:DIC(0)'["U",FILE^DICN:DIC(0)["U"
121 S %RGIEN=+Y
122 I %RGIEN>0,$P(%RGARG,";",2,99)'="" D DA,6
123 K DINUM
124 Q
1258 ; Lookup entry
126 N %RGOPT,%RGP,RGFN
127 S %RGOPT=$P(%RGARG,";"),%RGARG=$P(%RGARG,";",2,999),RGFN=+$P(%RGDIC,U,4)
128 S %RGP=+$P(%RGDIC,U,4),%RGP=$P($G(^DD(%RGP,.01,0)),U)
129 S:$L(%RGP) %RGP=%RGP_": "
130 S %RGIEN=$$ENTRY^RGUTLKP(%RGDIC(2),%RGOPT,%RGP,"",%RGARG,"","",$X,$Y,"","","HLP^RGUTDIC")
131 Q
132 ; Force DINUM
1339 S DINUM=%RGARG
134 Q
135HLP W $G(^DD(+RGFN,.01,3)),!
136 Q
137 ; Word processing field (special case of #7)
138WP N %RGZ,%RGZ1
139 I X="@" D
140 .K @%RGDIC(2)
141 .S Y=0
142 E D
143 .S %RGZ=$G(@%RGDIC(2)@(0)),Y=$G(DINUM,1+$O(^($C(1)),-1))
144 .S %RGZ1=+$P(%RGZ,U,4),%RGZ=+$P(%RGZ,U,3)
145 .S:Y>%RGZ %RGZ=Y
146 .S:'$D(^(Y)) %RGZ1=%RGZ1+1
147 .S ^(0)=U_U_%RGZ_U_%RGZ1_U_$G(DT),^(Y,0)=X
148 Q:$P(^DD(+DIC("P"),.01,0),U,2)'["a"
149 S %RGIEN=Y
150 D DA,WPAUDIT^RGCODAUD(+DIC("P"),.DA,X,"")
151 Q
152 ; Trap unexpected error
153ERROR S $P(%RGDIC,U)=-3
154 Q %RGDIC
155 ; Return field #
156FLD(X) Q $S(X=+X:X,1:+$O(^DD(+$P(%RGDIC,U,4),"B",X,0)))
157 ; Set up DA array
158DA N %RGZ,%RGZ1,%RGZ2
159 K DA
160 S:'$G(%RGIEN) %RGIEN=$P(%RGDIC,U,3)
161 S %RGZ=$P(%RGDIC,U,2),%RGZ2=$L(%RGZ,"|"),DA=%RGIEN
162 F %RGZ1=2:1:%RGZ2 S DA(%RGZ2-%RGZ1+1)=+$P(%RGZ,"|",%RGZ1)
163 S %RGDIC(1)=U_$TR($P(%RGDIC,U,2),"|"),%RGDIC(2)=$E(%RGDIC(1),1,$L(%RGDIC(1))-1),%RGDIC(2)=%RGDIC(2)_$S(%RGDIC(2)["(":")",1:"")
164 Q
Note: See TracBrowser for help on using the repository browser.