Produced by Araxis Merge on 11/9/2018 12:33:49 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHIUTIL.m | Mon Nov 5 16:45:12 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHIUTIL.m | Mon Nov 5 17:41:36 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 1006 |
Changed | 1 | 2 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | CHIUTIL ;H ARRIS; Uti lity Routi ne | |
2 | ;; Januar y 2012 | |
3 | ;;09/29/1 5 SBB DEF0 16554 fix for decnet | |
4 | ; | |
5 | FDIR(DIR,F SPEC,FILES ,FULL) ; | |
6 | ; Get lis ting of di rectory | |
7 | ; Paramet eres: | |
8 | ; DI R - VMS di rectory na me | |
9 | ; FSPEC - file na mes specif ication (i f none, th en *.*) | |
10 | ; FI LES - List of Files. (Pass by reference ) | |
11 | ; FU LL - give back fully qualified file name s or just short file names | |
12 | ; | |
13 | N FILE,I, SDIR,SFILE ,UFILE | |
14 | I $G(FULL )="" S FUL L=1 | |
15 | K FILES S :$G(FSPEC) ="" FSPEC= "*.*" | |
16 | S I=0 | |
17 | F J=1:1:$ L(FSPEC,", ") D | |
18 | . S FILE= $ZSEARCH(D IR_$P(FSPE C,",",J)) | |
19 | . I FILE= "" Q | |
20 | . F D Q :FILE="" | |
21 | . . S SDI R=DIR,SFIL E=FILE | |
22 | . . I SFI LE["passwo rd" S SFIL E=$P(SFILE ,"::",2,99 ),SDIR=$P( SDIR,"::", 2,99) | |
23 | . . S SFI LE=$P(SFIL E,SDIR,2,9 9),UFILE=S FILE | |
24 | . . I SFI LE?.E1";"1 .N S UFILE =$P(SFILE, ";",1,$L(S FILE,";")- 1) | |
25 | . . I UFI LE[".DIR" S UFILE=$P (UFILE,"." ) | |
26 | . . I 'FU LL S FILES (UFILE)=DI R_SFILE | |
27 | . . E S FILES(DIR_ SFILE)=DIR _SFILE | |
28 | . . S I=I +1 | |
29 | . . S FIL E=$ZSEARCH ("") | |
30 | Q I | |
31 | MENU() ;; present us er with me nu to sele ct vendor file then return ven dor file s election I O | |
32 | ; | |
33 | ; BC = "Base" or "Change" file type selected u ser - Do n ot New or Kill this variable. Used in CH IVFI to se t .04 fiel d in file #741033 | |
34 | ; RFILE = IO string returned in DIRECTO RY_FILE st ructure | |
35 | ; | |
36 | N DIR,F,F ILE,RFILE, I,TYPE | |
37 | S RFILE=" " | |
38 | S DIR(1)= "HAC_HFS$: [SCR.TEMP_ FILES.FS3B IG.CODEUPD T.ICD10UPD T.OPTUM_IC D10_BASE_D EC2011_EXT RACT]" | |
39 | S DIR(2)= "HAC_HFS$: [SCR.TEMP_ FILES.FS3B IG.CODEUPD T.ICD10UPD T.OPTUM_IC D10_CHANGE _DEC2011_E XTRACT]" | |
40 | S DIR(3)= "CHAMPVA_U SER:[ DNS GIULIL]" ; *** new 2 /20/12 -lg *** | |
41 | S I=1 | |
42 | F F="OPTU M_ICD10CM_ BASE.TAB", "OPTUM_ICD 10CM_BASE. TXT","OPTU M_ICD10PCS _BASE.TAB" ,"OPTUM_IC D10PCS_BAS E.TXT" S F ILE(1,I)=F ,I=I+1 | |
43 | S I=1 | |
44 | F F="OPTU M_ICD10CM_ CHANGE.TAB ","OPTUM_I CD10CM_CHA NGE.TXT"," OPTUM_ICD1 0PCS_CHANG E.TAB","OP TUM_ICD10P CS_CHANGE. TXT" S FIL E(2,I)=F,I =I+1 | |
45 | S I=1 | |
46 | F F="DX_A I_MAPPING. TXT","PCS_ AI_MAPPING .TXT" S FI LE(3,I)=F, I=I+1 ; ** * new 2/20 /12 -lg ** * | |
47 | ; | |
48 | ; get fil e type, i. e. baselin e file or change fil e | |
49 | F R !,"( B)ase, (C) hange, or (M)apping file: ",BC S BC=$E(B C) Q:"BCM^ "[BC ; ** * new 2/20 /12 -lg ** * | |
50 | S TYPE=$S (BC="B":1, BC="C":2,B C="M":3,1: "") G EXIT :TYPE="" ; *** new 2/20/12 -l g *** | |
51 | ; get fil e type, i. e. baselin e file or change fil e | |
52 | ;F R !," (B)ase, or (C)hange file: ",BC S BC=$E(B C) Q:"BC^" [BC ; *** old 2/20/ 12 -lg *** | |
53 | ;S TYPE=$ S(BC="B":1 ,BC="C":2, 1:"") G EX IT:TYPE="" ; *** ol d 2/20/12 -lg *** | |
54 | S DIR=DIR (TYPE) | |
55 | FIL ; | |
56 | W ! | |
57 | F I=1:1 Q :$G(FILE(T YPE,I))="" W !,I,") ",FILE(TY PE,I) | |
58 | R !!,"Cho ice # ",CH G EXIT:CH =""!(CH="^ ") G FIL:$ G(FILE(TYP E,CH))="" | |
59 | S FILE=FI LE(TYPE,CH ) | |
60 | S RFILE=D IR_FILE | |
61 | ; | |
62 | EXIT ; | |
63 | Q RFILE ; exit poi nt of MENU () subrout ine return s IO strin g in RFILE and leave s BC varia ble (File Type: B, o r C) | |
64 | ; | |
65 | NOW() ; cu rrent date & time in human rea dable form at | |
66 | N Y S Y=$ H D NOW^%D TC S Y=% X ^DD("DD") Q Y | |
67 | ; | |
68 | FMDT() ; c urrent dat e & time i n FM forma t | |
69 | N % D NOW ^%DTC Q % | |
70 | ; save va riable and stack inf o | |
71 | STACK(yDt) ; | |
72 | N State S State("Le v")=$ZU(41 ) ;save th e stack le vel | |
73 | S State=$ $INT^%STAC K(.State) ;returns t he pointer to ^mtemp () | |
74 | K yDt M y Dt=^mtemp( State) | |
75 | Q | |
76 | VARS ; | |
77 | K | |
78 | R !,"Rest oring from stack dum p: ",sTv(" GL") Q:sTv ("GL")="" | |
79 | VARSG1 | |
80 | S:$G(sTv1 )'="" sTv( "GL")=sTv1 | |
81 | S sTv("GL ")=$E(sTv( "GL"),1,*- 1) | |
82 | S sTv("LV ")=0 | |
83 | F S sTv( "LV")=sTv( "LV")+1 Q :'$D(@(sTv ("GL")_"," "*STACK"", "_sTv("LV" )_")")) D | |
84 | . W:$G(Qu iet)=99 !, @(sTv("GL" )_",""*STA CK"","_sTv ("LV")_"," "L"")") | |
85 | . S sTv(" V")="" | |
86 | . F S sT v("V")=$O( @(sTv("GL" )_",""*STA CK"","_sTv ("LV")_"," "V"")")@(s Tv("V"))) Q:sTv("V") ="" D | |
87 | . . M @sT v("V")=@(s Tv("GL")_" ,""*STACK" ","_sTv("L V")_",""V" ","""_sTv( "V")_""")" ) | |
88 | K sTv | |
89 | Q | |
90 | VARSG(StVz ) | |
91 | S sTv("GL ")=StVz | |
92 | G VARSG1 | |
93 | STACKL(sTv ,Quiet) ; | |
94 | K (sTv,Qu iet) | |
95 | i $g(sTv) s sTv("SL ")=sTv | |
96 | e R !,"R estore Sta ck Level: ",sTv("SL" ) | |
97 | S sTv("GL ")="^GLAZ( ""H"","_sT v("SL")_") " | |
98 | G VARSG1 | |
99 | ; | |
100 | DESC(CODE, DOS) ; Ext rinsic Fun ction to g et the Dia gnosis cod e descript ion in rel ation to D ate Of Ser vice | |
101 | ; CODE = Diagnosis Code Inter nal Entry Number, fi le #741006 .05 | |
102 | ; DOS = Date Of Se rvice | |
103 | ; ICD10-R CS Imcreme nt 2 bug # 2 fix -lg 09/20/12 | |
104 | I 'CODE Q "" | |
105 | I '$D(^CH MICDX(CODE ,0)) Q "" | |
106 | I 'DOS Q $P(^CHMICD X(CODE,0), U) | |
107 | I DOS>($P (^CHMICDX( CODE,0),U, 22)-1) Q $ P(^(0),U) | |
108 | N DT S DT =(9999999- DOS-1),DT= +$O(^CHMIC DX(CODE,10 3,DT)) I D T Q:$D(^(D T,0)) $P(^ (0),U,3) | |
109 | Q "Not Va lid on Giv en Date" | |
110 | ; | |
111 | ZZW(variab le) ; | |
112 | ; Write all local vari ables and/ or one/all open obje ct instanc es | |
113 | ; Copyright 2001,2012 George Jam es Softwar e Limited" | |
114 | ; Visit w ww.georgej ames.com f or updates | |
115 | /* | |
116 | ||
117 | i variabl e'="" d | |
118 | . i $$oRe fExists(va riable) d wDump(vari able) i 1 | |
119 | . e w $z zlist(vari able) | |
120 | e d | |
121 | . d write Orefs | |
122 | . d local s | |
123 | d copyRig ht | |
124 | q | |
125 | ; Does oR ef referen ce a valid object in stance? | |
126 | oRefExists (oRef) ; | |
127 | q $zobjst ate(oRef) | |
128 | ; Dump an object | |
129 | ; Usage: | |
130 | ; d wDump (oRef,leve l,name,.li stedObject s) | |
131 | wDump(oRef ,level,nam e,listedOb jects) ; | |
132 | n classNa me,oClass, oProperty, propertyId ,propertyV alue | |
133 | s level=$ g(level,0) | |
134 | s name=$g (name,"") | |
135 | ; | |
136 | i '$$oRef Exists(oRe f) w !,oRe f," is not an object reference " q | |
137 | ; | |
138 | s classNa me=oRef.%C lassName(1 ) ; Full n ame | |
139 | ; | |
140 | s oClass= ##class(%L ibrary.Com piledClass ).%OpenId( className) | |
141 | ; | |
142 | w !,$$ind ent(level) | |
143 | i name'=" " w name," = " | |
144 | w "[",oRe f,"]",$$ge tId(oRef) | |
145 | ; | |
146 | ; If obje ct not alr eady liste d then dis play its p roperties | |
147 | ; (this a voids recu rsion and repetition ) | |
148 | i '$d(lis tedObjects (oRef)) d | |
149 | . s liste dObjects(o Ref)="" | |
150 | . f prope rtyId=1:1: oClass.Pro perties.Co unt() d | |
151 | . . s oPr operty=oCl ass.Proper ties.GetAt (propertyI d) | |
152 | . . d pro perty(oRef ,oProperty ,level) | |
153 | ; | |
154 | d oClass. %Close() | |
155 | q | |
156 | property(o Ref,oPrope rty,level) ; | |
157 | n oChild, oChildErro r | |
158 | ; | |
159 | ; Suppres s % proper ties | |
160 | i $e(oPro perty.Name ,1)="%" q | |
161 | ; | |
162 | i $$isDat aType(oPro perty.Type ) d | |
163 | . ; It's a datatype property | |
164 | . i oProp erty.Multi Dimensiona l=1 d mult iDimension al(oRef,oP roperty,le vel) q | |
165 | . i oProp erty.Colle ction="lis t" d colle ctionList( oRef,oProp erty,level ) q | |
166 | . i oProp erty.Colle ction="arr ay" d arra y(oRef,oPr operty,lev el) q | |
167 | . i oProp erty.Colle ction="bin arystream" d binaryS tream(oRef ,oProperty ,level) q | |
168 | . i oProp erty.Colle ction="cha racterstre am" d char acterStrea m(oRef,oPr operty,lev el) q | |
169 | . i oProp erty.Colle ction="" d none(oRef ,oProperty ,level) q | |
170 | . w !,$$i ndent(leve l+1),oProp erty.Name, " = ","Unk nown colle ction type : ",oPrope rty.Collec tion q | |
171 | d | |
172 | . ; It's a referenc e property | |
173 | . n id | |
174 | . d prope rtyAccesso r(oRef,oPr operty.Nam e,.id,.oCh ild) | |
175 | . ; | |
176 | . ; If th ere is no swizzled i nstance th en try to get it | |
177 | . i $isob ject($g(oC hild))'=1, $g(id)'="" s oChild= $classmeth od(oProper ty.Type,"% OpenId",id ) | |
178 | . ; | |
179 | . ; If th ere is sti ll no inst ance then just name it | |
180 | . i $isob ject($g(oC hild))'=1 d q | |
181 | . . w !,$ $indent(le vel+1) | |
182 | . . w oPr operty.Nam e," = [",o Property.T ype,"]" | |
183 | . ; | |
184 | . ; There is an ins tance, so list the w hole objec t | |
185 | . d wDump (oChild,le vel+1,oPro perty.Name ,.listedOb jects) | |
186 | q | |
187 | */ | |
188 | ; Write a ll local v ariables a nd/or one/ all open o bject inst ances | |
189 | write(vari able) ; | |
190 | i variabl e'="" d | |
191 | . i $$oRe fExists(va riable) d wDump(vari able) i 1 | |
192 | . e w $$ zzlist(var iable) | |
193 | e d | |
194 | . d write Orefs | |
195 | . d local s | |
196 | q | |
197 | ||
198 | ; Dump an object | |
199 | ; Usage: | |
200 | ; d wDum p(oRef,lev el,name,.l istedObjec ts) | |
201 | wDump(oRef ,level,nam e,listedOb jects) ; | |
202 | n classNa me,oClass, oProperty, propertyId ,propertyV alue | |
203 | s level=$ g(level,0) | |
204 | s name=$g (name,"") | |
205 | ; | |
206 | i '$$oRef Exists(oRe f) w !,oRe f," is not an object reference " q | |
207 | ; | |
208 | s classNa me=oRef.%C lassName(1 ) ; Full n ame | |
209 | ; | |
210 | s oClass= ##class(%L ibrary.Com piledClass ).%OpenId( className) | |
211 | ; | |
212 | w !,$$ind ent(level) | |
213 | i name'=" " w name," = " | |
214 | w "[",oRe f,"]",$$ge tId(oRef) | |
215 | ; | |
216 | ; If obje ct not alr eady liste d then dis play its p roperties | |
217 | ; (this a voids recu rsion and repetition ) | |
218 | i '$d(lis tedObjects (oRef)) d | |
219 | . s liste dObjects(o Ref)="" | |
220 | . f prope rtyId=1:1: oClass.Pro perties.Co unt() d | |
221 | . . s oPr operty=oCl ass.Proper ties.GetAt (propertyI d) | |
222 | . . d pro perty(oRef ,oProperty ,level) | |
223 | ; | |
224 | d oClass. %Close() | |
225 | q | |
226 | ; Does oR ef referen ce a valid object in stance? | |
227 | oRefExists (oRef) ; | |
228 | q $zobjstate (oRef) | |
229 | property(o Ref,oPrope rty,level) ; | |
230 | n oChild, oChildErro r | |
231 | ; | |
232 | ; Suppres s % proper ties | |
233 | i $e(oPro perty.Name ,1)="%" q | |
234 | i oProper ty.Name="D isconnecte d" S GLAZ= 1 | |
235 | ; | |
236 | i $$isDat aType(oPro perty.Type ) d | |
237 | . ; It's a datatype property | |
238 | . i oProp erty.Multi Dimensiona l=1 d mult iDimension al(oRef,oP roperty,le vel) q | |
239 | . i oProp erty.Colle ction="lis t" d colle ctionList( oRef,oProp erty,level ) q | |
240 | . i oProp erty.Colle ction="arr ay" d arra y(oRef,oPr operty,lev el) q | |
241 | . i oProp erty.Colle ction="bin arystream" d binary Stream(oRe f,oPropert y,level) q | |
242 | . i oProp erty.Colle ction="cha racterstre am" d cha racterStre am(oRef,oP roperty,le vel) q | |
243 | . i oProp erty.Colle ction="" d none(oRef ,oProperty ,level) q | |
244 | . w !,$$i ndent(leve l+1),oProp erty.Name, " = ","Unk nown colle ction type : ",oPrope rty.Collec tion q | |
245 | e d | |
246 | . ; It's a referenc e property | |
247 | . n id | |
248 | . d prope rtyAccesso r(oRef,oPr operty.Nam e,.id,.oCh ild) | |
249 | . ; | |
250 | . ; If th ere is no swizzled i nstance th en try to get it | |
251 | . i $isob ject($g(oC hild))'=1, $g(id)'="" s oChild= $classmeth od(oProper ty.Type,"% OpenId",id ) | |
252 | . ; | |
253 | . ; If th ere is sti ll no inst ance then just name it | |
254 | . i $isob ject($g(oC hild))'=1 d q | |
255 | . . w !,$ $indent(le vel+1) | |
256 | . . w oPr operty.Nam e," = [",o Property.T ype,"]" | |
257 | . ; | |
258 | . ; There is an ins tance, so list the w hole objec t | |
259 | . d wDump (oChild,le vel+1,oPro perty.Name ,.listedOb jects) | |
260 | q | |
261 | ; Regular Property | |
262 | none(oRef, oProperty, level) ; | |
263 | n propert yValue,pro pertyValue Display,zz listValue | |
264 | d propert yValue(oRe f,oPropert y,.propert yValue,.pr opertyValu eDisplay) | |
265 | s zzlistV alue=$$zzl ist(proper tyValue) | |
266 | ; | |
267 | ; Enquote value if it has a l eading or trailing s pace chara cter | |
268 | i $e(zzli stValue,1) =" "!($e(z zlistValue ,$l(zzlist Value))=" ") s zzlis tValue=$$q uote(zzlis tValue) | |
269 | w !,$$ind ent(level+ 1),oProper ty.Name," = ",zzlist Value | |
270 | i propert yValue'=pr opertyValu eDisplay w " (",prop ertyValueD isplay,")" | |
271 | q | |
272 | ; Get the property value, eve n if priva te (unless it is cal culated an d its Get method is private) | |
273 | ; Derived from Dump ObjectExec ute() in % Studio.Gen eral | |
274 | propertyAc cessor(oRe f,propname ,arr,oChil d) | |
275 | n j,pd,iv ar,slot | |
276 | k arr | |
277 | f j=1:1:$ p($system. CLS.DumpCo ntext(oRef ,0),"^",8) d q:'j | |
278 | . s pd=$s ystem.CLS. Property(j ,oRef,0) | |
279 | . s ivar= $p(pd,"^") | |
280 | . q:propn ame'=ivar | |
281 | . s j=0 | |
282 | . s slot= $p(pd,"^", 2) | |
283 | . m arr=$ zobjval(oR ef,slot,0, 3,slot) | |
284 | . i $zb(+ $p(pd,"^", 3),16,1)=1 6 m oChild =$zobjval( oRef,slot+ 1,0,3,slot +1) | |
285 | q:'j | |
286 | n $et,$es s $et="i '$es s $ec =""""" | |
287 | s arr=$me thod(oRef, propname_" Get") | |
288 | q | |
289 | ||
290 | ; Get the actual va lue and di splay valu e of a pro perty | |
291 | ; If the property d oes not ha ve a displ ay value t hen return the actua l value | |
292 | propertyVa lue(oRef,o Property,p ropertyVal ue,propert yValueDisp lay) ; | |
293 | n arr | |
294 | ; | |
295 | s $zt="pr opertyValu eError1" | |
296 | d propert yAccessor( oRef,oProp erty.Name, .arr) | |
297 | s propert yValue=arr ; This m ay error i f no Get m ethod for property | |
298 | s $zt="pr opertyValu eError2" | |
299 | s @("prop ertyValueD isplay=oRe f."_oPrope rty.Name_" LogicalToD isplay(pro pertyValue )") | |
300 | q | |
301 | ; If a pr operty doe s not have a Get met hod (or so me other p roblem wit h it) then this will happen | |
302 | propertyVa lueError1 ; | |
303 | s $ze="" | |
304 | s propert yValue="<P ROPERTY CA NNOT BE AC CESSED>" | |
305 | s propert yValueDisp lay="<PROP ERTY CANNO T BE ACCES SED>" | |
306 | q | |
307 | ||
308 | ; If a prope rty does n ot have a LogicalToD isplay met hod then t his will h appen | |
309 | propertyVa lueError2 ; | |
310 | s $ze="" | |
311 | s propert yValueDisp lay=proper tyValue | |
312 | q | |
313 | ||
314 | ||
315 | ; List co ntents of a multidim ensional p roperty | |
316 | multiDimen sional(oRe f,oPropert y,level) ; | |
317 | n data,no de | |
318 | ; | |
319 | d propert yAccessor( oRef,oProp erty.Name, .data) | |
320 | w !,$$ind ent(level+ 1),oProper ty.Name," = " | |
321 | W $$zzlis t($g(data, "<UNDEFINE D>")) | |
322 | s node="d ata" | |
323 | f d i n ode="" q | |
324 | . s node= $q(@node) i node="" q | |
325 | . w !,$$i ndent(leve l+2),$e(no de,5,$l(no de))," = " ,$$zzlist( @node) | |
326 | q | |
327 | ||
328 | ; List co ntents of a Collecti on List | |
329 | collection List(oRef, oProperty, level) ; | |
330 | n seq,oLi st | |
331 | ; | |
332 | d propert yAccessor( oRef,oProp erty.Name, .oList) | |
333 | w !,$$ind ent(level+ 1),oProper ty.Name," = [list]" | |
334 | i oList'= "" f seq=1 :1:oList.C ount() d | |
335 | . w !," " ,$$indent( level+2),s eq,": ",$$ zzlist(oLi st.GetAt(s eq)) | |
336 | q | |
337 | ||
338 | ||
339 | ; List co ntents of an Array | |
340 | array(oRef ,oProperty ,level) ; | |
341 | n key,val ue,oArray | |
342 | ; | |
343 | d propert yAccessor( oRef,oProp erty.Name, .oArray) | |
344 | w !,$$ind ent(level+ 1),oProper ty.Name," = [array]" | |
345 | s key="" | |
346 | f d i k ey="" q | |
347 | . s value =oArray.Ge tNext(.key ) i key="" q | |
348 | . w !," " ,$$indent( level+2),k ey,": ",$$ zzlist(val ue) | |
349 | q | |
350 | ||
351 | ||
352 | ; List Bi nary Strea m | |
353 | binaryStre am(oRef,oP roperty,le vel) ; | |
354 | w !,$$ind ent(level+ 1),oProper ty.Name," = [binarys tream]" | |
355 | q | |
356 | ||
357 | ; List Ch aracter St ream | |
358 | characterS tream(oRef ,oProperty ,level) ; | |
359 | w !,$$ind ent(level+ 1),oProper ty.Name," = [charact erstream]" | |
360 | q | |
361 | ||
362 | ; Derive indented s tring | |
363 | indent(lev el) ; | |
364 | n x,inden t | |
365 | s indent= "" | |
366 | f x=1:1:l evel s ind ent=indent _"- " | |
367 | q indent | |
368 | ||
369 | ||
370 | ; Is this pr operty an instance o f a data t ype class or of some other cla ss? | |
371 | isDataType (type) ; | |
372 | n oClass, isDataType | |
373 | i type="" q 1 | |
374 | s oClass= ##class(%C lassDefini tion).%Ope nId(type) | |
375 | s isDataT ype=oClass .Datatype | |
376 | d oClass. %Close() | |
377 | q isDataT ype | |
378 | ||
379 | ; Display Orefs | |
380 | ; Get a r esult set of all ins tantiated objects an d then dum p each one | |
381 | writeOrefs ; | |
382 | n oRef,%o bjlasterro r,listedOb jects | |
383 | ; | |
384 | s oRef="" | |
385 | f d i o Ref="" q | |
386 | . s oRef= $zobjnext( oRef) i oR ef="" q | |
387 | . i '$d(l istedObjec ts(oRef)) d wDump(oR ef,,,.list edObjects) | |
388 | q | |
389 | ||
390 | ||
391 | ; List al l local va riables in the symbo l table | |
392 | ; Indent to indicat e the stac k level | |
393 | ; Display the line and comman d for each stack lev el | |
394 | ; NB igno re NEW fra mes | |
395 | locals ; | |
396 | n frame,v ariable,st ack,extra, frameType, call,line | |
397 | s extra=8 | |
398 | s stack=0 | |
399 | f frame=1 :1:$zu(41) -extra d | |
400 | . s frame Type=$p($z u(41,frame ),"^",1) | |
401 | . i frame Type="d" d | |
402 | . . s lin e=$p($zu(4 1,frame)," ^",2,3) | |
403 | . . i sta ck=0 s lin e="" ; Sup press the obvious | |
404 | . . s cal l=$p($zu(4 1,frame)," ^",5,999) | |
405 | . . i cal l="" q | |
406 | . . s sta ck=stack+1 | |
407 | . . w !,$ tr($j("",s tack-1)," ","-"),lin e,">",call | |
408 | . s varia ble="" | |
409 | . f d i variable= "" q | |
410 | . . s var iable=$zu( 42,frame,v ariable) i variable= "" q | |
411 | . . i $e( variable,1 ,7)="seren ji" q | |
412 | . . i $zu (41,frame, variable)= frame d | |
413 | . . . w ! ,$tr($j("" ,stack)," ","-") | |
414 | . . . i $ isobject($ zu(43,fram e,variable )) w varia ble,"->[", $$zzlist($ zu(43,fram e,variable )),"]",$$g etId($zu(4 3,frame,va riable)) | |
415 | . . . e w variable ,"=",$$zzl ist($zu(43 ,frame,var iable)) | |
416 | q | |
417 | ||
418 | ; Enquote string | |
419 | quote(stri ng) ; | |
420 | n out,q | |
421 | s out="" | |
422 | s q="""" | |
423 | f x=1:1:$ l(string,q ) s out=ou t_q_q_$p(s tring,q,x) | |
424 | q q_$e(ou t,3,$l(out ))_q | |
425 | ||
426 | ; Get the Id of an object if it is pers istent | |
427 | ; Returns " Id = "_ id or null | |
428 | getId(oRef ) ; | |
429 | n classNa me,oClass | |
430 | s classNa me=oRef.%C lassName(1 ) ; Full n ame | |
431 | ; | |
432 | s oClass= ##class(%L ibrary.Com piledClass ).%OpenId( className) | |
433 | ; | |
434 | i oClass. ClassType' ="persiste nt" q "" | |
435 | ; | |
436 | ; May nee d to add e rror trapp ing for th e case whe re the %Id () method is not pre sent or fa ils | |
437 | q " Id = "_oRef.%Id () | |
438 | ||
439 | ; Display copyright message e tc | |
440 | copyRight ; | |
441 | ; DO NOT REMOVE THI S COPYRIGH T MESSAGE | |
442 | i $r(15)' =0 q | |
443 | w !,"==== ========== ========== ========== ===" | |
444 | w !,"Cach ? and Ense mble 2011. x+ Command Line Exte nsions" | |
445 | w !,"Copy right 2001 ,2012 Geor ge James S oftware Li mited" | |
446 | w !,"Visi t www.geor gejames.co m for Tool s, Trainin g and Tech nology" | |
447 | w ! | |
448 | q | |
449 | zzlist(lis t) ; | |
450 | i $d(list )#10=0 q " <UNDEF>" | |
451 | q $$list( list) | |
452 | ; Switch to %SYS na mespace | |
453 | ||
454 | ; Functio n: $ZZLIST () | |
455 | ; Display List in h uman reada ble form ( invoked fr om %LANGF0 0) | |
456 | list(list) ; | |
457 | n out,qui t | |
458 | n listLen gth,item,l istResult | |
459 | ; | |
460 | ; Scan va riable for control c haracters and start of a list | |
461 | s out="" | |
462 | s quit=0 | |
463 | f d i q uit q | |
464 | . i $$isL ist(list) s quit=1 q | |
465 | . i $e(li st,1)?1c s out=out_" \"_$$leftP ad($a(list ,1),3) | |
466 | . e s ou t=out_$e(l ist,1) | |
467 | . s list= $e(list,2, $l(list)) | |
468 | . i list= "" s quit= 1 q | |
469 | i list="" q out | |
470 | ; | |
471 | ; Whats l eft is a l ist | |
472 | s listLen gth=$ll(li st) | |
473 | s listRes ult="" | |
474 | f item=1: 1:listLeng th d | |
475 | . s listR esult=list Result_$$l istItem(li st,item) | |
476 | q out_lis tResult | |
477 | ; Is this variable a list | |
478 | ; If it l ooks like a list the n it is a list | |
479 | ; $ll and $lf dont always fai l even for a valid l ist so hav e to try b oth | |
480 | ; eg $c(7 )_"abc"_$l b(1,2,3) p asses the $ll test b ut fails t he $lf tes t | |
481 | ; $lb( 1,2,3)_"ga ga" p asses the $lf test b ut fails t he $ll tes t | |
482 | isList(var iable) ; | |
483 | s $zt="no tList" | |
484 | i $ll(var iable) ; n oOp | |
485 | i $lf(var iable,"any thing") ; noOp | |
486 | q 1 | |
487 | ||
488 | ; Pad num ber to lef t with zer os | |
489 | leftPad(in teger,leng th) ; | |
490 | i $l(inte ger)>lengt h q intege r | |
491 | q $e(10** length+int eger,2,999 99) | |
492 | ; Variabl e is not a list | |
493 | notList i $ze["<LIST >" s $ze=" " q 0 | |
494 | q $ze | |
495 | ; Format list eleme nt for dis play | |
496 | ; If list element i s *not* de fined then display n othing or <UNDEF> | |
497 | ; Otherwi se evaluat e list ite m as a lis t | |
498 | listItem(l ist,item) ; | |
499 | n listIte m | |
500 | i '$ld(li st,item) q "" ; or a lternative ly: q "["_ item_":<UN DEF>]" | |
501 | s listIte m=$li(list ,item) | |
502 | q "["_ite m_":"_$$zz list(listI tem)_"]" | |
503 | ||
504 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.