Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XINDX13

XINDX13.m

Go to the documentation of this file.
  1. XINDX13 ; OSE/SMH - Input, Print, and Sort Template Analysis;03/01/2018 8:37 AM
  1. ;;7.3;TOOLKIT;**140**;Apr 25, 1995;Build 40
  1. ; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; This routine finds non-self files that are pointed to by a template
  1. ; EPs DIPTM and DIETM support XINDX12 in finding M code in Input and
  1. ; Print templates.
  1. ;
  1. ALL(path) ; [Public] Export all template CSV files at once to a specific dir
  1. I $G(path)="" S path=$$DEFDIR^%ZISH()
  1. D DIBT(path),DIET(path),DIPT(path)
  1. Q
  1. ;
  1. DIBT(path,filename) ; [Public] Sort template analysis
  1. N outputData
  1. I $G(path)="" S path=$$DEFDIR^%ZISH()
  1. I $G(filename)="" S filename="DIBTOUT.csv"
  1. D DIBTCOL(.outputData)
  1. D DIBTOUT(.outputData,path,filename)
  1. Q
  1. ;
  1. DIET(path,filename) ; [Public] Input template analysis
  1. N outputData
  1. I $G(path)="" S path=$$DEFDIR^%ZISH()
  1. I $G(filename)="" S filename="DIETOUT.csv"
  1. D DIETCOL(.outputData)
  1. D DIETOUT(.outputData,path,filename)
  1. Q
  1. ;
  1. DIPT(path,filename) ; [Public] Print template analysis
  1. N outputData
  1. I $G(path)="" S path=$$DEFDIR^%ZISH()
  1. I $G(filename)="" S filename="DIPTOUT.csv"
  1. D DIPTCOL(.outputData)
  1. D DIPTOUT(.outputData,path,filename)
  1. Q
  1. ;
  1. DIBTCOL(outputData) ; [Private] Sort Template Data Collection
  1. ; for each template
  1. N dibt F dibt=0:0 S dibt=$O(^DIBT(dibt)) Q:'dibt D
  1. . Q:'$D(^DIBT(dibt,0)) ; get valid ones only
  1. . N name,file,isSort,line
  1. . S name=$P(^DIBT(dibt,0),U),file=$P(^DIBT(dibt,0),U,4)
  1. . S isSort=$O(^DIBT(dibt,2,0)) ; make sure they are sort templates
  1. . I 'isSort Q
  1. . ;
  1. . ; walk through each field
  1. . F line=0:0 S line=$O(^DIBT(dibt,2,line)) Q:'line D
  1. .. N lineData,lineFile,lineField,lineFieldSpec
  1. .. ; We have some variances on how the data is stored (lines below)
  1. .. S:$D(^DIBT(dibt,2,line))#2 lineData=^(line)
  1. .. S:$D(^DIBT(dibt,2,line,0))#2 lineData=^(0)
  1. .. ;
  1. .. ; some vital data
  1. .. S lineFile=$P(lineData,U)
  1. .. I '$D(^DD(lineFile)) Q ; bad DD
  1. .. S lineField=$P(lineData,U,2),lineFieldSpec=$P(lineData,U,3)
  1. .. ;
  1. .. ; if it's the same file, and not a relational field, we are not interested
  1. .. I lineFile=file,(lineFieldSpec'[":"&(lineFieldSpec'[" IN ")) Q
  1. .. ;
  1. .. ; if the parent is the same file, and ditto, we are still not interested
  1. .. I $$PARENT(lineFile)=file,(lineFieldSpec'[":"&(lineFieldSpec'[" IN ")) Q
  1. .. ;
  1. .. ; We are interested
  1. .. ; Do we have the field?
  1. .. I lineField="" D
  1. ... ; no we don't so get the fields using DICOMP
  1. ... N X,pairs,pair
  1. ... D EXPR^DICOMP(lineFile,"dmFITSL",lineFieldSpec)
  1. ... I '$D(X) Q
  1. ... ; X("USED")="404.51^.07;404.57^.02"
  1. ... I X("USED")="" Q ; not an expression that uses fields
  1. ... F pairs=1:1:$L(X("USED"),";") D
  1. .... S pair=$P(X("USED"),";",pairs)
  1. .... N thisFile,thisField
  1. .... S thisFile=$P(pair,U,1),thisField=$P(pair,U,2)
  1. .... I thisFile=file Q
  1. .... S outputData(file,thisFile,thisField)=dibt_U_name
  1. .. ; we have a field. Take it at face value
  1. .. E S outputData(file,lineFile,lineField)=dibt_U_name
  1. Q
  1. ;
  1. DIBTOUT(outputData,outputPath,outputFile) ; [Private] Sort Template Data Output
  1. N POP
  1. D OPEN^%ZISH("file1",outputPath,outputFile,"W")
  1. I POP Q
  1. U IO
  1. N c,file,dstFile,dstField,dibtIEN,dibtName
  1. S c=","
  1. W "SORT TEMPLATE IEN,SORT TEMPLATE NAME,SOURCE FILE,DESTINATION FILE,DESTINATION FIELD",!
  1. F file=0:0 S file=$Q(outputData(file)) Q:'file D
  1. . F dstFile=0:0 S dstFile=$O(outputData(file,dstFile)) Q:'dstFile D
  1. .. F dstField=0:0 S dstField=$O(outputData(file,dstFile,dstField)) Q:'dstField D
  1. ... N data S data=outputData(file,dstFile,dstField)
  1. ... S dibtIEN=$P(data,U,1),dibtName=$P(data,U,2)
  1. ... W dibtIEN_c_dibtName_c_file_c_dstFile_c_dstField,!
  1. D CLOSE^%ZISH("file1")
  1. Q
  1. ;
  1. DIETCOL(outputData,mCodeData) ; [Private] Input Template Data Collection
  1. ; for each template
  1. ; s outputData(file,thisFile,thisField)=dibt_U_name
  1. N diet F diet=0:0 S diet=$O(^DIE(diet)) Q:'diet D
  1. . Q:'$D(^DIE(diet,0)) ; get valid ones only
  1. . N name,file,line,lineFile
  1. . S name=$P(^DIE(diet,0),U),file=$P(^DIE(diet,0),U,4)
  1. . ; for each file in the input template
  1. . F line=0:0 S line=$O(^DIE(diet,"DR",line)) Q:line>98!(line="") D ; 99 is reserved for some compiled code
  1. .. F lineFile=0:0 S lineFile=$O(^DIE(diet,"DR",line,lineFile)) Q:'lineFile!(lineFile'=+lineFile) D
  1. ... N fields,fieldIndex,field
  1. ... S fields=^DIE(diet,"DR",line,lineFile)
  1. ... F fieldIndex=1:1:$L(fields,";") D
  1. .... S field=$P(fields,";",fieldIndex)
  1. .... ; various tests for the field
  1. .... Q:field="" ; empty field. Can happen!
  1. .... ;
  1. .... ; FROM X+2^DIA3: Get M field and check it
  1. .... N X S X=field
  1. .... I X'?.E1":" S X=$S(X["//^":$P(X,"//^",2),1:X),X=$S(X[";":$P(X,";"),1:X) D ^DIM
  1. .... I $D(X) S mCodeData(lineFile,line)=X Q
  1. .... ;
  1. .... ; We analyzed the M code; now we just want the dependencies
  1. .... Q:lineFile=file ; DR file same as our file; not interested
  1. .... Q:$$PARENT(lineFile)=file ; ditto, for parent
  1. .... ;
  1. .... ; range like .01:5
  1. .... I $L(field,":")=2,(+$P(field,":"))=$P(field,":") D Q
  1. ..... N start,end,eachField
  1. ..... S start=$P(field,":",1),end=$P(field,":",2)
  1. ..... I $D(^DD(lineFile,start)) S outputData(file,lineFile,start)=diet_U_name
  1. ..... S eachField=start
  1. ..... F S eachField=$O(^DD(lineFile,eachField)) Q:eachField>end!(eachField="") D
  1. ...... S outputData(file,lineFile,eachField)=diet_U_name
  1. .... ;
  1. .... Q:$E(field)="@" ; jump to another place in the template. Not a field
  1. .... S field=+field
  1. .... Q:'$D(^DD(lineFile,field)) ; field doesn't exist
  1. .... S outputData(file,lineFile,field)=diet_U_name
  1. Q
  1. ;
  1. DIETOUT(outputData,outputPath,outputFile) ; [Private] Input Template Data Output
  1. N POP
  1. D OPEN^%ZISH("file1",outputPath,outputFile,"W")
  1. I POP Q
  1. U IO
  1. N c,file,dstFile,dstField,dietIEN,dietName
  1. S c=","
  1. W "INPUT TEMPLATE IEN,INPUT TEMPLATE NAME,SOURCE FILE,DESTINATION FILE,DESTINATION FIELD",!
  1. F file=0:0 S file=$O(outputData(file)) Q:'file D
  1. . F dstFile=0:0 S dstFile=$O(outputData(file,dstFile)) Q:'dstFile D
  1. .. F dstField=0:0 S dstField=$O(outputData(file,dstFile,dstField)) Q:'dstField D
  1. ... N data S data=outputData(file,dstFile,dstField)
  1. ... S dietIEN=$P(data,U,1),dietName=$P(data,U,2)
  1. ... W dietIEN_c_dietName_c_file_c_dstFile_c_dstField,!
  1. D CLOSE^%ZISH("file1")
  1. Q
  1. ;
  1. DIPTCOL(outputData,mCodeData) ; [Private] Print Template Data Collection
  1. ; for each template
  1. N dipt F dipt=0:0 S dipt=$O(^DIPT(dipt)) Q:'dipt D
  1. . Q:'$D(^DIPT(dipt,0)) ; get valid ones only
  1. . N name,file
  1. . S name=$P(^DIPT(dipt,0),U),file=$P(^DIPT(dipt,0),U,4)
  1. . ;
  1. . ;D:$T(^XTMLOG)]"" INITEASY^XTMLOG("C","WARN")
  1. . ; debug
  1. . ; b:name="ZBJM FEE BASIS LIST"
  1. . ; debug
  1. . ;
  1. . ; for each field
  1. . N fileNamePrint,line
  1. . S fileNamePrint=1
  1. . F line=0:0 S line=$O(^DIPT(dipt,"F",line)) Q:'line D
  1. .. N lineContents,fieldDataIndex
  1. .. S lineContents=^DIPT(dipt,"F",line)
  1. .. F fieldDataIndex=1:1:$L(lineContents,"~") D
  1. ... N fieldData,fields
  1. ... S fieldData=$P(lineContents,"~",fieldDataIndex) Q:fieldData=""
  1. ... S fields=$P(fieldData,";")
  1. ... Q:fields=""!(fields=" ")
  1. ... ;
  1. ... ; analyze the fields
  1. ... ;
  1. ... ; See if we have a multiple navigation. These are noted in the first piece
  1. ... ; as a series of numbers like 50,1,2,5...
  1. ... ; don't process these any further if we find them
  1. ... ; We don't process them as they mean we don't branch out to other files
  1. ... ; --we just trace our own file down.
  1. ... N fieldsUpright,fieldIndex,field
  1. ... S fieldsUpright=1 F fieldIndex=1:1:$L(fields,",") D Q:'fieldsUpright
  1. .... S field=$P(fields,",",fieldIndex)
  1. .... S:field'=+field!(field<0) fieldsUpright=0
  1. ... I fieldsUpright Q ;D:$T(^XTMLOG)]"" DEBUG^XTMLOG("Qutting since upright","name,file,fieldData") Q
  1. ... ;
  1. ... ; Exclude transition lines
  1. ... ; We are not interested in the lines that switch files (e.g. in 52: 'PROVIDER:')
  1. ... N ignoreTransition,fieldIndex,field,nextField
  1. ... S ignoreTransition=0 F fieldIndex=1:1:$L(fields,",") D Q:ignoreTransition
  1. .... S field=$P(fields,",",fieldIndex),nextField=$P(fields,",",fieldIndex+1)
  1. .... I $E(nextField)=U S ignoreTransition=1 Q
  1. ... I ignoreTransition Q ;D:$T(^XTMLOG)]"" DEBUG^XTMLOG("Quitting due to context transistion with no fields","name,file,fieldData") Q
  1. ... ;
  1. ... ; If zpiece is defined, then we have a COMPUTED EXPRESSION or M code
  1. ... N Zpiece,i
  1. ... S Zpiece=0 F i=1:1:$L(fieldData,";") I $P(fieldData,";",i)="Z" S Zpiece=i Q
  1. ... ;
  1. ... ; exclude print only fields (quoted values, or literal $C)
  1. ... N printOnlyField
  1. ... S printOnlyField=0
  1. ... I 'Zpiece F fieldIndex=1:1:$L(fields,",") D Q:printOnlyField
  1. .... S field=$P(fields,",",fieldIndex)
  1. .... Q:+field=field ; numeric -- quit -- not a literal
  1. .... I $E(field)="""" S printOnlyField=1
  1. .... I $E(field,1,5)="W $C(" S printOnlyField=1
  1. ... I printOnlyField Q ;D:$T(^XTMLOG)]"" DEBUG^XTMLOG("Quitting for printOnlyField","name,file,fieldData,printOnlyField") Q
  1. ... ;
  1. ... ; This can be a "hidden" M field masqurading
  1. ... N isNonTradMCode S isNonTradMCode=0
  1. ... I 'Zpiece D
  1. .... N p1 S p1=$P(fields,",")
  1. .... Q:+p1=p1 ; Just a normal field
  1. .... N X S X=$P(fields,";") D ^DIM
  1. .... I $D(X) S isNonTradMCode=1
  1. .... ;D:$t(^XTMLOG)]"" WARN^XTMLOG("Treating Print Field as M code","file,fieldData")
  1. .... S mCodeData(+file,line)=X
  1. ... ;
  1. ... ; Don't process any further if non-Traditional M code
  1. ... Q:isNonTradMCode
  1. ... ;
  1. ... ; Now, process non-M code fields
  1. ... ; Best template to test this with: MAGV-PAT-QUERY
  1. ... ; NB: This is a recursive search; each search updates the pointerFile variable
  1. ... ; We only want the last entry in the pointerFile chain to file the data if there
  1. ... ; is a field we want to grab
  1. ... N pointerFile S pointerFile=0
  1. ... I 'Zpiece F fieldIndex=1:1:$L(fields,",") D
  1. .... N field,nextField
  1. .... S field=$P(fields,",",fieldIndex),nextField=$P(fields,",",fieldIndex+1)
  1. .... I field<0 S pointerFile=-field Q
  1. .... I field>0,'pointerFile Q ; field in original file. We are not interested
  1. .... D ASSERT(+pointerFile=pointerFile)
  1. .... D ASSERT(+field=field)
  1. .... ;D:$T(^XTMLOG)]"" INFO^XTMLOG("Num Parsed as:","fieldData,pointerFile,field")
  1. .... I field>0,pointerFile S outputData(file,pointerFile,field)=dipt_U_name
  1. ... I 'Zpiece Q ; can't quit on the for line above
  1. ... ;
  1. ... ; Now, process M code/Copmputed code fields.
  1. ... N exitEarly S exitEarly=0
  1. ... ;
  1. ... ; We are really interested in capturing the computed field information
  1. ... ; (Z piece stuff only)
  1. ... ; Calculate the correct context for the Computed Expression
  1. ... N mCodeContext,mCode
  1. ... S mCode="",mCodeContext=file ; The default
  1. ... N fileField,fileFieldIndex
  1. ... F fileFieldIndex=1:1:$L(fields,",") D Q:mCode]""
  1. .... S fileField=$P(fields,",",fileFieldIndex)
  1. .... I fileField'=+fileField S mCode=$P(fields,",",fileFieldIndex,99) Q
  1. .... ;
  1. .... ; Relational navigation
  1. .... I fileField<0 S mCodeContext=-fileField Q
  1. .... ;
  1. .... ; Subfile processing. Move context to subfile
  1. .... I '$D(^DD(mCodeContext,fileField,0)) S exitEarly=1 D Q ; doesn't exist!
  1. ..... ;D:$T(^XTMLOG)]"" WARN^XTMLOG("^DD("_mCodeContext_","_fileField_",0) does not exist")
  1. .... I fileField>0,$P(^DD(mCodeContext,fileField,0),U,2) S mCodeContext=+$P(^DD(mCodeContext,fileField,0),U,2) Q
  1. ... Q:exitEarly
  1. ... ;D:$t(^XTMLOG)]"" DEBUG^XTMLOG("Context for "_fieldData_" is "_mCodeContext_" and M code is "_mCode)
  1. ... ;
  1. ... ; debug
  1. ... ; w mCodeContext,!
  1. ... ; debug
  1. ... ;
  1. ... ;
  1. ... ; Get the potentially COMPUTED EXPRESSION code for this field
  1. ... N potComputedCode S potComputedCode=$P(fieldData,";",Zpiece+1)
  1. ... S potComputedCode=$E(potComputedCode,2,$L(potComputedCode)-1)
  1. ... ;
  1. ... ; If M Code is broken up, put it back together
  1. ... I $F(mCode,"X DXS") D
  1. .... N startdxs,enddxs,dxsString,s1,s2,dxsCode,%
  1. .... S startdxs=$f(mCode,"DXS")-3,enddxs=$f(mCode,")",startdxs)-1,dxsString=$E(mCode,startdxs,enddxs)
  1. .... S s1=$QS(dxsString,1),s2=$QS(dxsString,2),dxsCode=^DIPT(dipt,"DXS",s1,s2)
  1. .... S %("X "_dxsString)=dxsCode,mCode=$$REPLACE^XLFSTR(mCode,.%)
  1. ... ;
  1. ... ; Is it the same (after removing the quotes) as the MCode?
  1. ... ; If so, then this is not a computed expression
  1. ... ; We can abandon hope of finding what field it refers to.
  1. ... I potComputedCode=mCode D Q
  1. .... S mCodeData(+file,line)=mCode
  1. .... ;D:$T(^XTMLOG)]"" INFO^XTMLOG(fieldData_" in "_file_" considered to be M code")
  1. ...
  1. ... ; debug
  1. ...
  1. ... ; At this point, we think it's a computed expression.
  1. ... ; Lets try to to see
  1. ... N X
  1. ... D EXPR^DICOMP(mCodeContext,"dmFITSL",potComputedCode)
  1. ... I '$D(X) Q ;D:$T(^XTMLOG)]"" ERROR^XTMLOG("Can't resolve "_fieldData_" into fields (context "_mCodeContext_", name "_name_")") Q
  1. ... Q:X("USED")="" ; not an expression that uses fields (NOW, PAGE)
  1. ... ;
  1. ... N pairs,pair F pairs=1:1:$L(X("USED"),";") D
  1. .... S pair=$P(X("USED"),";",pairs)
  1. .... N thisFile,thisField
  1. .... S thisFile=$P(pair,U,1),thisField=$P(pair,U,2)
  1. .... Q:thisFile=file
  1. .... S outputData(file,thisFile,thisField)=dipt_U_name
  1. ;D:$T(^XTMLOG)]"" ENDLOG^XTMLOG()
  1. Q
  1. ;
  1. DIPTOUT(outputData,outputPath,outputFile) ; [Private] Print Template Data Output
  1. N POP
  1. D OPEN^%ZISH("file1",outputPath,outputFile,"W")
  1. I POP Q
  1. U IO
  1. N c,file,dstFile,dstField,dietIEN,dietName
  1. S c=","
  1. W "PRINT TEMPLATE IEN,PRINT TEMPLATE NAME,SOURCE FILE,DESTINATION FILE,DESTINATION FIELD",!
  1. F file=0:0 S file=$O(outputData(file)) Q:'file D
  1. . F dstFile=0:0 S dstFile=$O(outputData(file,dstFile)) Q:'dstFile D
  1. .. F dstField=0:0 S dstField=$O(outputData(file,dstFile,dstField)) Q:'dstField D
  1. ... N data S data=outputData(file,dstFile,dstField)
  1. ... S dietIEN=$P(data,U,1),dietName=$P(data,U,2)
  1. ... W dietIEN_c_dietName_c_file_c_dstFile_c_dstField,!
  1. D CLOSE^%ZISH("file1")
  1. Q
  1. ;
  1. ; DIETM and DIPTM are used by XINDEX to process input and sort templates
  1. ; respectively. XINDEX passes required parameters through the stack instead
  1. ; passed variables.
  1. ;
  1. ; B = {IEN}
  1. ; INDLC = {counter}
  1. ; INDRN = {faux routine prefix}
  1. ; INDC = {IEN} ; {NAME} - {DISPLAY NAME}
  1. ; INDX = {code to be XINDEXED}
  1. ; INDL = {NAME field (.01) of IEN}
  1. DIETM ; [Public] Collect M code fileds from all input templates
  1. ; ZEXCEPT: B,INDX
  1. Q:'$D(^DIE(B,0)) ; get valid ones only
  1. N name,file
  1. S name=$P(^DIE(B,0),U),file=$P(^DIE(B,0),U,4)
  1. ;
  1. ; for each file in the input template
  1. N line,lineFile
  1. F line=0:0 S line=$O(^DIE(B,"DR",line)) Q:line>98!(line="") D ; 99 is reserved for some compiled code
  1. . F lineFile=0:0 S lineFile=$O(^DIE(B,"DR",line,lineFile)) Q:'lineFile!(lineFile'=+lineFile) D
  1. .. N fields,fieldIndex,field
  1. .. S fields=^DIE(B,"DR",line,lineFile) F fieldIndex=1:1:$L(fields,";") D
  1. ... S field=$P(fields,";",fieldIndex)
  1. ... ; various tests for the field
  1. ... Q:field="" ; empty field. Can happen!
  1. ... ;
  1. ... ; FROM X+2^DIA3: Get M field and check it
  1. ... N X S X=field
  1. ... I X'?.E1":" S X=$S(X["//^":$P(X,"//^",2),1:X),X=$S(X[";":$P(X,";"),1:X) D ^DIM
  1. ... ; Add code to be INDEXed
  1. ... I $D(X) S INDX=X D ADDLN^XINDX11
  1. Q
  1. ;
  1. DIPTM ; [Public] Collect M code fields from all print templates
  1. ; ZEXCEPT: B,INDX
  1. Q:'$D(^DIPT(B,0)) ; get valid ones only
  1. N name,file,fileNamePrint,line
  1. S name=$P(^DIPT(B,0),U),file=$P(^DIPT(B,0),U,4)
  1. ;
  1. ; for each field
  1. S fileNamePrint=1
  1. F line=0:0 S line=$O(^DIPT(B,"F",line)) Q:'line D
  1. . N lineContents,fieldDataIndex,fieldData,fields
  1. . S lineContents=^DIPT(B,"F",line)
  1. . F fieldDataIndex=1:1:$L(lineContents,"~") D
  1. .. S fieldData=$P(lineContents,"~",fieldDataIndex)
  1. .. Q:fieldData=""
  1. .. S fields=$P(fieldData,";")
  1. .. Q:fields=""!(fields=" ")
  1. .. ;
  1. .. ; If zpiece is defined, then we have a COMPUTED EXPRESSION or M code
  1. .. N i,Zpiece
  1. .. S Zpiece=0 F i=1:1:$L(fieldData,";") I $P(fieldData,";",i)="Z" S Zpiece=i Q
  1. .. ;
  1. .. ; This can be a "hidden" M field masqurading -- the entire line is M code
  1. .. ; NB: This is rare, but print templates support that.
  1. .. N isNonTradMCode S isNonTradMCode=0
  1. .. I 'Zpiece D
  1. ... N p1,X
  1. ... S p1=$P(fields,",") I +p1=p1 Q ; Just a normal field
  1. ... S X=$P(fields,";") D ^DIM
  1. ... ; Add code to be INDEXed
  1. ... I $D(X) S isNonTradMCode=1 S INDX=X D ADDLN^XINDX11 Q
  1. .. ;
  1. .. Q:isNonTradMCode ; We already have M code. Quit.
  1. .. ;
  1. .. Q:'Zpiece ; Straight field
  1. .. ;
  1. .. ; extract compiled code from file/subfile references
  1. .. N mCode,fileField,fileFieldIndex
  1. .. S mCode=""
  1. .. F fileFieldIndex=1:1:$L(fields,",") D Q:mCode]""
  1. ... S fileField=$P(fields,",",fileFieldIndex)
  1. ... I fileField'=+fileField S mCode=$P(fields,",",fileFieldIndex,99)
  1. .. ;
  1. .. I mCode="" Q ; no compiled code in this field
  1. .. ;
  1. .. ; If zpiece is defined, see if computed expression or M code
  1. .. ; Get the potentially COMPUTED EXPRESSION code for this field
  1. .. N potComputedCode S potComputedCode=$P(fieldData,";",Zpiece+1)
  1. .. S potComputedCode=$E(potComputedCode,2,$L(potComputedCode)-1)
  1. .. ;
  1. .. ; If M Code is broken up, put it back together
  1. .. I $F(mCode,"X DXS") D
  1. ... N startdxs,enddxs,dxsString,s1,s2,dxsCode,%
  1. ... S startdxs=$F(mCode,"DXS")-3,enddxs=$F(mCode,")",startdxs)-1
  1. ... S dxsString=$E(mCode,startdxs,enddxs),s1=$QS(dxsString,1),s2=$QS(dxsString,2)
  1. ... S dxsCode=^DIPT(B,"DXS",s1,s2)
  1. ... S %("X "_dxsString)=dxsCode,mCode=$$REPLACE^XLFSTR(mCode,.%)
  1. .. ;
  1. .. ; Is it the same (after removing the quotes) as the MCode?
  1. .. ; If so, then this is not a computed expression
  1. .. I potComputedCode=mCode D Q
  1. ... N X S X=mCode D ^DIM
  1. ... ; Add code to be INDEXed
  1. ... I $D(X) S INDX=X D ADDLN^XINDX11
  1. Q
  1. ;
  1. PARENT(subfile) ; [Private] Find out who my parent is
  1. ; WARNING: Recursive algorithm
  1. I $D(^DD(subfile,0,"UP")) Q $$PARENT(^("UP"))
  1. Q subfile
  1. ;
  1. ASSERT(x) I 'x S $EC=",u-assert,"
  1. Q
  1. ;