Index: cprs/branches/tmg-cprs/CPRS-Chart/Templates/fTemplateDialog.pas =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Templates/fTemplateDialog.pas (revision 698) +++ cprs/branches/tmg-cprs/CPRS-Chart/Templates/fTemplateDialog.pas (revision 729) @@ -47,4 +47,7 @@ FAnswerOpenTag : string; //kt added 12/28/09 FAnswerCloseTag : string; //kt added 12/28/09 + NameToObjID : TStringList; //kt added 3/26/10 + Formulas : TStringList; //kt added 3/26/10 + TxtObjects : TStringList; //kt added 3/28/10 procedure SizeFormToCancelBtn(); procedure ChkAll(Chk: boolean); @@ -81,10 +84,4 @@ frmTemplateDialog: TfrmTemplateDialog; -const - HTMLBEGINNINGTAG = '{HTML:'; //kt - HTMLENDINGTAG = '}'; //kt - HTMLBEGINNINGTAGLEN = length(HTMLBEGINNINGTAG); //kt - HTMLENDINGTAGLEN = length(HTMLENDINGTAG); //kt - implementation @@ -153,9 +150,10 @@ i, j, idx, Indent: integer; DlgProps, Txt: string; + Temp : string; //kt + Changed : boolean; //kt DlgIDCounts: TStringList; DlgInt: TIntStruc; CancelDlg: Boolean; CancelMsg: String; - procedure IncDlgID(var id: string); //Appends an item count in the form of id.0, id.1, id.2, etc @@ -221,5 +219,7 @@ frmTemplateDialog.HTMLAnswerOpenTag := ''; //kt 12/28/09 //SL.Text := RemoveHTMLTags(SL.Text); //elh - AssignFieldIDs(SL); + AssignFieldIDs(SL,frmTemplateDialog.NameToObjID); //kt added NameToObjID param 3/26/10 + HideFormulas(SL,frmTemplateDialog.Formulas); //kt added 3/26/10 + HideTxtObjects(SL,frmTemplateDialog.TxtObjects); //kt added 3/28/10 frmTemplateDialog.SL := SL; frmTemplateDialog.Index := ''; @@ -231,17 +231,13 @@ repeat i := pos(ObjMarker, Txt); - if(i > 1) then - begin + if(i > 1) then begin j := pos(DlgPropMarker, Txt); - if(j > 0) then - begin + if(j > 0) then begin DlgProps := copy(Txt, j + DlgPropMarkerLen, (i - j - DlgPropMarkerLen)); CountDlgProps(DlgProps); - end - else - begin + end else begin DlgProps := ''; j := i; - end; + end; inc(frmTemplateDialog.Count); frmTemplateDialog.Index := frmTemplateDialog.Index + @@ -249,14 +245,14 @@ inc(idx,i+ObjMarkerLen-1); Indent := StrToIntDef(Piece(DlgProps, ';', 5),0); - if(frmTemplateDialog.FirstIndent > Indent) then + if(frmTemplateDialog.FirstIndent > Indent) then begin frmTemplateDialog.FirstIndent := Indent; - end; - if(i > 0) then + end; + end; + if(i > 0) then begin delete(txt, 1, i + ObjMarkerLen - 1); + end; until (i = 0); - if(frmTemplateDialog.Count > 0) then - begin - if(frmTemplateDialog.OneOnly) then - begin + if(frmTemplateDialog.Count > 0) then begin + if(frmTemplateDialog.OneOnly) then begin frmTemplateDialog.btnNone.Visible := FALSE; frmTemplateDialog.btnAll.Visible := FALSE; @@ -264,42 +260,53 @@ frmTemplateDialog.BuildAllControls; repeat - if (assigned(frmNotes)) and (frmTemplateDialog.HTMLMode) then frmNotes.HTMLEditor.SetMsgActive(False); //kt 2-1-10 - frmTemplateDialog.ShowModal; - if (assigned(frmNotes)) and (frmTemplateDialog.HTMLMode) then frmNotes.HTMLEditor.SetMsgActive(True); //kt 2-1-10 - if(frmTemplateDialog.ModalResult = mrOK) then begin - GetText(SL, TRUE); {TRUE = Include embedded fields} - { - if uTemplates.bUsingHTMLMode then begin - SL.Text := FormatHTMLTags(SL.Text); - end else begin - SL.Text := RemoveHTMLTags(SL.Text); - end; - } - end else begin - if (not PreviewMode) and (not frmTemplateDialog.Silent) and (not uInit.TimedOut) then - begin -// CancelMsg := 'If you cancel, your changes will not be saved. Are you sure you want to cancel?'; <-- original line. //kt 8/8/2007 - CancelMsg := DKLangConstW('fTemplateDialog_If_you_cancelx_your_changes_will_not_be_savedx__Are_you_sure_you_want_to_cancelx'); //kt added 8/8/2007 -// if (InfoBox(CancelMsg, 'Cancel Dialog Processing', MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then <-- original line. //kt 8/8/2007 - if (InfoBox(CancelMsg, DKLangConstW('fTemplateDialog_Cancel_Dialog_Processing'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then //kt added 8/8/2007 - begin - SL.Clear; - Result := TRUE; - CancelDlg := TRUE; - end - else - CancelDlg := FALSE; - end - else - begin + if (assigned(frmNotes)) and (frmTemplateDialog.HTMLMode) then frmNotes.HTMLEditor.SetMsgActive(False); //kt 2-1-10 + frmTemplateDialog.ShowModal; + if (assigned(frmNotes)) and (frmTemplateDialog.HTMLMode) then frmNotes.HTMLEditor.SetMsgActive(True); //kt 2-1-10 + if(frmTemplateDialog.ModalResult = mrOK) then begin + //kt -- begin mod -- 3/27/10 + Changed := RestoreTransformTxtObjects(SL, frmTemplateDialog.TxtObjects, frmTemplateDialog.NameToObjID); + Changed := RestoreTransformFormulas(SL, frmTemplateDialog.Formulas, frmTemplateDialog.NameToObjID) or Changed; + if Changed then begin //kt 3/27/10 + Txt := SL.Text; + i := pos(ObjMarker, Txt); + if(i > 1) then begin + j := pos(DlgPropMarker, Txt); + if (j <= 0) then j := i; + Temp := frmTemplateDialog.Index; + SetPiece(Temp,'~',2,IntToStr(j-1)); + frmTemplateDialog.Index := Temp; + end; + end; + //kt -- end mod -- + GetText(SL, TRUE); {TRUE = Include embedded fields} + { + if uTemplates.bUsingHTMLMode then begin + SL.Text := FormatHTMLTags(SL.Text); + end else begin + SL.Text := RemoveHTMLTags(SL.Text); + end; + } + end else begin + if (not PreviewMode) and (not frmTemplateDialog.Silent) and (not uInit.TimedOut) then begin +// CancelMsg := 'If you cancel, your changes will not be saved. Are you sure you want to cancel?'; <-- original line. //kt 8/8/2007 + CancelMsg := DKLangConstW('fTemplateDialog_If_you_cancelx_your_changes_will_not_be_savedx__Are_you_sure_you_want_to_cancelx'); //kt added 8/8/2007 +// if (InfoBox(CancelMsg, 'Cancel Dialog Processing', MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then <-- original line. //kt 8/8/2007 + if (InfoBox(CancelMsg, DKLangConstW('fTemplateDialog_Cancel_Dialog_Processing'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then begin //kt added 8/8/2007 SL.Clear; Result := TRUE; CancelDlg := TRUE; + end else begin + CancelDlg := FALSE; end; - end; + end else begin + SL.Clear; + Result := TRUE; + CancelDlg := TRUE; + end; + end; until CancelDlg or (frmTemplateDialog.ModalResult = mrOK) - end - else + end else begin SL.Clear; + end; finally //frmTemplateDialog.Free; v22.11e RV @@ -324,5 +331,5 @@ tempString := Txt; //here we will strip out all HTML formatting tags //elh - beginning := pos(HTMLBEGINNINGTAG, tempString); + beginning := pos(HTML_BEGIN_TAG, tempString); if beginning = 0 then begin Result := Txt; @@ -331,9 +338,9 @@ begin tempResult := tempResult + Leftstr(tempString,beginning-1); - tempString := Rightstr(tempString,length(tempString)-beginning-HTMLBEGINNINGTAGLEN); - ending := pos(HTMLENDINGTAG, tempString); + tempString := Rightstr(tempString,length(tempString)-beginning-HTML_BEGIN_TAGLEN); + ending := pos(HTML_ENDING_TAG, tempString); tempString := Rightstr(tempString,length(tempString)-ending); - beginning := pos(HTMLBEGINNINGTAG, tempString); - // tempString := Midstr(Txt,i,HTMLBEGINNINGTAGLEN); + beginning := pos(HTML_BEGIN_TAG, tempString); + // tempString := Midstr(Txt,i,HTML_BEGIN_TAGLEN); end; Result := tempResult + tempString; @@ -348,5 +355,5 @@ tempString := Txt; //here we will strip out all HTML formatting tags //elh - beginning := pos(HTMLBEGINNINGTAG, tempString); + beginning := pos(HTML_BEGIN_TAG, tempString); if beginning = 0 then begin Result := Txt; @@ -355,10 +362,10 @@ begin tempResult := tempResult + Leftstr(tempString,beginning-1); - tempString := Rightstr(tempString,length(tempString)-beginning-HTMLBEGINNINGTAGLEN+1); - ending := pos(HTMLENDINGTAG, tempString); + tempString := Rightstr(tempString,length(tempString)-beginning-HTML_BEGIN_TAGLEN+1); + ending := pos(HTML_ENDING_TAG, tempString); tempResult := tempResult + Leftstr(tempString,ending-1); tempString := Rightstr(tempString,length(tempString)-ending); - beginning := pos(HTMLBEGINNINGTAG, tempString); - // tempString := Midstr(Txt,i,HTMLBEGINNINGTAGLEN); + beginning := pos(HTML_BEGIN_TAG, tempString); + // tempString := Midstr(Txt,i,HTML_BEGIN_TAGLEN); end; Result := tempResult + tempString; @@ -565,5 +572,5 @@ end; tmp := copy(SL.Text, p1, p2); - tmp := RemoveHTMLTags(tmp); + tmp := RemoveHTMLTags(tmp); //kt if(copy(tmp, length(tmp)-1, 2) = CRLF) then delete(tmp, length(tmp)-1, 2); @@ -747,4 +754,7 @@ Entries := TStringList.Create; NoTextID := TStringList.Create; + NameToObjID := TStringList.Create ; //kt + Formulas := TStringList.Create ; //kt + TxtObjects := TStringList.Create; //kt added 3/28/10 FOldHintEvent := Application.OnShowHint; Application.OnShowHint := AppShowHint; @@ -774,4 +784,7 @@ Entries.Free; BuildIdx.Free; + NameToObjID.Free; //kt + Formulas.Free; //kt + TxtObjects.Free; //kt end; Index: cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplateFields.pas =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplateFields.pas (revision 698) +++ cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplateFields.pas (revision 729) @@ -6,5 +6,5 @@ uses Forms, SysUtils, StrUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs, - Graphics, ORClasses, ComCtrls, ORDtTm; + Graphics, ORClasses, ComCtrls, ORDtTm, uEvaluate; type @@ -166,7 +166,14 @@ function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry; procedure FreeEntries(SL: TStrings); -procedure AssignFieldIDs(var Txt: string); overload; -procedure AssignFieldIDs(SL: TStrings); overload; +//kt 3/26/10 --> original procedure AssignFieldIDs(var Txt: string); overload; +procedure AssignFieldIDs(var Txt: string; NameToObjID : TStringList=nil); overload; //kt 3/26/10 +//kt 3/26/10 --> original procedure AssignFieldIDs(SL: TStrings); overload; +procedure AssignFieldIDs(SL: TStrings; NameToObjID : TStringList=nil); overload; //kt 3/26/10 +procedure HideFormulas(SL : TStrings; Formulas : TStringList); //kt added 3/26/10 +procedure HideTxtObjects(SL : TStrings; TxtObjects : TStringList); //kt added 3/28/10 +//function RestoreTransformFormulas(var Txt : string; Formulas, NameToObjID : TStringList) : boolean; overload; //kt added 3/26/10 +function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; {overload; }//kt added 3/26/10 //kt 12/28/09 originial --> function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string; +function RestoreTransformTxtObjects(SL : TStrings; TxtObjects, NameToObjID : TStringList) : boolean; function ResolveTemplateFields(Text: string; AutoWrap: boolean; @@ -190,12 +197,52 @@ procedure ConvertCodes2Text(sl: TStrings; Short: boolean); function StripEmbedded(iItems: string): string; +function CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer; //kt added + +type + TMGExtension = (tmgeFN,tmgeOBJ); + TMGExtMatch = record + Signature : string; + SigLen : integer; + EndTag : char; + end; + TMGExtArray = array[tmgeFN..tmgeOBJ] of TMGExtMatch; const TemplateFieldBeginSignature = '{FLD:'; TemplateFieldEndSignature = '}'; - HTMLBEGINNINGTAG = '{HTML:'; - HTMLENDINGTAG = '}'; - HTMLBEGINNINGTAGLEN = length(HTMLBEGINNINGTAG); - HTMLENDINGTAGLEN = length(HTMLENDINGTAG); + HTML_BEGIN_TAG = '{HTML:'; //kt + HTML_ENDING_TAG = '}'; //kt + HTML_BEGIN_TAGLEN = length(HTML_BEGIN_TAG); //kt + HTML_ENDING_TAGLEN = length(HTML_ENDING_TAG); //kt + FN_BEGIN_SIGNATURE = '{FN:'; //kt + FN_BEGIN_TAG = '{'; //kt + FN_END_TAG = '}'; //kt + FN_BEGIN_SIGNATURE_LEN = length(FN_BEGIN_SIGNATURE);//kt + FN_END_TAGLEN = length(FN_END_TAG); //kt + FN_SHOW_TEXT = '{%_____%-#'; //kt + FN_SHOW_TEXT_END = '}'; //kt + FN_SHOW_TEXT_LEN = length(FN_SHOW_TEXT); //kt + FN_SHOW_TEXT_END_LEN = length(FN_SHOW_TEXT_END);//kt + FN_FIELD_TAG = '[FLD:'; //kt + FN_FIELD_TAG_LEN = length(FN_FIELD_TAG); //kt + FN_OBJ_TAG = '[OBJ:'; //kt + FN_OBJ_TAG_LEN = length(FN_OBJ_TAG); //kt + FLD_OBJ_SIGNATURE = '{OBJ:'; //kt + FLD_OBJ_END_TAG = '}'; //kt + FLD_OBJ_SIG_LEN = length(FLD_OBJ_SIGNATURE); //kt + OBJ_SHOW_TEXT = '{OBJ%_____%-#'; //kt + OBJ_SHOW_TEXT_END = '}'; //kt + OBJ_SHOW_TEXT_LEN = length(OBJ_SHOW_TEXT); //kt + TMG_MATCH : TMGExtArray = + ( (Signature : FN_BEGIN_SIGNATURE; + SigLen : FN_BEGIN_SIGNATURE_LEN; + EndTag : FN_END_TAG), + + (Signature : FLD_OBJ_SIGNATURE; + SigLen : FLD_OBJ_SIG_LEN; + EndTag : FLD_OBJ_END_TAG) + ); + + //MissingFieldsTxt = 'One or more required fields must still be entered.'; <-- original line. //kt 8/8/2007 function MissingFieldsTxt : string; //kt added @@ -289,4 +336,6 @@ uses ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows, + ORNet, //kt + TRPCB, //kt DKLang; //kt @@ -296,5 +345,4 @@ TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature); - var uTmplFlds: TList = nil; @@ -305,4 +353,6 @@ uInternalFieldIDCount: integer = 0; + uInternalFormulaCount: integer = 0; //kt + uInternalTxtObjCount : integer = 0; //kt const @@ -416,29 +466,38 @@ if(uEntries.Count = 0) then uInternalFieldIDCount := 0; - end; -end; - -procedure AssignFieldIDs(var Txt: string); + uInternalFormulaCount := 0; //kt + uInternalTxtObjCount := 0; //kt + end; +end; + +//kt original line --> procedure AssignFieldIDs(var Txt: string); +procedure AssignFieldIDs(var Txt: string; NameToObjID : TStringList); //kt var i: integer; + p2 : integer; //kt + FldName : string; //kt + FldID : string; //kt begin i := 0; - while (i < length(Txt)) do - begin + while (i < length(Txt)) do begin inc(i); - if(copy(Txt,i,TemplateFieldSignatureLen) = TemplateFieldBeginSignature) then - begin + if copy(Txt,i,TemplateFieldSignatureLen) = TemplateFieldBeginSignature then begin inc(i,TemplateFieldSignatureLen); - if(i < length(Txt)) and (copy(Txt,i,1) <> FieldIDDelim) then - begin + if(i < length(Txt)) and (copy(Txt,i,1) <> FieldIDDelim) then begin + p2 := PosEx(TemplateFieldEndSignature,Txt,i); //kt + FldName := ''; //kt + if p2 > 0 then FldName := Trim(copy(Txt,i,(p2-i))); //kt insert(GetNewFieldID, Txt, i); inc(i, FieldIDLen); - end; - end; - end; -end; - -procedure AssignFieldIDs(SL: TStrings); + if (FldName <> '') and Assigned(NameToObjID) then begin //kt + NameToObjID.AddObject(FldName,Pointer(uInternalFieldIDCount)); //kt + end; //kt + end; + end; + end; +end; + +procedure AssignFieldIDs(SL: TStrings; NameToObjID : TStringList); var i: integer; @@ -449,8 +508,377 @@ begin txt := SL[i]; - AssignFieldIDs(txt); + //kt AssignFieldIDs(txt); + AssignFieldIDs(txt, NameToObjID); //kt SL[i] := txt; end; end; + +function CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer; +//kt added function +//Return the position of a closing character, ignoring all intervening nested open and close chars +//NOTE: It is expected that StartingPos is pointing to the first opening character. +var i : integer; + CloseMatchesNeeded : integer; +begin + Result := 0; + CloseMatchesNeeded := 1; + for i := StartingPos to Length(Txt) do begin + if (Txt[i] = OpenChar) and (i <> StartingPos) then Inc(CloseMatchesNeeded); + if Txt[i] = CloseChar then Dec(CloseMatchesNeeded); + if CloseMatchesNeeded = 0 then begin + Result := i; + break; + end; + end; +end; + + +procedure HideFormulas(SL : TStrings; Formulas : TStringList); +//kt added function +//NOTE: formulas will not be allowed to use the '}' character +var p1,p2 : integer; + FnStr : string; + SubStrA,SubStrB : string; + Txt : String; +begin + Txt := SL.Text; + p1 := Pos(FN_BEGIN_SIGNATURE,Txt); + while (p1>0) do begin + SubStrA := MidStr(Txt,1,p1-1); + p1 := p1 + FN_BEGIN_SIGNATURE_LEN; + //p2 := PosEx(FN_END_TAG,Txt,p1); + p2 := CloseCharPos(FN_BEGIN_TAG, FN_END_TAG, Txt, p1); + SubStrB := MidStr(Txt,p2+1,999); + FnStr := MidStr(Txt,p1, (p2-p1)); + FnStr := AnsiReplaceText(FnStr,#9,''); + FnStr := AnsiReplaceText(FnStr,#10,''); + FnStr := AnsiReplaceText(FnStr,#13,''); + //FnStr := AnsiReplaceText(FnStr,' ',''); + inc(uInternalFormulaCount); + Formulas.AddObject(FnStr,Pointer(uInternalFormulaCount)); + Txt := SubStrA + FN_SHOW_TEXT + IntToStr(uInternalFormulaCount) + FN_SHOW_TEXT_END + SubStrB; + p1 := PosEx(FN_BEGIN_SIGNATURE,Txt,p1); + end; + SL.Text := Txt; +end; + +procedure HideTxtObjects(SL : TStrings; TxtObjects : TStringList); //kt added 3/28/10 +//kt added function +var p1,p2 : integer; + FnStr : string; + SubStrA,SubStrB : string; + Txt : String; +begin + Txt := SL.Text; + p1 := Pos(FLD_OBJ_SIGNATURE,Txt); + while (p1>0) do begin + SubStrA := MidStr(Txt,1,p1-1); + p1 := p1 + FN_OBJ_TAG_LEN; + p2 := CloseCharPos(FN_BEGIN_TAG, FN_END_TAG, Txt, p1); + SubStrB := MidStr(Txt,p2+1,999); + FnStr := MidStr(Txt,p1, (p2-p1)); + FnStr := AnsiReplaceText(FnStr,#9,''); + FnStr := AnsiReplaceText(FnStr,#10,''); + FnStr := AnsiReplaceText(FnStr,#13,''); + inc(uInternalTxtObjCount); + TxtObjects.AddObject(FnStr,Pointer(uInternalTxtObjCount)); + Txt := SubStrA + OBJ_SHOW_TEXT + IntToStr(uInternalTxtObjCount) + OBJ_SHOW_TEXT_END + SubStrB; + p1 := PosEx(FLD_OBJ_SIGNATURE,Txt,p1); + end; + SL.Text := Txt; +end; + +function InsideMarkers(var S : string; MarkerCh : char; P : integer) : boolean; +//Function returns if position P is inside characters MarkerCh. +//e.g. S = 'xxx|xxxxx|xxxxx' MarkerCh='|' +// P = 2 ==> result is false +// P = 5 ==> result is true +// P = 12 ==> result is false + +var p1,p2 : integer; + Inside : boolean; +begin + Inside := false; + p1 := Pos(MarkerCh,S); + while (p1 > 0) do begin + if (p1 >= P) then break; + p1 := PosEx(MarkerCh,S,p1+1); + if (p1 > 0) and (p1 > P) then Inside := not Inside; + end; + Result := Inside; +end; + +function SubstuteIDs(Txt : string; NameToObjID : TStringList) : string; +//kt added function +//Prefix any field names with their FldID's, in format of FieldIDDelim+FldID +// E.g. [FLD:1:NUM1-16] --> `00001NUM1-16` +//Note: Field ID's are started with character FieldIDDelim, and are of a fixed length (FieldIDLen) + +(* Syntax examples: + + {FN:[FLD:1:NUMB1-16]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or + {FN:[OBJ:TABLE1]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or + {FN:[OBJ:TABLE2("POTASSIUM")]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or + {FN:[OBJ:TABLE2([FLD:1:NUMB1-16])]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]} + {FN:[OBJ:TABLE2((5+3)/2)]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]} + (arbitrary deep nesting) + Note: arguments should be round by matching [ ]'s + An argument will start with a TYPE (so far, FLD or OBJ) and ':' + + If TYPE is FLD, there will be :number:, with number being same + as number in old format (i.e. ...]#2). + If number not provided, then default value is 1 + + If TYPE is OBJ, then this indicates that the parameter name (e.g. TABLE) is + the name of a TIU TEXT object, that will be processed on the server. + Parameters should be resolved before passing to the server. +*) + +var i,j,p1,p2 : integer; + SubStrA,SubStrB, NumStr : string; + FldIDNum,CountofSimilar : integer; + FldIDNumStr : string; + CountOfSimStr : string; + Temp,FldName : string; + Skip : boolean; +begin + for i := 0 to NameToObjID.Count-1 do begin + CountofSimilar := 0; + FldName := NameToObjID.Strings[i]; + for j := 0 to i do begin + if NameToObjID.Strings[i] = FldName then inc(CountofSimilar); + end; + CountOfSimStr := IntToStr(CountofSimilar); + FldIDNum := Integer(NameToObjID.Objects[i]); + FldIDNumStr := IntToStr(FldIDNum); + FldIDNumStr := FieldIDDelim + StringOfChar('0', FieldIDLen-1-Length(FldIDNumStr)) + FldIDNumStr; + p1 := 1; + p1 := PosEx(FldName,Txt,p1); + while InsideMarkers(Txt, FieldIDDelim, p1) do begin //Ignore included fieldnames from prior cycle. + p2 := PosEx(FieldIDDelim,Txt,p1+1); + if p2 >0 then begin + p1 := p2+1; + p1 := PosEx(FldName,Txt,p1); + end else p1 := 999; //error condition. + end; + while (p1>0) and (p1 < 999) do begin + Skip := false; + SubStrA := MidStr(Txt,1,p1-1); + SubStrB := MidStr(Txt, p1+Length(FldName), 999); + if (LeftStr(SubStrB,1)=']') and (Pos(FN_FIELD_TAG,SubStrA) > 0) then begin + NumStr := piece(RightStr(SubStrA,7),':',2); + SubStrA := LeftStr(SubStrA,Length(SubStrA)-7); + p2 := 2; + SubStrB := MidStr(SubStrB,p2,999); + if NumStr <> CountOfSimStr then begin + Skip := true; + Inc(p1); + end; + end else begin + Skip := true; + Inc(p1); + end; + if not Skip then begin + Txt := SubStrA + FldIDNumStr +FldName + FieldIDDelim; + p1 := Length(Txt); + Txt := Txt + SubStrB; + end; + p1 := PosEx(FldName,Txt,p1); + end; + end; + Result := Txt; +end; + + +function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; +//kt added 3/26/10 +//Returns if any changes made +//Replace formula text back in, and change field names into FldID's + + function GetFormula(NumStr : string) : string; + //Return formula text based on provided index number of formula + var num, i : integer; + PtrNum : Pointer; + begin + Result := ''; + try + Num := StrToInt(NumStr); + PtrNum := Pointer(Num); + for i := 0 to Formulas.Count-1 do begin + if Formulas.Objects[i] = PtrNum then begin + Result := Formulas.Strings[i]; + break; + end; + end; + except + on EConvertError do Result := '??'; + end; + end; + +var p1,p2 : integer; + count : integer; + FnStr : string; + Txt : string; + SubStrA,SubStrB : string; +begin + Txt := SL.Text; + Result := false; + p1 := Pos(FN_SHOW_TEXT,Txt); + while (p1>0) do begin + SubStrA := MidStr(Txt,1,p1-1); + p1 := p1 + FN_SHOW_TEXT_LEN; + p2 := PosEx(FN_SHOW_TEXT_END,Txt,p1); + SubStrB := MidStr(Txt,p2+1,999); + FnStr := MidStr(Txt,p1, (p2-p1)); + FnStr := GetFormula(FnStr); + FnStr := SubstuteIDs(FnStr,NameToObjID); + Txt := SubStrA + FN_BEGIN_SIGNATURE + FnStr + FN_END_TAG + SubStrB; + Result := true; + p1 := PosEx(FN_SHOW_TEXT,Txt,p1); + end; + SL.Text := Txt; +end; + +{ +function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; overload; +//kt added 3/26/10 +//Returns if any changes made +var + i: integer; + Changed : boolean; + txt: string; + +begin + Result := false; + for i := 0 to SL.Count-1 do begin + txt := SL[i]; + Changed := RestoreTransformFormulas(txt, Formulas, NameToObjID); + Result := Result or Changed; + SL[i] := txt; + end; +end; +} + +function RestoreTransformTxtObjects(SL : TStrings; TxtObjects, NameToObjID : TStringList) : boolean; +//kt added 3/28/10 +//Returns if any changes made +//Replace formula text back in, and change field names into FldID's + + function GetTxtObjects(NumStr : string) : string; + //Return TxtObject text based on provided index number of formula + var num, i : integer; + PtrNum : Pointer; + begin + Result := ''; + try + Num := StrToInt(NumStr); + PtrNum := Pointer(Num); + for i := 0 to TxtObjects.Count-1 do begin + if TxtObjects.Objects[i] = PtrNum then begin + Result := TxtObjects.Strings[i]; + break; + end; + end; + except + on EConvertError do Result := '??'; + end; + end; + +var p1,p2 : integer; + count : integer; + ObjStr : string; + SubStrA,SubStrB : string; + Txt : string; +begin + Txt := SL.Text; + Result := false; + p1 := Pos(OBJ_SHOW_TEXT,Txt); + while (p1>0) do begin + SubStrA := MidStr(Txt,1,p1-1); + p1 := p1 + OBJ_SHOW_TEXT_LEN; + p2 := PosEx(OBJ_SHOW_TEXT_END,Txt,p1); + SubStrB := MidStr(Txt,p2+1,999); + ObjStr := MidStr(Txt,p1, (p2-p1)); + ObjStr := GetTxtObjects(ObjStr); + ObjStr := SubstuteIDs(ObjStr,NameToObjID); + Txt := SubStrA + FLD_OBJ_SIGNATURE + ObjStr + FLD_OBJ_END_TAG + SubStrB; + Result := true; + p1 := PosEx(OBJ_SHOW_TEXT,Txt,p1); + end; + SL.Text := Txt; +end; + + +function GetRPCTIUObj(TIUObjName : string) : string; +//kt added entire function 3/28/10 +//Based on rTemplates.GetTemplateText(BoilerPlate: TStrings); +begin + TIUObjName := AnsiReplaceText(TIUObjName,'|',''); + with RPCBrokerV do begin + ClearParameters := True; + RemoteProcedure := 'TIU TEMPLATE GETTEXT'; + Param[0].PType := literal; + Param[0].Value := Patient.DFN; + Param[1].PType := literal; + Param[1].Value := Encounter.VisitStr; + Param[2].PType := list; + Param[2].Mult[IntToStr(1)+',0'] := '|' + TIUObjName + '|'; + CallBroker; + RPCBrokerV.Results.Delete(0); + if RPCBrokerV.Results.count > 0 then begin + Result := RPCBrokerV.Results.Strings[0]; + end else Result := ''; + RPCBrokerV.Results.Clear; + end; +end; + + +Procedure EvalTIUObjects(var Formula : string); +//kt added entire function 3/28/10 +var p1,p2 : integer; + OP1,OP2 : integer; + Problem : boolean; + SubStrA, SubStrB : string; + TIUObj,Argument,s : string; +begin + p1 := Pos(FN_OBJ_TAG, Formula); + while (p1 > 0) do begin + p2 := CloseCharPos('[',']',Formula, p1+1); + if p2=0 then begin + Formula := 'ERROR. Matching "]" not found after ' + FN_OBJ_TAG + '.'; + Exit; + end; + SubStrA := MidStr(Formula,1,p1-1); + p1 := p1+FN_OBJ_TAG_LEN; + TIUObj := Trim(MidStr(Formula, p1, (p2-p1))); + SubStrB := MidStr(Formula,p2+1,999); + OP1 := Pos('{',TIUObj); + if (OP1 > 0) then begin + OP2 := CloseCharPos('{','}', TIUObj, OP1+1); + if OP2=0 then begin + Formula := 'ERROR. Matching ")" not found after "(".'; + Exit; + end; + Argument := MidStr(TIUObj,OP1+1,(OP2-(OP1+1))); + if Pos(FN_OBJ_TAG,Argument)>0 then begin + EvalTIUObjects(Argument) + end; + Problem := false; + s := FloatToStr(StringEval(Argument,Problem)); + if Problem then begin + Formula := 'ERROR evaluating argument: [' + s + '].'; + Exit; + end else begin + Argument := s; + end; + TIUObj := MidStr(TIUObj,1,OP1-1) + '{' + Argument + '}'; + end; + TIUObj := GetRPCTIUObj(TIUObj); + Formula := SubStrA + TIUObj + SubStrB; + p1 := Pos(FN_OBJ_TAG, Formula); + end; +end; + + procedure WordWrapText(var Txt: string; HTMLMode : boolean); @@ -561,7 +989,11 @@ Entry: TTemplateDialogEntry; iField, Temp, NewTxt, Fld: string; - FoundEntry: boolean; + FoundEntry,Problem: boolean; TmplFld: TTemplateField; tempSL : TStringList; + SubStrA, SubStrB : string; //kt + ExtMode : TMGExtension; //kt + TempStr, FnObjStr,Argument : string; //kt + FnP1,FnP2,p1,p2 : integer; //kt procedure AddNewTxt; @@ -648,4 +1080,77 @@ end; until(i = 0); + + //kt -- begin mod --- Entire section added. + Temp := Result; + for ExtMode := tmgeFN to tmgeOBJ do begin + repeat + i := pos(TMG_MATCH[ExtMode].Signature, Temp); + if(i > 0) then begin + FnP1 := i; + FnP2 := CloseCharPos('{', TMG_MATCH[ExtMode].EndTag, Temp, i); + //FnP2 := Pos(TMG_MATCH[ExtMode].EndTag,Temp); //Should use CloseCharPos function + p1 := FnP1 + TMG_MATCH[ExtMode].SigLen; + FnObjStr := MidStr(Temp, p1, FnP2-p1); + p1 := Pos(FieldIDDelim,FnObjStr); + while (p1 > 0) do begin + SubStrA := MidStr(FnObjStr,1,p1-1); + p2 := PosEx(FieldIDDelim,FnObjStr,p1+1); + Argument := MidStr(FnObjStr,p1+1,(p2-p1)-1); + SubStrB := MidStr(FnObjStr,p2+1,999); + CtrlID := StrToIntDef(MidStr(Argument,1,FieldIDLen-1), 0); + Fld := MidStr(Argument,FieldIDLen,999); + if(CtrlID > 0) then begin + FoundEntry := FALSE; + for j := 0 to uEntries.Count-1 do begin + Entry := TTemplateDialogEntry(uEntries.Objects[j]); + if(assigned(Entry)) then begin + if IncludeEmbedded then + iField := Fld + else + iField := ''; + NewTxt := Entry.GetControlText(CtrlID, FALSE, FoundEntry, AutoWrap, iField); + TmplFld := GetTemplateField(Fld, FALSE); + if (assigned(TmplFld)) and (TmplFld.DateType in DateComboTypes) then {if this is a TORDateBox} + NewTxt := Piece(NewTxt,':',1); {we only want the first piece of NewTxt} + Argument := Trim(NewTxt); + end; + end; + end else Argument := '??'; + FnObjStr := SubStrA + Argument + SubStrB; + p1 := Pos(FieldIDDelim,FnObjStr); + end; + if (ExtMode = tmgeOBJ) then begin + FnObjStr := FN_OBJ_TAG + FnObjStr + ']'; + end; + if (Pos(FN_OBJ_TAG,FnObjStr)>0) then begin + EvalTIUObjects(FnObjStr); + end; + if ExtMode = tmgeFN then begin + Problem := false; + TempStr := AnsiReplaceText(FnObjStr,' ',''); + TempStr := FloatToStr(StringEval(TempStr,Problem)); + if not Problem then FnObjStr := TempStr; + end; + SubStrA := MidStr(Temp,1,FnP1-1); + SubStrB := MidStr(Temp,FnP2+1,999); + if (HTMLMode=true) and (FnObjStr <> '') then begin + FnObjStr := HTMLAnswerOpenTag + FnObjStr + HTMLAnswerCloseTag; + end; + Temp := SubStrA + FnObjStr + SubStrB; + end else begin + if HTMLMode=true then begin + tempSL := TStringList.create; + tempSL.Text := Result; + if tempSL.Count < 3 then begin + Result := HTMLAnswerOpenTag + Result + HTMLAnswerCloseTag; + end; + tempSL.Free; + end; + end; + until(i = 0); + end; + Result := Temp; + //kt -- end mod -- + if not AutoWrap then WordWrapText(Result,HTMLMode); @@ -660,4 +1165,5 @@ Temp, NewTxt, FldName: string; FoundEntry: boolean; + SubStrA,SubStrB : string; begin @@ -2510,4 +3016,9 @@ end; +function EvaluateFormula(formula : string): string; +begin +//CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer; +end; + initialization