59. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 5/10/2019 1:00:05 PM Eastern Daylight 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.

59.1 Files compared

# Location File Last Modified
1 CPRS_v32_64_P2.zip\OR_30_405V64_SRC.zip\Encounter fDiagnoses.pas Wed Apr 3 19:32:16 2019 UTC
2 CPRS_v32_64_P2.zip\OR_30_405V64_SRC.zip\Encounter fDiagnoses.pas Thu May 9 14:16:26 2019 UTC

59.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 1628
Changed 1 2
Inserted 0 0
Removed 0 0

59.3 Comparison options

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

59.4 Active regular expressions

No regular expressions were active.

59.5 Comparison detail

  1   unit fDiag noses;
  2  
  3   interface
  4  
  5   uses
  6     Windows,  Messages,  SysUtils,  Classes,  Graphics,  Controls,  Forms, Dia logs,
  7     fPCEBase , StdCtrls , CheckLst , ORNet, E xtCtrls, B uttons, uP CE, ORFn,
  8     ComCtrls , fPCEBase Main, UBAG lobals, UB AConst, UC ore, VA508 Accessibil ityManager ,
  9     ORCtrls,  StrUtils;
  10  
  11   type
  12     TfrmDiag noses = cl ass(TfrmPC EBaseMain)
  13       cmdDia gPrimary:  TButton;
  14       ckbDia gProb: TCh eckBox;
  15       proced ure cmdDia gPrimaryCl ick(Sender : TObject) ;
  16       proced ure ckbDia gProbClick ed(Sender:  TObject);
  17       proced ure FormCr eate(Sende r: TObject );
  18       proced ure btnRem oveClick(S ender: TOb ject);
  19       proced ure FormRe size(Sende r: TObject ); overrid e;
  20       proced ure lbxSec tionClickC heck(Sende r: TObject ; Index: I nteger);
  21       proced ure btnOKC lick(Sende r: TObject );  overri de;
  22       proced ure lbSect ionClick(S ender: TOb ject);
  23       proced ure GetEnc ounterDiag noses;
  24       proced ure lbSect ionDrawIte m(Control:  TWinContr ol; Index:  Integer;
  25         Rect : TRect; S tate: TOwn erDrawStat e);
  26       proced ure lbxSec tionDrawIt em(Control : TWinCont rol; Index : Integer;
  27         Rect : TRect; S tate: TOwn erDrawStat e);
  28       proced ure btnOth erClick(Se nder: TObj ect);
  29     private
  30       proced ure Ensure PrimaryDia g;
  31       proced ure GetSCT forICD(ADi agnosis: T PCEDiag);
  32       proced ure Update Problem(Ap lIEN: Stri ng; AICDCo de: String ; ASCTCode : String =  '');
  33       functi on isProbl em(diagnos is: TPCEDi ag): Boole an;
  34       functi on isEncou nterDx(pro blem: stri ng): Boole an;
  35     protecte d
  36       proced ure Update NewItemStr (var x: st ring); ove rride;
  37       proced ure Update Controls;  override;
  38     public
  39     end;
  40  
  41   const
  42     TX_INACT IVE_ICD_CO DE     = ' This probl em referen ces an ICD  code that  is not ac tive as of  the date  of this en counter. '  +
  43                                  ' Please upd ate the IC D Diagnosi s.';
  44     TX_NONSP EC_ICD_COD E      = ' Please ent er a more  specific I CD Diagnos is for thi s problem. ';
  45     TX_INACT IVE_SCT_CO DE     = ' This probl em referen ces a SNOM ED CT code  that is n ot active  as of the  date of th is encount er. ' +
  46                                  ' Please upd ate the SN OMED CT co de.';
  47     TX_INACT IVE_ICD_SC T_CODE = ' This probl em referen ces BOTH a n ICD and  a SNOMED C T code tha t are not  active as  of the dat e ' +
  48                                  ' of this en counter. P lease upda te the cod es now.';
  49     TX_ICD_L ACKS_SCT_C ODE    = ' Addition o f a diagno sis to the  problem l ist requir es a SNOME D CT code.  Please '  +
  50                                  ' select the  SNOMED CT  concept w hich best  describes  the diagno sis: ';
  51     TX_PROB_ LACKS_SCT_ CODE   = ' You''ve se lected to  update a p roblem fro m the Prob lem List w hich now r equires a  SNOMED CT  code. ' +
  52                                  ' Please ent er a SNOME D CT equiv alent term  which bes t describe s the diag nosis: ';
  53  
  54     TC_INACT IVE_CODE          = ' Problem Co ntains Ina ctive Code ';
  55     TC_NONSP EC_CODE           = ' Problem Co ntains Non -Specific  Code';
  56     TC_I10_L ACKS_SCT          = ' SNOMED CT  Needed for  Problem E ntry';
  57  
  58     TX_REDUN DANT_DX           = ' The proble m that you ''ve selec ted is alr eady inclu ded in the  list of d iagnoses '  +
  59                                  ' for this e ncounter.  No need to  select it  again...' ;
  60     TC_REDUN DANT_DX           = ' Redundant  Diagnosis:  ';
  61  
  62     TX_INV_I CD10_DX           = ' The select ed ICD-10- CM diagnos is cannot  be added t o an encou nter prior  to ICD-10  implement ation.' +  CRLF + CRL F +
  63                                  ' Please sel ect a vali d ICD-9-CM  diagnosis  which bes t describe s the diag nosis.';
  64     TC_INV_I CD10_DX           = ' Invalid Se lection';
  65  
  66   var
  67     frmDiagn oses: Tfrm Diagnoses;
  68     dxList :  TStringLi st;
  69     PLUpdate d: boolean  = False;
  70  
  71   implementa tion
  72  
  73   {$R *.DFM}
  74  
  75   uses
  76     fEncount erFrame, u Const, UBA Core, VA50 8Accessibi lityRouter , fPCELex,  rPCE, uPr obs, rProb s, rCore;
  77  
  78   type
  79     TORCBImg Idx = (iiU nchecked,  iiChecked,  iiGrayed,  iiQMark,  iiBlueQMar k,
  80       iiDisU nchecked,  iiDisCheck ed, iiDisG rayed, iiD isQMark,
  81       iiFlat UnChecked,  iiFlatChe cked, iiFl atGrayed,
  82       iiRadi oUnchecked , iiRadioC hecked, ii RadioDisUn checked, i iRadioDisC hecked);
  83  
  84   const
  85     CheckBox ImageResNa mes: array [TORCBImgI dx] of PCh ar = (
  86       'ORCB_ UNCHECKED' , 'ORCB_CH ECKED', 'O RCB_GRAYED ', 'ORCB_Q UESTIONMAR K',
  87       'ORCB_ BLUEQUESTI ONMARK', ' ORCB_DISAB LED_UNCHEC KED', 'ORC B_DISABLED _CHECKED',
  88       'ORCB_ DISABLED_G RAYED', 'O RCB_DISABL ED_QUESTIO NMARK',
  89       'ORLB_ FLAT_UNCHE CKED', 'OR LB_FLAT_CH ECKED', 'O RLB_FLAT_G RAYED',
  90       'ORCB_ RADIO_UNCH ECKED', 'O RCB_RADIO_ CHECKED',
  91       'ORCB_ RADIO_DISA BLED_UNCHE CKED', 'OR CB_RADIO_D ISABLED_CH ECKED');
  92  
  93     BlackChe ckBoxImage ResNames:  array[TORC BImgIdx] o f PChar =  (
  94       'BLACK _ORLB_FLAT _UNCHECKED ', 'BLACK_ ORLB_FLAT_ CHECKED',  'BLACK_ORL B_FLAT_GRA YED',
  95       'BLACK _ORCB_QUES TIONMARK',  'BLACK_OR CB_BLUEQUE STIONMARK' ,
  96       'BLACK _ORCB_DISA BLED_UNCHE CKED', 'BL ACK_ORCB_D ISABLED_CH ECKED',
  97       'BLACK _ORCB_DISA BLED_GRAYE D', 'BLACK _ORCB_DISA BLED_QUEST IONMARK',
  98       'BLACK _ORLB_FLAT _UNCHECKED ', 'BLACK_ ORLB_FLAT_ CHECKED',  'BLACK_ORL B_FLAT_GRA YED',
  99       'BLACK _ORCB_RADI O_UNCHECKE D', 'BLACK _ORCB_RADI O_CHECKED' ,
  100       'BLACK _ORCB_RADI O_DISABLED _UNCHECKED ', 'BLACK_ ORCB_RADIO _DISABLED_ CHECKED');
  101  
  102     PL_ITEMS  = 'Proble m List Ite ms';
  103  
  104   var
  105     ORCBImag es: array[ TORCBImgId x, Boolean ] of TBitM ap;
  106  
  107   function G etORCBBitm ap(Idx: TO RCBImgIdx;  BlackMode : boolean) : TBitmap;
  108   var
  109     ResName:  string;
  110   begin
  111     if (not  assigned(O RCBImages[ Idx, Black Mode])) th en
  112     begin
  113       ORCBIm ages[Idx,  BlackMode]  := TBitMa p.Create;
  114       if Bla ckMode the n
  115         ResN ame := Bla ckCheckBox ImageResNa mes[Idx]
  116       else
  117         ResN ame := Che ckBoxImage ResNames[I dx];
  118       ORCBIm ages[Idx,  BlackMode] .LoadFromR esourceNam e(HInstanc e, ResName );
  119     end;
  120     Result : = ORCBImag es[Idx, Bl ackMode];
  121   end;
  122  
  123   procedure  TfrmDiagno ses.Ensure PrimaryDia g;
  124   var
  125     i: Integ er;
  126     Primary:  Boolean;
  127  
  128   begin
  129     with lst CaptionLis t do
  130     begin
  131       Primar y := False ;
  132       for i  := 0 to It ems.Count  - 1 do
  133         if T PCEDiag(Ob jects[i]). Primary th en
  134           Pr imary := T rue;
  135  
  136       if not  Primary a nd (Items. Count > 0)  then
  137       begin
  138           GridIndex  := Items.C ount - 1;/ /0;  DNS  CQ 15836
  139         TPCE Diag(Objec ts[Items.C ount - 1]) .Primary : = True;
  140         Grid Changed;
  141       end;
  142     end;
  143   end;
  144  
  145   procedure  TfrmDiagno ses.cmdDia gPrimaryCl ick(Sender : TObject) ;
  146   var
  147     gi, i: I nteger;
  148     ADiagnos is: TPCEDi ag;
  149  
  150   begin
  151     inherite d;
  152     gi := Gr idIndex;
  153     with lst CaptionLis t do for i  := 0 to I tems.Count  - 1 do
  154     begin
  155       ADiagn osis := TP CEDiag(Obj ects[i]);
  156       ADiagn osis.Prima ry := (gi  = i);
  157     end;
  158     GridChan ged;
  159   end;
  160  
  161   procedure  TfrmDiagno ses.ckbDia gProbClick ed(Sender:  TObject);
  162   var
  163     i: integ er;
  164   begin
  165     inherite d;
  166     if(NotUp dating) th en
  167     begin
  168       for i  := 0 to ls tCaptionLi st.Items.C ount-1 do
  169       begin
  170         if(l stCaptionL ist.Items[ i].Selecte d) then
  171         begi n
  172           TP CEDiag(lst CaptionLis t.Objects[ i]).AddPro b := (ckbD iagProb.Ch ecked) and
  173                                                             (not is Problem(TP CEDiag(lst CaptionLis t.Objects[ i]))) and
  174                                                             (TPCEDi ag(lstCapt ionList.Ob jects[i]). Category < > PL_ITEMS );
  175           // TODO: Add  check for  I10Active
  176           if  TPCEDiag( lstCaption List.Objec ts[i]).Add Prob and
  177              (Piece(Enc ounter.Get ICDVersion , U, 1) =  '10D') and
  178              (not ((pos ('SCT', TP CEDiag(lst CaptionLis t.Objects[ i]).Narrat ive) > 0)  or
  179              (pos('SNOM ED', TPCED iag(lstCap tionList.O bjects[i]) .Narrative ) > 0))) t hen
  180                GetSCTfo rICD(TPCED iag(lstCap tionList.O bjects[i]) );
  181         end;
  182       end;
  183       GridCh anged;
  184     end;
  185   end;
  186  
  187   procedure  TfrmDiagno ses.FormCr eate(Sende r: TObject );
  188   begin
  189     inherite d;
  190     FTabName  := CT_Dia gNm;
  191     FPCEList CodesProc  := ListDia gnosisCode s;
  192     FPCEItem Class := T PCEDiag;
  193     FPCECode  := 'POV';
  194     FSection TabCount : = 3;
  195     FormResi ze(Self);
  196   end;
  197  
  198   procedure  TfrmDiagno ses.btnOth erClick(Se nder: TObj ect);
  199   var
  200     x, Code,  SCode, Te xt, Captio n: string;
  201     APCEItem : TPCEItem ;
  202     j, SrchC ode: integ er;
  203   //  Match:  boolean;
  204   begin
  205     ClearGri d;
  206     SrchCode  := (Sende r as TButt on).Tag;
  207     if(SrchC ode <= LX_ Threshold)  then Lexi conLookup( Code, Srch Code, 0, F alse, '');
  208     btnOther .SetFocus;
  209     if Code  <> '' then
  210     begin
  211       SCode  := Piece(C ode, U, 1) ;
  212   //    Matc h := False ;
  213       for j  := lstCapt ionList.It ems.Count  - 1 downto  0 do
  214       begin
  215         APCE Item := TP CEItem(lst CaptionLis t.Objects[ j]);
  216         if A PCEItem.Co de = SCode  then
  217         begi n
  218   //         Match := T rue;  // - - value is  never use d
  219           Te xt := '"'  + Piece(Co de, U, 2)  + '" is al ready incl uded in th e list of  selected d iagnoses f or this en counter. P lease sele ct a diffe rent diagn osis...';
  220           Ca ption := ' Duplicate  Diagnosis' ;
  221           In foBox(Text , Caption,  MB_ICONWA RNING or M B_OK);
  222           Ex it;
  223         end
  224       end;
  225   //    if n ot Match t hen
  226       begin
  227         x :=  FPCECode  + U + Piec e(Code, U,  1) + U +  U + Piece( Code, U, 2 );
  228         if F PCEItemCla ss = TPCEP roc then
  229           Se tPiece(x,  U, pnumPro vider, Int ToStr(uPro viders.PCE Provider)) ;
  230         Upda teNewItemS tr(x);
  231         APCE Item := FP CEItemClas s.Create;
  232         APCE Item.SetFr omString(x );
  233         Grid Index := l stCaptionL ist.Add(AP CEItem.Ite mStr, APCE Item);
  234       end;
  235     end;
  236     UpdateCo ntrols;
  237   end;
  238  
  239   procedure  TfrmDiagno ses.btnRem oveClick(S ender: TOb ject);
  240   begin
  241     inherite d;
  242     Sync2Gri d;
  243     EnsurePr imaryDiag;
  244   end;
  245  
  246   procedure  TfrmDiagno ses.Update NewItemStr (var x: st ring);
  247   begin
  248     inherite d;
  249     if lstCa ptionList. Items.Coun t = 0 then
  250       x := x  + U + '1'
  251     else
  252       x := x  + U + '0' ;
  253   end;
  254  
  255   procedure  TfrmDiagno ses.Update Problem(Ap lIEN: Stri ng; AICDCo de: String ; ASCTCode : String =  '');
  256   var
  257     AList: T StringList ;
  258     ProbRec:  TProbRec;
  259     CodeSysS tr: String ;
  260     DateOfIn t: TFMDate Time;
  261   begin
  262     // Updat e problem  list entry  with new  ICD (& SCT ) code(s)  (& narrati ve).
  263     AList :=  TStringLi st.create;
  264     try
  265       EditLo ad(aList,A plIEN);
  266       ProbRe c := TProb Rec.create (AList);
  267       ProbRe c.PIFN :=  AplIEN;
  268  
  269       if AIC DCode <> ' ' then
  270       begin
  271         Prob Rec.Diagno sis.DHCPto KeyVal(Pie ces(AICDCo de, U, 1,  2));
  272         Code SysStr :=  Piece(AICD Code, U, 4 );
  273         if ( Pos('10',  CodeSysStr ) > 0) the n
  274           Co deSysStr : = '10D^ICD -10-CM'
  275         else
  276           Co deSysStr : = 'ICD^ICD -9-CM';
  277         Prob Rec.CodeSy stem.DHCPt oKeyVal(Co deSysStr);
  278       end;
  279  
  280       if ASC TCode <> ' ' then
  281       begin
  282         Prob Rec.SCTCon cept.DHCPt oKeyVal(Pi eces(ASCTC ode, U, 1,  2));
  283         //TO DO: need t o accommod ate change s to Desig nation Cod e
  284         Prob Rec.Narrat ive.DHCPto KeyVal(U +  Piece(ASC TCode, U,  3));
  285         Prob Rec.SCTDes ignation.D HCPtoKeyVa l(Piece(AS CTCode, U,  4) + U +  Piece(ASCT Code, U, 4 ));
  286       end;
  287  
  288       ProbRe c.RespProv ider.DHCPt oKeyVal(In tToStr(Enc ounter.Pro vider) + u  + Encount er.Provide rName);
  289       if Enc ounter.Dat eTime = 0  then DateO fInt := FM Now
  290       else D ateOfInt : = Encounte r.DateTime ;
  291       ProbRe c.CodeDate Str := For matFMDateT ime('mm/dd /yy', Date OfInt);
  292       AList. Clear;
  293       EditSa ve(aList,P robRec.PIF N, User.DU Z, User.St ationNumbe r, '1', Pr obRec.File rObject, ' ');
  294     finally
  295       AList. clear;
  296     end;
  297   end;
  298  
  299   function T frmDiagnos es.isProbl em(diagnos is: TPCEDi ag): Boole an;
  300   var
  301     i: integ er;
  302     p, code,  narr, sct : String;
  303   begin
  304     result : = false;
  305     for i :=  0 to FPro blems.Coun t - 1 do
  306     begin
  307       p := F Problems[i ];
  308       code : = piece(p,  '^', 1);
  309       narr : = piece(p,  '^', 2);
  310       if (po s('SCT', n arr) > 0)  or (pos('S NOMED', na rr) > 0) t hen
  311         sct  := piece(p iece(piece (narr, ')' , 1), '(',  2), ' ',  2)
  312       else
  313         sct  := '';
  314       narr : = TrimRigh t(piece(na rr, '(',1) );
  315       if pos (diagnosis .Code, cod e) > 0 the n
  316       begin
  317         resu lt := true ;
  318         brea k;
  319       end
  320       else i f (sct <>  '') and (p os(sct, di agnosis.Na rrative) >  0) then
  321       begin
  322         resu lt := true ;
  323         brea k;
  324       end
  325       else i f pos(narr , diagnosi s.Narrativ e) > 0 the n
  326       begin
  327         resu lt := true ;
  328         brea k;
  329       end;
  330     end;
  331   end;
  332  
  333   function T frmDiagnos es.isEncou nterDx(pro blem: stri ng): Boole an;
  334   var
  335     i: integ er;
  336     dx, code , narr, pC ode, pNarr ative, sct : String;
  337  
  338   function E xtractCode (narr: Str ing; csys:  String):  String;
  339   var cso: I nteger;
  340   begin
  341     if csys  = 'SCT' th en
  342     begin
  343       cso :=  4;
  344     end
  345     else if  (csys = 'I CD') and ( pos('ICD-1 0', narr)  > 0) then
  346     begin
  347       csys : = 'ICD-10- CM';
  348       cso :=  10;
  349     end
  350     else
  351     begin
  352       csys : = 'ICD-9-C M';
  353       cso :=  9;
  354     end;
  355     if (pos( csys, narr ) > 0) the n
  356       result  := Piece( copy(narr,  pos(csys,  narr) + c so, length (narr)), ' )', 1)
  357     else
  358       result  := '';
  359   end;
  360  
  361   begin
  362     result : = false;
  363     pCode :=  piece(pro blem, U, 1 );
  364     pNarrati ve := piec e(problem,  U, 2);
  365     for i :=  0 to lstC aptionList .Items.Cou nt - 1 do
  366     begin
  367       dx :=  lstCaption List.Strin gs[i];
  368       narr : = piece(dx , U, 3);
  369       code : = ExtractC ode(narr,  'ICD');
  370       sct :=  ExtractCo de(narr, ' SCT');
  371       if pos (pCode, na rr) > 0 th en
  372       begin
  373         resu lt := true ;
  374         brea k;
  375       end
  376       else i f pos(narr , pNarrati ve) > 0 th en
  377       begin
  378         resu lt := true ;
  379         brea k;
  380       end;
  381     end;
  382   end;
  383  
  384   procedure  TfrmDiagno ses.Update Controls;
  385   var
  386     i, j, k,  PLItemCou nt: intege r;
  387     OK: bool ean;
  388   const
  389     PL_ITEMS  = 'Proble m List Ite ms';
  390   begin
  391     inherite d;
  392     if(NotUp dating) th en
  393     begin
  394       BeginU pdate;
  395       try
  396         cmdD iagPrimary .Enabled : = (lstCapt ionList.Se lCount = 1 );
  397         OK : = (lstCapt ionList.Se lCount > 0 );
  398         PLIt emCount :=  0;
  399         if O K then
  400           fo r k := 0 t o lstCapti onList.Ite ms.Count -  1 do
  401           be gin
  402              if (lstCap tionList.I tems[k].Se lected) th en
  403              begin
  404                if (TPCE Diag(lstCa ptionList. Objects[k] ).Category  = PL_ITEM S) or isPr oblem(TPCE Diag(lstCa ptionList. Objects[k] )) then
  405                  PLItem Count := P LItemCount  + 1;
  406              end;
  407           en d;
  408         OK : = OK and ( PLItemCoun t < lstCap tionList.S elCount);
  409         ckbD iagProb.En abled := O K;
  410         if(O K) then
  411         begi n
  412           j  := 0;
  413           fo r i := 0 t o lstCapti onList.Ite ms.Count-1  do
  414           be gin
  415              if(lstCapt ionList.It ems[i].Sel ected) and  (TPCEDiag (lstCaptio nList.Obje cts[i]).Ad dProb) the n
  416                inc(j);
  417           en d;
  418           if (j = 0) th en
  419              ckbDiagPro b.Checked  := FALSE
  420           el se
  421           if (j < lstCa ptionList. SelCount)  then
  422              ckbDiagPro b.State :=  cbGrayed
  423           el se
  424              ckbDiagPro b.Checked  := TRUE;
  425         end
  426         else
  427           ck bDiagProb. Checked :=  FALSE;
  428       finall y
  429         EndU pdate;
  430       end;
  431     end;
  432   end;
  433  
  434   procedure  TfrmDiagno ses.FormRe size(Sende r: TObject );
  435   begin
  436     inherite d;
  437     FSection Tabs[0] :=  -(lbxSect ion.width  - LBCheckW idthSpace  - (10 * Ma inFontWidt h) - Scrol lBarWidth) ;
  438     FSection Tabs[1] :=  -FSection Tabs[0]+2;
  439     FSection Tabs[2] :=  -FSection Tabs[0]+4;
  440     UpdateTa bPos;
  441   end;
  442  
  443   procedure  TfrmDiagno ses.lbxSec tionClickC heck(Sende r: TObject ; Index: I nteger);
  444   var
  445     ICDSys,  ICDCode, I CDPar, SCT Code, SCTP ar, plIEN,  msg, SecI tem, Input Str, OrigP robStr, I1 0Descripti on, TmpNar r: String;
  446  
  447   function G etSearchSt ring(AStri ng: String ): String;
  448   begin
  449     if (Pos( '#', AStri ng) > 0) t hen
  450       Result  := TrimLe ft(Piece(A String, '# ', 2))
  451     else
  452       Result  := AStrin g;
  453   end;
  454  
  455   begin
  456     if (not  FUpdatingG rid) and ( lbxSection .Checked[I ndex]) the n
  457     begin
  458       SCTPar  := '';
  459       InputS tr := '';
  460       OrigPr obStr := l bxSection. Items[Inde x];
  461       if (Pi ece(lbxSec tion.Items [Index], U , 4) = '#' ) or
  462          (Po s('799.9',  Piece(lbx Section.It ems[Index] , U, 1)) >  0) or
  463          (Po s('R69', P iece(lbxSe ction.Item s[Index],  U, 1)) > 0 ) then
  464       begin
  465         if ( Piece(lbxS ection.Ite ms[Index],  U, 4) = ' #') then
  466           ms g := TX_IN ACTIVE_ICD _CODE
  467         else
  468           ms g := TX_NO NSPEC_ICD_ CODE;
  469  
  470         Inpu tStr := Ge tSearchStr ing(Piece( lbxSection .Items[Ind ex], U, 2) );
  471  
  472         Lexi conLookup( ICDCode, L X_ICD, 0,  True, Inpu tStr, msg) ;
  473  
  474         if ( Piece(ICDC ode, U, 1)  <> '') th en
  475         begi n
  476           pl IEN := Pie ce(lbxSect ion.Items[ Index], U,  5);
  477  
  478           FU pdatingGri d := TRUE;
  479           if  Pos('ICD- 10', ICDCo de) > 0 th en ICDSys  := '10D' e lse ICDSys  := 'ICD';
  480           lb xSection.I tems[Index ] := Piece s(ICDCode,  U, 1, 2)  + U + Piec e(ICDCode,  U, 1) + U  + U + plI EN + U + I CDSys;
  481           lb xSection.C hecked[Ind ex] := Tru e;
  482           if  plIEN <>  '' then
  483           be gin
  484              if not (Po s('SCT', P iece(ICDCo de, U, 2))  > 0) and  (Piece(Enc ounter.Get ICDVersion , U, 1) =  '10D') the n
  485              begin
  486                //ask fo r SNOMED C T
  487                I10Descr iption :=  Piece(ICDC ode, U, 2)  + ' (' +  Piece(ICDC ode, U, 4)  + #32 + P iece(ICDCo de, U, 1)  + ')';
  488                LexiconL ookup(SCTC ode, LX_SC T, 0, True , InputStr , TX_PROB_ LACKS_SCT_ CODE + CRL F + CRLF +  I10Descri ption);
  489  
  490                if (Piec e(SCTCode,  U, 4) <>  '') then
  491                begin
  492                  SecIte m := lbxSe ction.Item s[Index];
  493                  if (Po s('SNOMED  CT', SCTCo de) > 0) t hen
  494                    TmpN arr := Rep laceStr(Pi ece(SCTCod e, U, 2),  'SNOMED CT ', 'SCT')
  495                  else
  496                    TmpN arr := Pie ce(SCTCode , U, 2);
  497                  SetPie ce(SecItem , U, 2, Tm pNarr);
  498  
  499                  FUpdat ingGrid :=  TRUE;
  500                  lbxSec tion.Items [Index] :=  SecItem;
  501                  lbxSec tion.Check ed[Index]  := True;
  502                  if plI EN <> '' t hen
  503                  begin
  504                    SCTP ar := Piec e(SCTCode,  U, 4) + U  + Piece(S CTCode, U,  4) + U +  Piece(SCTC ode, U, 2)  + U + Pie ce(SCTCode , U, 3);
  505                  end;
  506                  FUpdat ingGrid :=  FALSE;
  507                end
  508                else
  509                begin
  510                  //Undo  previous  ICD-10 upd ates when  cancelling  out of th e SCT upda te dialog
  511                  lbxSec tion.Items [Index] :=  OrigProbS tr;
  512                  lbxSec tion.Check ed[Index]  := False;
  513                  FUpdat ingGrid :=  False;
  514                  exit;
  515                end;
  516              end;
  517              ICDPar :=  Piece(ICDC ode, U, 3)  + U + Pie ce(ICDCode , U, 1) +  U + Piece( ICDCode, U , 2) + U +  Piece(ICD Code, U, 4 );
  518              UpdateProb lem(plIEN,  ICDPar, S CTPar);
  519              UpdateDiag nosisObj(l bxSection. Items[Inde x], Index) ;
  520              PLUpdated  := True;
  521           en d;
  522           FU pdatingGri d := FALSE ;
  523         end
  524         else
  525         begi n
  526           lb xSection.C hecked[Ind ex] := Fal se;
  527           ex it;
  528         end;
  529       end
  530       else i f (Piece(l bxSection. Items[Inde x], U, 4)  = '$') the n
  531       begin
  532         // c orrect ina ctive SCT  Code
  533         msg  := TX_INAC TIVE_SCT_C ODE;
  534  
  535         Lexi conLookup( SCTCode, L X_SCT, 0,  True, Inpu tStr, msg) ;
  536  
  537         if ( Piece(SCTC ode, U, 4)  <> '') th en
  538         begi n
  539           pl IEN := Pie ce(lbxSect ion.Items[ Index], U,  5);
  540  
  541           Se cItem := l bxSection. Items[Inde x];
  542           if  (Pos('SNO MED CT', S CTCode) >  0) then
  543              TmpNarr :=  ReplaceSt r(Piece(SC TCode, U,  2), 'SNOME D CT', 'SC T')
  544           el se
  545              TmpNarr :=  Piece(SCT Code, U, 2 );
  546           Se tPiece(Sec Item, U, 2 , TmpNarr) ;
  547  
  548           FU pdatingGri d := TRUE;
  549           lb xSection.I tems[Index ] := SecIt em;
  550           lb xSection.C hecked[Ind ex] := Tru e;
  551           if  plIEN <>  '' then
  552           be gin
  553              SCTPar :=  Piece(SCTC ode, U, 4)  + U + Pie ce(SCTCode , U, 4) +  U + Piece( SCTCode, U , 2) + U +  Piece(SCT Code, U, 3 );
  554              UpdateProb lem(plIEN,  '', SCTPa r);
  555              UpdateDiag nosisObj(l bxSection. Items[Inde x], Index) ;
  556              PLUpdated  := True;
  557           en d;
  558           FU pdatingGri d := FALSE ;
  559         end
  560         else
  561         begi n
  562           lb xSection.C hecked[Ind ex] := Fal se;
  563           ex it;
  564         end;
  565       end
  566       else i f (Piece(l bxSection. Items[Inde x], U, 4)  = '#$') th en
  567       begin
  568         // c orrect ina ctive SCT  Code
  569         msg  := TX_INAC TIVE_SCT_C ODE;
  570  
  571         Lexi conLookup( SCTCode, L X_SCT, 0,  True, Inpu tStr, msg) ;
  572  
  573         if ( Piece(SCTC ode, U, 3)  = '') the n
  574         begi n
  575           lb xSection.C hecked[Ind ex] := Fal se;
  576           ex it;
  577         end;
  578  
  579         // c orrect ina ctive ICD  Code
  580         msg  := TX_INAC TIVE_ICD_C ODE;
  581  
  582         Lexi conLookup( ICDCode, L X_ICD, 0,  True, '',  msg);
  583  
  584         if ( Piece(ICDC ode, U, 1)  <> '') an d (Piece(S CTCode, U,  4) <> '')  then
  585         begi n
  586           pl IEN := Pie ce(lbxSect ion.Items[ Index], U,  5);
  587  
  588           if  (Pos('SNO MED CT', S CTCode) >  0) then
  589              TmpNarr :=  ReplaceSt r(Piece(SC TCode, U,  2), 'SNOME D CT', 'SC T')
  590           el se
  591              TmpNarr :=  Piece(SCT Code, U, 2 );
  592           Se tPiece(ICD Code, U, 2 , TmpNarr) ;
  593  
  594           FU pdatingGri d := TRUE;
  595           if  Pos('ICD- 10', ICDCo de) > 0 th en ICDSys  := '10D' e lse ICDSys  := 'ICD';
  596           lb xSection.I tems[Index ] := Piece s(ICDCode,  U, 1, 2)  + U + Piec e(ICDCode,  U, 1) + U  + U + plI EN + U + I CDSys;
  597           lb xSection.C hecked[Ind ex] := Tru e;
  598           if  plIEN <>  '' then
  599           be gin
  600              SCTPar :=  Piece(SCTC ode, U, 4)  + U + Pie ce(SCTCode , U, 4) +  U + Piece( SCTCode, U , 2) + U +  Piece(SCT Code, U, 3 );
  601              ICDPar :=  Piece(ICDC ode, U, 3)  + U + Pie ce(ICDCode , U, 1) +  U + Piece( ICDCode, U , 2) + U +  Piece(ICD Code, U, 4 );
  602              UpdateProb lem(plIEN,  ICDPar, S CTPar);
  603              UpdateDiag nosisObj(l bxSection. Items[Inde x], Index) ;
  604              PLUpdated  := True;
  605           en d;
  606           FU pdatingGri d := FALSE ;
  607         end
  608         else
  609         begi n
  610           lb xSection.C hecked[Ind ex] := Fal se;
  611           ex it;
  612         end;
  613       end
  614       else i f (Piece(l bSection.I tems[lbSec tion.ItemI ndex], U,  2) = PL_IT EMS) and
  615         (Pie ce(Encount er.GetICDV ersion, U,  1) = '10D ') and
  616         not  (Pos('SCT' , Piece(lb xSection.I tems[Index ], U, 2))  > 0) then
  617       begin
  618         // P roblem Lac ks SCT Cod e
  619         msg  := TX_PROB _LACKS_SCT _CODE + CR LF + CRLF  + Piece(lb xSection.I tems[Index ], U, 2);
  620  
  621         Lexi conLookup( SCTCode, L X_SCT, 0,  True, Inpu tStr, msg) ;
  622  
  623         if ( Piece(SCTC ode, U, 4)  <> '') th en
  624         begi n
  625           pl IEN := Pie ce(lbxSect ion.Items[ Index], U,  5);
  626  
  627           Se cItem := l bxSection. Items[Inde x];
  628           if  (Pos('SNO MED CT', S CTCode) >  0) then
  629              TmpNarr :=  ReplaceSt r(Piece(SC TCode, U,  2), 'SNOME D CT', 'SC T')
  630           el se
  631              TmpNarr :=  Piece(SCT Code, U, 2 );
  632           Se tPiece(Sec Item, U, 2 , TmpNarr) ;
  633  
  634           FU pdatingGri d := TRUE;
  635           lb xSection.I tems[Index ] := SecIt em;
  636           lb xSection.C hecked[Ind ex] := Tru e;
  637           if  plIEN <>  '' then
  638           be gin
  639              SCTPar :=  Piece(SCTC ode, U, 4)  + U + Pie ce(SCTCode , U, 4) +  U + Piece( SCTCode, U , 2) + U +  Piece(SCT Code, U, 3 );
  640              UpdateProb lem(plIEN,  '', SCTPa r);
  641              UpdateDiag nosisObj(l bxSection. Items[Inde x], Index) ;
  642              PLUpdated  := True;
  643           en d;
  644           FU pdatingGri d := FALSE ;
  645         end
  646         else
  647         begi n
  648           lb xSection.C hecked[Ind ex] := Fal se;
  649           ex it;
  650         end;
  651       end
  652       else i f (Piece(E ncounter.G etICDVersi on, U, 1)  = 'ICD') a nd
  653         ((Po s('ICD-10' , Piece(lb xSection.I tems[Index ], U, 2))  > 0) or (P iece(lbxSe ction.Item s[Index],  U, 6)='10D ')) then
  654       begin
  655         // A ttempting  to add an  ICD10 diag nosis code  to an ICD 9 encounte r
  656         Info Box(TX_INV _ICD10_DX,  TC_INV_IC D10_DX, MB _ICONERROR  or MB_OK) ;
  657         lbxS ection.Che cked[Index ] := False ;
  658         exit ;
  659       end
  660       else i f isEncoun terDx(lbxS ection.Ite ms[Index])  then
  661       begin
  662         Info Box(TX_RED UNDANT_DX,  TC_REDUND ANT_DX + p iece(lbxSe ction.Item s[Index],  '^',2),
  663           MB _ICONWARNI NG or MB_O K);
  664         lbxS ection.Che cked[Index ] := False ;
  665         exit ;
  666       end;
  667     end;
  668     inherite d;
  669     EnsurePr imaryDiag;
  670   end;
  671  
  672   procedure  TfrmDiagno ses.lbxSec tionDrawIt em(Control : TWinCont rol; Index : Integer;
  673     Rect: TR ect; State : TOwnerDr awState);
  674   var
  675     Narr, Co de: String ;
  676     Format,  CodeTab, I temRight,  DY: Intege r;
  677     ARect, T mpR: TRect ;
  678     BMap: TB itMap;
  679   begin
  680     inherite d;
  681     Narr :=  Piece((Con trol as TO RListBox). Items[Inde x], U, 2);
  682     Code :=  Piece((Con trol as TO RListBox). Items[Inde x], U, 3);
  683     CodeTab  := StrToIn t(Piece(lb xSection.T abPosition s, ',', 2) );
  684  
  685     // draw  CheckBoxes
  686     with lbx Section do
  687     begin
  688       if (Ch eckBoxes)  then
  689       begin
  690         case  CheckedSt ate[Index]  of
  691           cb Unchecked:
  692           be gin
  693              if (FlatCh eckBoxes)  then
  694                BMap :=  GetORCBBit map(iiFlat UnChecked,  False)
  695              else
  696                BMap :=  GetORCBBit map(iiUnch ecked, Fal se);
  697           en d;
  698           cb Checked:
  699           be gin
  700              if (FlatCh eckBoxes)  then
  701                BMap :=  GetORCBBit map(iiFlat Checked, F alse)
  702              else
  703                BMap :=  GetORCBBit map(iiChec ked, False );
  704           en d;
  705         else  // cbGray ed:
  706         begi n
  707           if  (FlatChec kBoxes) th en
  708              BMap := Ge tORCBBitma p(iiFlatGr ayed, Fals e)
  709           el se
  710              BMap := Ge tORCBBitma p(iiGrayed , False);
  711           en d;
  712         end;
  713         TmpR  := Rect;
  714         TmpR .Right :=  TmpR.Left;
  715         dec( TmpR.Left,  (LBCheckW idthSpace  - 5));
  716         DY : = ((TmpR.B ottom - Tm pR.Top) -  BMap.Heigh t) div 2;
  717         Canv as.Draw(Tm pR.Left, T mpR.Top +  DY, BMap);
  718       end;
  719     end;
  720  
  721     // draw  the Proble m Text
  722     ARect :=  (Control  as TListBo x).ItemRec t(Index);
  723     ARect.Le ft := ARec t.Left + L BCheckWidt hSpace;
  724     ItemRigh t := ARect .Right;
  725     ARect.Ri ght := Cod eTab - 10;
  726     Format : = (DT_LEFT  or DT_NOP REFIX or D T_WORD_ELL IPSIS);
  727     DrawText ((Control  as TListBo x).Canvas. Handle, PC har(Narr),  Length(Na rr), ARect , Format);
  728  
  729     // now d raw ICD co des
  730     ARect.Le ft := Code Tab;
  731     ARect.Ri ght := Ite mRight;
  732     DrawText ((Control  as TListBo x).Canvas. Handle, PC har(Code),  Length(Co de), ARect , Format);
  733   end;
  734  
  735   procedure  TfrmDiagno ses.btnOKC lick(Sende r: TObject );
  736   begin
  737     inherite d;
  738     if  BILL ING_AWARE  then
  739        GetEn counterDia gnoses;
  740     if ckbDi agProb.Che cked then
  741        PLUpd ated := Tr ue;
  742   end;
  743  
  744   procedure  TfrmDiagno ses.lbSect ionClick(S ender: TOb ject);
  745   begin
  746     inherite d;
  747   //
  748   end;
  749  
  750   procedure  TfrmDiagno ses.GetEnc ounterDiag noses;
  751   var
  752     i: integ er;
  753     dxCode,  dxName: st ring;
  754     ADiagnos is: TPCEIt em;
  755   begin
  756     inherite d;
  757     UBAGloba ls.BAPCEDi agList.Cle ar;
  758     with lst CaptionLis t do for i  := 0 to I tems.Count  - 1 do
  759     begin
  760       ADiagn osis := TP CEDiag(Obj ects[i]);
  761       dxCode  :=  ADiag nosis.Code ;
  762       dxName  :=  ADiag nosis.Narr ative;
  763       if BAP CEDiagList .Count = 0  then
  764          UBA Globals.BA PCEDiagLis t.Add(U +  DX_ENCOUNT ER_LIST_TX T);
  765       UBAGlo bals.BAPCE DiagList.A dd(dxCode  + U + dxNa me);
  766     end;
  767   end;
  768  
  769   procedure  TfrmDiagno ses.GetSCT forICD(ADi agnosis: T PCEDiag);
  770   var
  771     Code, ms g, ICDDesc ription: S tring;
  772   begin
  773     // look- up SNOMED  CT
  774     if Pos(' ICD-10-CM' , ADiagnos is.Narrati ve) > 0 th en
  775       ICDDes cription : = ADiagnos is.Narrati ve
  776     else
  777       ICDDes cription : = ADiagnos is.Narrati ve + ' ('  + Piece(En counter.Ge tICDVersio n, U, 2) +  #32 + ADi agnosis.Co de + ')';
  778     msg := T X_ICD_LACK S_SCT_CODE  + CRLF +  CRLF + ICD Descriptio n;
  779     LexiconL ookup(Code , LX_SCT,  0, False,  '', msg);
  780     if (Code  = '') the n
  781     begin
  782       ckbDia gProb.Chec ked := Fal se;
  783     end
  784     else
  785     begin
  786       ADiagn osis.Narra tive := Pi ece(Code,  U, 2);
  787     end;
  788   end;
  789  
  790   procedure  TfrmDiagno ses.lbSect ionDrawIte m(Control:  TWinContr ol;
  791     Index: I nteger; Re ct: TRect;  State: TO wnerDrawSt ate);
  792   begin
  793     inherite d;
  794     if (cont rol as TLi stbox).ite ms[index]  = DX_PROBL EM_LIST_TX T then
  795        (Cont rol as TLi stBox).Can vas.Font.S tyle := [f sBold]
  796     else
  797        if (c ontrol as  Tlistbox). items[inde x] = DX_PE RSONAL_LIS T_TXT then
  798           (C ontrol as  TListBox). Canvas.Fon t.Style :=  [fsBold]
  799     else
  800        if (c ontrol as  Tlistbox). items[inde x] =  DX_T ODAYS_DX_L IST_TXT  t hen
  801           (C ontrol as  TListBox). Canvas.Fon t.Style :=  [fsBold]
  802     else
  803        if (c ontrol as  Tlistbox). items[inde x] = DX_EN COUNTER_LI ST_TXT the n
  804           (C ontrol as  TListBox). Canvas.Fon t.Style :=  [fsBold]
  805     else
  806        (Cont rol as TLi stBox).Can vas.Font.S tyle := [] ;
  807  
  808     (Control  as TListB ox).Canvas .TextOut(R ect.Left+2 , Rect.Top +1, (Contr ol as
  809                  TListB ox).Items[ Index]); { display th e text }
  810   end;
  811  
  812   initializa tion
  813     SpecifyF ormIsNotAD ialog(Tfrm Diagnoses) ;
  814  
  815   end.