Procedure

TfrmdlgProb.FormShow

Module

fProbEdt

Last Modified

7/15/2014 3:26:38 PM

Visibility

Public/Published

Owner

TfrmdlgProb

Declaration

procedure FormShow(Sender: TObject);

Calls Hierarchy


TfrmdlgProb.FormShow
 ├TfrmdlgProb.SetFontSize
 ├EditLoad
 ├TfrmdlgProb.SetDefaultProb
 │ ├TPLPt.Today
 │ │ └FMToday
 │ │   └FMNow
 │ ├Permanent
 │ └TEncounter.GetICDVersion
 │   └FMNow
 ├TProbRec.Create
 │ ├TProbRec.CreateFields
 │ ├TProbRec.LoadField
 │ │ └GetOrigVal
 │ └TProbRec.LoadComments
 │   └TComment.Create
 ├TKeyVal.DHCPtoKeyVal
 ├TEncounter.GetProviderName
 │ └TEncounter.UpdateText
 │   └GetEncounterText
 ├TProbRec.GetOnsetDatstr
 ├TProbRec.GetStatus
 ├TProbRec.GetPriority
 ├TProbRec.GetRecDatstr
 ├TProbRec.GetModDatstr
 ├TProbRec.GetResDatstr
 ├TfrmdlgProb.ckTreatments
 ├TProbRec.GetSCProblem
 ├TProbRec.GetAOProblem
 ├TProbRec.GetRADProblem
 ├TProbRec.GetENVProblem
 ├TProbRec.GetSHADProblem
 ├TProbRec.GetMSTProblem
 ├TProbRec.GetHNCProblem
 ├PersonHasKey
 ├TfrmdlgProb.ShowServiceCombo
 ├TfrmdlgProb.ShowClinicLocationCombo
 ├IsClinicLoc
 ├TfrmdlgProb.ShowComments
 └TProbRec.GetCondition

Calls

Name Declaration Comments
TfrmdlgProb.ckTreatments procedure ckTreatments(value: String; ckBox: Integer); -
TProbRec.Create constructor Create(AList:TstringList); -
TKeyVal.DHCPtoKeyVal procedure DHCPtoKeyVal(DHCPFld:String); -
EditLoad function EditLoad(ProblemIFN: string; ProviderID: int64; ptVAMC: string): TStrings ; -
TProbRec.GetAOProblem Function GetAOProblem:String; -
TProbRec.GetCondition function GetCondition:string; -
TProbRec.GetENVProblem Function GetENVProblem:String; -
TProbRec.GetHNCProblem Function GetHNCProblem:String; -
TProbRec.GetModDatstr function GetModDatstr:string; -
TProbRec.GetMSTProblem Function GetMSTProblem:String; -
TProbRec.GetOnsetDatstr function GetOnsetDatstr:string; -
TProbRec.GetPriority function GetPriority:String; -
TEncounter.GetProviderName function GetProviderName: string; -
TProbRec.GetRADProblem Function GetRADProblem:String; -
TProbRec.GetRecDatstr function GetRecDatstr:string; -
TProbRec.GetResDatstr function GetResDatstr:string; -
TProbRec.GetSCProblem Function GetSCProblem:String; -
TProbRec.GetSHADProblem Function GetSHADProblem:String; -
TProbRec.GetStatus function GetStatus:String; -
IsClinicLoc function IsClinicLoc(ALoc: integer): boolean; -
PersonHasKey function PersonHasKey(APerson: Int64; const AKey: string): Boolean; -
TfrmdlgProb.SetDefaultProb procedure SetDefaultProb(Alist:TstringList;prob:string); -
TfrmdlgProb.SetFontSize procedure SetFontSize( NewFontSize: integer); -
TfrmdlgProb.ShowClinicLocationCombo procedure ShowClinicLocationCombo; -
TfrmdlgProb.ShowComments procedure ShowComments; -
TfrmdlgProb.ShowServiceCombo procedure ShowServiceCombo; -


Source

378   procedure TfrmdlgProb.FormShow(Sender: TObject);
379   var
380     alist: TstringList;
381     Anchorses: Array of TAnchors;
382     i: integer;
383   begin
384     if ProbRec <> nil then exit;
385     if (ResizeWidth(Font,MainFont,Width) >= Parent.ClientWidth) and
386       (ResizeHeight(Font,MainFont,Height) >= Parent.ClientHeight) then
387     begin  //This form won't fit when it resizes, so we have to take Drastic Measures
388       SetLength(Anchorses, dlgProbs.ControlCount);
389       for i := 0 to ControlCount - 1 do
390       begin
391         Anchorses[i] := Controls[i].Anchors;
392         Controls[i].Anchors := [akLeft, akTop];
393       end;
394       SetFontSize(MainFontSize);
395       RequestAlign;
396       for i := 0 to ControlCount - 1 do
397         Controls[i].Anchors := Anchorses[i];
398     end
399     else
400     begin
401       SetFontSize(MainFontSize);
402       RequestAlign;
403     end;
404     frmProblems.mnuView.Enabled := False;
405     frmProblems.mnuAct.Enabled := False ;
406     frmProblems.lstView.Enabled := False;
407     frmProblems.bbNewProb.Enabled := False ;
408     Alist := TstringList.create;
409     try
410       if Reason = 'E' then
411         lblact.caption := 'Editing:'
412       else if Reason = 'A' then
413         lblact.caption := 'Adding'
414       else {display, comment edit or remove problem}
415         begin
416           case reason of 'C','c': lblact.caption := 'Comment Edit';
417                          'R','r': lblact.caption := 'Remove Problem:';
418           end; {case}
419           {ckVerify.Enabled:=false;}
420           cbProv.Enabled       := false;
421           cbLoc.Enabled        := false;
422           bbRemove.enabled     := false;
423           rgStatus.Enabled     := false;
424           rgStage.Enabled      := false;
425           edRecdate.enabled    := false;
426           edResdate.enabled    := false;
427           edOnsetDate.enabled  := false;
428           ckYSC.enabled         := false;
429           ckYRAD.enabled        := false;
430           ckYAO.enabled         := false;
431           ckYENV.enabled        := false;
432           ckYHNC.enabled        := false;
433           ckYMST.enabled        := false;
434           ckYSHAD.enabled       := false;
435           ckNSC.enabled         := false;
436           ckNRAD.enabled        := false;
437           ckNAO.enabled         := false;
438           ckNENV.enabled        := false;
439           ckNHNC.enabled        := false;
440           ckNMST.enabled        := false;
441           ckNSHAD.enabled       := false;
442           if Reason = 'R' then bbFile.caption := 'Remove';
443         end;
444       edProb.Caption := lblact.Caption;
445       edProb.Text := Piece(subjProb, u, 2);
446   
447       if Piece(subjProb, '|', 2) <> '' then
448         FSearchString := Piece(subjProb, '|', 2);
449   
450       {line up problem action and title}
451       {edProb.Left:=lblAct.left+lblAct.width+2;}
452       {get problem}
453       if Reason <> 'A' then
454         begin {edit,remove or display existing problem}
455           problemIFN := Piece(subjProb, u, 1);
456           FastAssign(EditLoad(ProblemIFN, User.DUZ, PLPt.ptVAMC), AList) ;   //V17.5   RV
457         end
458       else {new  problem}
459         SetDefaultProb(Alist, subjProb);
460       if Alist.count = 0 then
461         begin
462           InfoBox('No Data on Host for problem ' + ProblemIFN, 'Information', MB_OK or MB_ICONINFORMATION);
463           close;
464           exit;
465         end;
466       ProbRec := TProbRec.Create(Alist); {create a problem object}
467       ProbRec.PIFN := ProblemIFN;
468       ProbRec.EnteredBy.DHCPtoKeyVal(inttostr(User.DUZ) + u + User.Name);
469       ProbRec.RecordedBy.DHCPtoKeyVal(inttostr(Encounter.Provider) + u + Encounter.ProviderName);
470       {fill in defaults}
471       edOnsetdate.text := ProbRec.DateOnsetStr;
472       if Probrec.status <> 'A' then
473         begin
474           rgStatus.itemindex := 1;
475           rgStage.Visible := False ;
476         end;
477       if Probrec.Priority = 'A' then
478         rgStage.itemindex := 0
479       else if Probrec.Priority = 'C' then
480         rgStage.itemindex := 1
481       else
482         rgStage.itemindex := 2;
483       rgStatus.TabStop := (rgStatus.ItemIndex = -1);
484       rgStage.TabStop := (rgStage.ItemIndex = -1);
485       edRecDate.text := Probrec.DateRecStr;
486       edUpdate.text := Probrec.DateModStr;
487       edResDate.text := ProbRec.DateResStr;
488       edUpdate.enabled := false;
489       if pos(Reason,'CR') = 0 then
490         with PLPt do
491           begin
492             if PtServiceConnected then
493             begin
494               ckYSC.Enabled := True;
495               ckNSC.Enabled := True;
496               ckTreatments(ProbRec.SCProblem,0);
497             end
498             else
499             begin
500               ckYSC.Enabled := False;
501               ckNSC.Enabled := False;
502             end;
503   
504             if PtAgentOrange then
505             begin
506               ckYAO.Enabled := True;
507               ckNAO.Enabled := True;
508               ckTreatments(ProbRec.AOProblem,1);
509             end
510             else
511             begin
512               ckYAO.Enabled := False;
513               ckNAO.Enabled := False;
514             end;
515   
516             if PtRadiation then
517             begin
518               ckYRad.Enabled := True;
519               ckNRad.Enabled := True;
520               ckTreatments(Probrec.RADProblem,2);
521             end
522             else
523             begin
524               ckYRad.Enabled := False;
525               ckNRad.Enabled := False;
526             end;
527   
528             if PtEnvironmental then
529             begin
530               ckYENV.Enabled := True;
531               ckNENV.Enabled := True;
532               ckTreatments(ProbRec.ENVProblem,3);
533             end
534             else
535             begin
536               ckYENV.Enabled := False;
537               ckNENV.Enabled := False;
538             end;
539   
540             if PtSHAD then
541             begin
542               ckYSHAD.Enabled := True;
543               ckNSHAD.Enabled := True;
544               ckTreatments(ProbRec.SHADProlem,4);
545             end
546             else
547             begin
548               ckYSHAD.Enabled := False;
549               ckNSHAD.Enabled := False;
550             end;
551   
552             if PtMST then
553             begin
554               ckYMST.Enabled := True;
555               ckNMST.Enabled := True;
556               ckTreatments(ProbRec.MSTProblem,5);
557             end
558             else
559             begin
560               ckYMST.Enabled := False;
561               ckNMST.Enabled := False;
562             end;
563   
564             if PtHNC then
565             begin
566               ckYHNC.Enabled := True;
567               ckNHNC.Enabled := True;
568               ckTreatments(ProbRec.HNCProblem,6);
569             end
570             else
571             begin
572               ckYHNC.Enabled := False;
573               ckNHNC.Enabled := False;
574             end;
575           end ;
576   
577       {cbProv.InitLongList(ProbRec.RespProvider.extern) ;
578       if (ProbRec.RespProvider.intern <> '') and (StrToInt64Def(ProbRec.RespProvider.intern, 0) > 0) then
579         cbProv.SelectByIEN(StrToInt64(ProbRec.RespProvider.intern));}
580   
581       if (Encounter.Provider > 0) and PersonHasKey(Encounter.Provider, 'PROVIDER') then
582         begin
583           cbProv.InitLongList(Encounter.ProviderName);
584           cbProv.SelectByIEN(Encounter.Provider);
585         end
586       else cbProv.InitLongList('');
587   
588   
589       if UpperCase(Reason) = 'A' then
590         begin
591           if Encounter.Inpatient then
592             begin
593               ShowServiceCombo();
594               cbServ.InitLongList('');
595             end
596           else
597             begin
598               ShowClinicLocationCombo();
599               cbLoc.InitLongList(Encounter.LocationName);
600               cbLoc.SelectByIEN(Encounter.Location);
601             end;
602         end
603       else
604         begin
605           {if (ProbRec.Service.DHCPField = '^') and  (ProbRec.Clinic.DHCPField <> '^') then
606             begin
607               ShowClinicLocationCombo();
608               cbLoc.InitLongList(ProbRec.Clinic.Extern);
609               cbLoc.SelectByID(ProbRec.Clinic.Intern);
610             end
611           else if (ProbRec.Clinic.DHCPField = '^') and  (ProbRec.Service.DHCPField <> '^') then
612             begin
613               ShowServiceCombo();
614               cbServ.InitLongList(ProbRec.Service.Extern);
615               cbServ.SelectByID(ProbRec.Service.Intern);
616             end
617           else}
618           if Encounter.Inpatient then
619             begin
620               ShowServiceCombo();
621               cbServ.InitLongList('');
622             end
623           else if (Encounter.Location > 0) and IsClinicLoc(Encounter.Location) then
624             begin
625               ShowClinicLocationCombo();
626               cbLoc.InitLongList(Encounter.LocationName);
627               cbLoc.SelectByIEN(Encounter.Location);
628             end
629           else
630             begin
631               ShowClinicLocationCombo();
632               cbLoc.InitLongList('');
633             end;
634         end;
635       cbLoc.Caption := lblLoc.Caption;
636   
637       ShowComments;
638       if ProbRec.CmtIsXHTML then
639         begin
640           bbAdd.Enabled := FALSE;
641           bbEdit.Enabled := FALSE;
642           bbRemove.Enabled := FALSE;
643           pnlComments.Hint := ProbRec.CmtNoEditReason;
644         end
645       else
646         begin
647           bbAdd.Enabled := TRUE;
648           bbEdit.Enabled := TRUE;
649           bbRemove.Enabled := TRUE;
650           pnlComments.Hint := '';
651         end ;
652      // ===================  changed code - REV 7/30/98  =========================
653      // PlUser.usVerifyTranscribed is a SITE requirement, not a user ability
654       if Reason = 'A' then
655         begin
656           if PlUser.usVerifyTranscribed and not PlUser.usPrimeUser then
657             ckVerify.Checked := False
658           else
659             ckVerify.Checked := True;
660         end
661       else ckVerify.checked := (Probrec.condition = 'P');
662      //===========================================================================
663      (* if (PlUSer.usVerifyTranscribed) and (Reason='A') then
664         begin {some users can add and verify}
665           {ckVerify.visible:=true;}
666           ckVerify.checked:=true; {assume it will be entered verified}
667         end {others can add and edit verified status}
668       else if (PlUSer.usVerifyTranscribed) and (PlUser.usPrimeUser) then
669         begin
670           {ckVerify.visible:=true; }
671           ckVerify.checked:=(Probrec.condition='P');
672         end;  *)
673       if Reason <> 'A' then fChanged := False else fChanged := True; {initialize form for changes}
674       if rgStatus.ItemIndex = -1 then
675         InitialFocus := rgStatus
676       else
677         InitialFocus := rgStatus.Buttons[rgStatus.ItemIndex] as TWinControl;
678     finally
679       alist.free;
680     end;
681   end;