Procedure

AttachPLTFactorsToDx

Module

UBACore

Last Modified

7/15/2014 3:26:34 PM

Scope

Interfaced

Declaration

procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string);

Calls Hierarchy


AttachPLTFactorsToDx
 └ProcessProblemTFactors

Called-By Hierarchy


                                                AttachPLTFactorsToDx
                          TfrmBALocalDiagnoses.AddProbsToDiagnosis┘ 
                          TfrmBALocalDiagnoses.LoadEncounterForm┘   
                               TfrmBALocalDiagnoses.MainDriver┤     
                             TfrmBALocalDiagnoses.FormCreate┘ │     
TfrmBALocalDiagnoses.AddDiagnosistoPersonalDiagnosesList1Click┤     
TfrmBALocalDiagnoses.AddDiagnosistoPersonalDiagnosesList2Click┘     

Calls

Name Declaration Comments
ProcessProblemTFactors function ProcessProblemTFactors(pText:String):String; -

Called-By

Name Declaration Comments
TfrmBALocalDiagnoses.AddProbsToDiagnosis procedure AddProbsToDiagnosis; -


Source

593   procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string);
594   var
595       TFResults: string;
596       thisRec: TBAPLFactorsIN;
597   begin
598       TFResults := '';
599       thisRec := TBAPLFactorsIN.Create;
600       thisRec.FBADxText            := Piece(ProblemRec,'(',1);
601       thisRec.FBADxText            := Piece(thisRec.FBADxText,U,2);
602       thisRec.FBADxCode            := Piece(ProblemRec,U,3);
603       thisRec.FBASC                := Piece(ProblemRec,U,5);
604       thisRec.FBASC_YN             := Piece(ProblemRec,U,6);
605       //HDS8409
606       if StrPos(PChar(ProblemRec),'(') <> nil then
607          thisRec.FBATreatFactors :=  ProcessProblemTFactors(ProblemRec)
608       else
609       begin
610          thisRec.FBATreatFactors  := Piece(ProblemRec,')',1);
611          thisRec.FBATreatFactors  := Piece(thisRec.FBATreatFactors,'(',2);
612       end;
613       //HDS8409
614     with thisRec do
615     begin
616         if StrLen(pchar(FBATreatFactors)) > 0 then   // 0 Treatment Factors exist
617         //build string containing Problem List Treatment Factors
618           TFResults := ( FBADXCode + U + FBADxText  + '  (' + FBASC + '/' + FBATreatFactors + ')  ' )
619         else
620           if StrLen(PChar(FBASC)) > 0 then
621              TFResults := ( FBADxCode + U + FBADxText  + '  (' + FBASC + ')  ' )
622           else
623              TFResults := ( FBADxCode + U  + FBADxText );
624     end;
625   
626       Dest := TFResults;
627   end;