25. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 5/13/2019 2:40:11 PM Central 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.

25.1 Files compared

# Location File Last Modified
1 C:\AraxisMergeCompare\Pri_un\MPDU\Code\CPRS-chart-master-20181214\CPRS-chart-master\Encounter fDiagnoses.pas Fri Dec 14 18:30:40 2018 UTC
2 C:\AraxisMergeCompare\Pri_re\MPDU\MPDU\Code\CPRS-chart-master-20181214\CPRS-chart-master\Encounter fDiagnoses.pas Tue May 7 12:18:36 2019 UTC

25.2 Comparison summary

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

25.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

25.4 Active regular expressions

No regular expressions were active.

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