Index: cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBAConst.pas =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBAConst.pas (revision 541) +++ cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBAConst.pas (revision 541) @@ -0,0 +1,117 @@ +//kt -- Modified with SourceScanner on 8/17/2007 +unit UBAConst; + +{$OPTIMIZATION OFF} + +interface + +const + + BUFFER_ORDER_ID = '9999999999'; + + CARET = '^'; + NOT_APPLICABLE = 'N/A'; + +//kt 8-17-07 removed to replace with functions +//ENCOUNTER_TODAYS_DX = '^Diagnoses from Today''s Orders'; //BAPHII 1.3.10 <-- original line. //kt 8/17/2007 +//ENCOUNTER_PERSONAL_DX = '^Personal Diagnoses List Items'; <-- original line. //kt 8/17/2007 +//DX_PROBLEM_LIST_TXT = 'Problem List Items'; <-- original line. //kt 8/17/2007 +//DX_PERSONAL_LIST_TXT = 'Personal Diagnoses List Items'; <-- original line. //kt 8/17/2007 +//DX_ENCOUNTER_LIST_TXT = 'Encounter Form Diagnoses'; <-- original line. //kt 8/17/2007 +//DX_TODAYS_DX_LIST_TXT = 'Diagnoses from Today''s Orders'; <-- original line. //kt 8/17/2007 + + MIN_SC_CONDITION = 0; + MAX_SC_CONDITION = 0; + BILLABLE_ORDER = '1'; + SERVICE_CONNECTED = 'SC'; + NOT_SERVICE_CONNECTED = 'NSC'; + AGENT_ORANGE = 'AO'; + IONIZING_RADIATION = 'IR'; + ENVIRONMENTAL_CONTAM = 'EC'; + HEAD_NECK_CANCER = 'HNC'; + MILITARY_SEXUAL_TRAUMA = 'MST'; + COMBAT_VETERAN = 'CV'; + + MAX_DX = 4; + DXREC_INIT_FIELD_VAL = ''; + UNSIGNED_REC_INIT_FIELD_VAL = ''; + +//kt 8-17-07 removed to replace with functions +//PRIMARY_DX = 'Primary'; <-- original line. //kt 8/17/2007 +//SECONDARY_DX = 'Secondary'; <-- original line. //kt 8/17/2007 +function PRIMARY_DX: string; //kt +function SECONDARY_DX: string; //kt + +const + //Form identifiers + F_ORDERS_SIGN = 1; + F_REVIEW = 2; + F_CONSULTS = 3; + // Order Status + + BAOK2SIGN = 1; + DISCONTINUED = 5; + MIN_RECT = 0; + MAX_RECT = 199; + + ADD_TO_PROBLEM_LIST = 'PL'; + ADD_TO_PERSONAL_DX_LIST = 'PD'; + BA_INACTIVE_CODE = '#'; + + //kt replacing constants with fn declarations to allow just-in-time translation + function ENCOUNTER_TODAYS_DX : string; + function ENCOUNTER_PERSONAL_DX : string; + function DX_PROBLEM_LIST_TXT : string; + function DX_PERSONAL_LIST_TXT : string; + function DX_ENCOUNTER_LIST_TXT : string; + function DX_TODAYS_DX_LIST_TXT : string; + + +implementation + +uses DKLang; + +function ENCOUNTER_TODAYS_DX : string; +begin + Result := '^'+DKLangConstW('UBAConst_Diagnoses_from_Todayxxs_Orders'); //BAPHII 1.3.10 //kt added 8/17/2007 +end; + +function ENCOUNTER_PERSONAL_DX : string; +begin + Result := '^'+DKLangConstW('UBAConst_Personal_Diagnoses_List_Items'); //kt added 8/17/2007 +end; + +function DX_PROBLEM_LIST_TXT : string; +begin + Result := DKLangConstW('UBAConst_Problem_List_Items'); //kt added 8/17/2007 +end; + +function DX_PERSONAL_LIST_TXT : string; +begin + Result := DKLangConstW('UBAConst_Personal_Diagnoses_List_Items'); //kt added 8/17/2007 +end; + +function DX_ENCOUNTER_LIST_TXT : string; +begin + Result := DKLangConstW('UBAConst_Encounter_Form_Diagnoses'); //kt added 8/17/2007 +end; + +function DX_TODAYS_DX_LIST_TXT : string; +begin + Result := DKLangConstW('UBAConst_Diagnoses_from_Todayxxs_Orders'); //kt added 8/17/2007 +end; + + +function PRIMARY_DX: string; +begin + Result := DKLangConstW('UBAConst_Primary'); //kt added 8/17/2007 +end; + +function SECONDARY_DX: string; +begin + Result := DKLangConstW('UBAConst_Secondary'); //kt added 8/17/2007 +end; + +end. + + Index: cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBACore.pas =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBACore.pas (revision 541) +++ cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBACore.pas (revision 541) @@ -0,0 +1,1481 @@ +//kt -- Modified with SourceScanner on 8/8/2007 +unit UBACore; + +{.$define debug} + +interface +uses + Classes, ORNet, uConst, ORFn, Sysutils, Dialogs, Windows,Messages, UBAGlobals,Trpcb, + fFrame; + +function rpcAddToPersonalDxList(UserDUZ:int64; DxCodes:TStringList):boolean; +function rpcGetPersonalDxList(UserDUZ:int64):TStringList; +function rpcDeleteFromPersonalDxList(UserDUZ:int64; Dest:TStringList):integer; +procedure rpcSaveBillingDxEntered; // save dx enteries regardless of being mandatory.... +function rpcNonBillableOrders(pOrderList: TStringList): TStringList; +function rpcOrderRequiresDx(pList: TStringList):boolean; +procedure rpcSetBillingAwareSwitch(encProvider: int64; pPatientDFN: string); +procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string); +procedure rpcGetSC4Orders; // returns Eligible Treatment Factors for a given patient + +function rpcTreatmentFactorsActive(pOrderID: string):boolean; +procedure rpcBuildSCIEList(pOrderList: TList); +function rpcGetUnsignedOrdersBillingData(pOrderList: TStringList):TStringList; +function rpcRetrieveSelectedOrderInfo(pOrderIDList: TStringList):TStringList; +function rpcGetTFHintData:TStringList; +procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList); +function rpcGetBAMasterSwStatus:boolean; +procedure rpcSaveCIDCData(pCIDCList: TStringList); +function rpcIsPatientInsured(pPatientDFN: string):boolean; + +procedure SaveBillingData(pBillingData:TStringList); +function OrdersHaveDx(pOrderList:TStringList):boolean; +procedure SetTreatmentFactors(TFactors: string); +function AttachDxToOrderList(pOrderList:TStringList):TStringList; +procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string); +procedure BALoadStsFlagsAsIs(StsFlagsIN: string); +function BADxEntered:boolean; // main logic to determine if dx has been entered for order that requires dx +function StripTFactors(FactorsIN: string): string; +function AddProviderPatientDaysDx(Dest: TStringList; ProviderIEN: string;PatientIEN: string) : TStringList; +function IsOrderBillable(pOrderID: string):boolean; + +function OrderRequiresSCEI(pOrderID :String): boolean; +procedure SaveUnsignedOrders(pOrderRec:String); + +procedure CompleteUnsignedBillingInfo(pOrderList: TStringList); +procedure BuildSaveUnsignedList(pOrderList: TStringList); +procedure LoadUnsignedOrderRec(var thisRetVal: TBAUnsignedBillingRec;UnsignedBillingInfo:string); +function GetUnsignedOrderFlags(pOrderID: string; pFlagList: TStringList):string; // returns STSFlags if found +procedure BuildTFHintRec; +function IsAllOrdersNA(pOrderList:TStringList):boolean; +function PrepOrderID(pOrderID:String): String; +procedure ClearSelectedOrderDiagnoses(pOrderIDList: TStringList); +procedure LoadConsultOrderRec(var thisRetVal: TBAConsultOrderRec; pOrderID: String; pDxList: TStringList); +procedure CompleteConsultOrderRec(pOrderID: string; pDxList: TStringList); +function GetConsultFlags(pOrderID:String; pFlagList:TStringList;FlagsAsIs:string):string; +function SetConsultFlags(pPLFactors: string;pFlagsAsIs: string):string; // return updated flags. +procedure GetBAStatus(pProvider:int64; pPatientDFN: string); +function IsICD9CodeActive(ACode: string; LexApp: string; ADate:TFMDateTime = 0): boolean; +function BuildConsultDxRec(ConsultRec: TBAConsultOrderRec): string; +function ConvertPIMTreatmentFactors(pTFactors:string):string; +procedure DeleteDCOrdersFromCopiedList(pOrderID:string); +procedure UpdateBAConsultOrderList(pDcOrders: TStringList); +function VerifyOrderIdExists(pOrderList: TStringList): TStringList; // removes records without order id +function IsCIDCProvider(encProvider:int64):boolean; +function ProcessProblemTFactors(pText:String):String; + +var + uAddToPDl: integer; + uDeleteFromPDL: integer; + uDxLst: TStringList; + BADxList: TStringList; + +implementation + +uses fBALocalDiagnoses, fOrdersSign, fReview, rOrders, uCore, rCore, rPCE,uPCE, + UBAConst, UBAMessages, USignItems; + + +// ----------------- MAIN CIDC DX HAS BEEN ENTERED LOGIC --------------------------- +function BADxEntered:boolean; +var + i: integer; + //orderStatus: integer; + x: string; + passList: TStringList; + holdOrderList: TStringList; + thisOrderID: string; + thisRec: string; +begin + // Result := TRUE; // caused hint..... + holdOrderList := TStringList.Create; + holdOrderList.Clear; + updatedBAOrderList := TStringList.Create; + updatedBAOrderList.Clear; + passList := TStringList.Create; + passList.Clear; + // determine which orders require a dx (lrmp- only) + // if NO then continue + // if YES, check BADxList for orders with DX enteries. + // if ok then create data string pass to M via RPC + + for i := 0 to BAOrderList.Count-1 do + begin + thisRec := BAOrderList.Strings[i]; + thisOrderID := piece(thisRec,';',1) + ';1'; //rebuild orderID pass to M. + x := BAOrderList.Strings[i]; + //orderStatus := StrToInt(CharAt(Piece(x, ';', 2), 1)); // Order Status 1=OK, 2=DISCONTINUE + if IsOrderBillable(thisOrderID) then + begin + passList.Add(piece(x,';',1)); + holdOrderList.Add(x);// place holder for orders that can be signed! + end; + end; + + BAOrderList.Assign(holdOrderList); //assign signable orders to BAOrderList for further processing + holdOrderList.Clear; // CQ5025 + + //call with passList determine if LRMP + if rpcOrderRequiresDx(passList) then + BAOrderList.Assign(updatedBAOrderList); + + // check of all orders dx columns are flagged with N/A..... + if UBACore.IsAllOrdersNA(BAOrderList) then + begin + Result := TRUE; // force true, no record needs DX entry + Exit; //to do. clean this up... when time permitts + end + else + begin + if OrdersHaveDx(UBAGlobals.BAOrderList) then + begin + Result := True; // CIDC orders have dx + SaveBillingData(UBAGlobals.BAOrderList) ; + end + else + begin + Result := FALSE; + Exit; + end; + end; +end; + + +function rpcOrderRequiresDx(pList: TStringList):boolean; +var x: string; + i,j: integer; + returnList, updatedList: TStringList; + begin + Result := FALSE; // initial set dx NOT required + returnList := TStringList.Create; + updatedList := TStringList.Create; + returnList.Clear; + updatedList.Clear; + // remove deleted orderid's + if UBAGlobals.BADeltedOrders.Count > 0 then + begin + for i := 0 to UBAGlobals.BADeltedOrders.Count-1 do + x := UBAGlobals.BADeltedOrders.Strings[i]; + for j := 0 to pList.Count-1 do + begin + if x = pList.Strings[j] then + continue // orderid is removed.. or skipped + else + updatedList.Add(x); + end; + end + else + updatedList.Assign(pList); + + // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0 + tCallV(returnList,'ORWDBA1 ORPKGTYP',[updatedList]); + + //Remove NON LRMP orders from the mix(when checking for dx entry); + // BAOrderList and pList are in sync - order id.... + for i := 0 to BAOrderList.Count-1 do + begin + x:= piece(returnList.Strings[i],'^',1); + if x = BILLABLE_ORDER then + begin + updatedBAOrderList.Add(BAOrderList[i]); + Result := TRUE; + end; + end; +end; + + +// UBAGlobals.NonBillableOrderList must be populated prior to calling this function. +// call rpcNonBillableOrders to populate List. +function IsOrderBillable(pOrderID: string):boolean ; +var + i: integer; + currOrderID: string; + matchOrderID : string; + +begin + Result := TRUE; // = Billable + currOrderID := PrepOrderID(pOrderID); + if Piece(pOrderID,';',2) = DISCONTINUED_ORDER THEN + begin + Result := FALSE; + Exit; + end; + try + for i := 0 to UBAGlobals.NonBillableOrderList.Count -1 do + begin + matchOrderID := PrepOrderID( (Piece(UBAGlobals.NonBillableOrderList.Strings[i],U,1)) ); + if currOrderID = matchOrderID then + begin + Result := FALSE; //= Non Billable + Exit; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBACore.IsOrderBillable()');{$endif} + raise; + end; + end; +end; + + +procedure SaveBillingData(pBillingData:TStringList); +var + RecsToSave: TStringList; +begin + RecsToSave := TStringList.Create; + RecsToSave.Clear; + + RecsToSave := AttachDxToOrderList(pBillingData); //call with new Biling data, return-code returned + rpcSaveCIDCData(RecsToSave); // verify and save billing data + + if Assigned(UBAGlobals.BAOrderList) then UBAGlobals.BAOrderList.Clear; // hds00005025 +end; + +function rpcTreatmentFactorsActive(pOrderID:string): boolean; +var x: string; + i: integer; + pList: TStringList; + rList: TStringList; + begin + pList := TStringList.Create; + rList := TStringList.Create; + rList.Clear; + rList := nil; + pList.Clear; + pList.Add(pOrderID); + Result := FALSE; + // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0 + tCallV(rList,'ORWDBA1 ORPKGTYP',[pList]); + //returns boolean value by OrderID - True = billable + for i := 0 to rList.Count-1 do + begin + x := rList[i]; + if rList[i] = BILLABLE_ORDER then + begin + Result := True; + end; + end; +end; + + +function AttachDxToOrderList(pOrderList:TStringList):TStringList; +var + i: integer; + newBillingList: TStringList; + baseDxRec: TBADxRecord; + currentOrderID: string; + currentOrderString: string; + dxString,FlagsStatsIn: string; + +begin + newBillingList:= TStringList.Create; + newBillingList.Clear; + dxString := ''; + baseDxRec := nil; + baseDxRec := TBADxRecord.Create; + + InitializeNewDxRec(baseDxRec); + for i := 0 to pOrderList.Count-1 do + begin + currentOrderString := pOrderList.Strings[i]; + currentOrderID := piece(pOrderList.Strings[i],';',1)+ ';1'; + + GetBADxListForOrder(baseDxRec, currentOrderID); + FlagsStatsIn := BAFlagsIN; + dxString := currentOrderString + '^' + piece(baseDxRec.FBADxCode,':',2); + if baseDxRec.FBASecDx1 <> '' then + dxString := dxString + '^' + piece(baseDxRec.FBASecDx1,':',2); + if baseDxRec.FBASecDx2 <> '' then + dxString := dxString + '^' + piece(baseDxRec.FBASecDx2,':',2); + if baseDxRec.FBASecDx3 <> '' then + dxString := dxString + '^' + piece(baseDxRec.FBASecDx3,':',2); + + NewBillingList.Add(dxString); + InitializeNewDxRec(baseDxRec); //HDS00004744 + end; + Result := NewBillingList; +end; + +function rpcAddToPersonalDxList(UserDUZ:int64; DxCodes:TStringList):boolean; +//input example ien^code(s) = 12345^306.70^431.22 +begin + Result := (sCallV('ORWDBA2 ADDPDL', [UserDUZ,DxCodes])= '1'); +end; + +function rpcGetPersonalDxList(UserDUZ:int64):TStringList; +var +tmplst: TStringList; +begin + tmplst := TStringList.Create; + tmplst.clear; + tCallV(tmplst, 'ORWDBA2 GETPDL', [UserDUZ]); + Result := tmplst; +end; + +function rpcDeleteFromPersonalDxList(UserDUZ:int64; Dest:TStringList):integer; +begin + uDeleteFromPDL := StrToIntDef(sCallV('ORWDBA2 DELPDL', [UserDUZ,Dest]), 0); + Result := uDeleteFromPDL; +end; + +// returns value used to bypass Billing Aware if needed. +// turns off visual and functionality +procedure rpcSetBillingAwareSwitch(encProvider:int64; pPatientDFN: string); +begin +// Is Provider -> Is Master Sw -> Is CIDC SW -> Is Patient Insured + BILLING_AWARE := FALSE; + // verify user is a provider + if (encProvider <> 0) and PersonHasKey(encProvider, 'PROVIDER') then + // Master switch is set "ON" + if (sCallV('ORWDBA1 BASTATUS', [nil]) = '1') then + // User is CIDC Enabled + if (sCallV('ORWDBA4 GETBAUSR', [encProvider]) = '1') then + begin + // Verify Patient is Insured + if rpcIsPatientInsured(pPatientDFN) then + BILLING_AWARE := TRUE; + end; + {$ifdef debug}BILLING_AWARE := TRUE;{$endif} +end; + +// verify CIDC Master Switch and Provider is CIDC Enabled. +// Patient insurance check is bypassed. (hds7564) +function IsCIDCProvider(encProvider:int64):boolean; +begin + Result := False; + if rpcGetBAMasterSwStatus then + if (encProvider <> 0) and PersonHasKey(encProvider, 'PROVIDER') then + Result := True; +end; + + +function rpcGetBAMasterSwStatus:boolean; +begin + Result := (sCallV('ORWDBA1 BASTATUS', [nil]) = '1'); // Master switch is set "ON" +end; + + +procedure rpcSaveNurseConsultOrder(pOrderRec:TStringList); +begin + rpcSaveCIDCData(pOrderRec); +end; + + +procedure rpcSaveBillingDxEntered; // if not mandatory and user enters dx. +var + ordersWithDx,i: integer; + newBillingList: TStringList; + baseDxRec, tempDxRec: TBADxRecord; + currentOrderID, thisOrderID: string; + currentOrderString, thisRec: string; +begin +// verify Dx has been entered for orders checked for signature.. + ordersWithDx := 0; + tempDxRec := TBADxRecord.Create; + UBAGlobals.InitializeNewDxRec(tempDxRec); + for i := 0 to BAOrderList.Count-1 do + begin + thisRec := BAOrderList.Strings[i]; + thisOrderID := piece(thisRec,';',1) + ';1'; //rebuild orderID pass to M. + if tempDxNodeExists(thisOrderID) then + inc(ordersWithDx); + end; + + // if orders have dx enteries - save billing data. + if ordersWithDx > 0 then + begin + newBillingList:= TStringList.Create; + newBillingList.Clear; + baseDxRec := nil; + baseDxRec := TBADxRecord.Create; + InitializeNewDxRec(baseDxRec); + + try + for i := 0 to BAOrderList.Count-1 do + begin + currentOrderString := BAOrderList.Strings[i]; + currentOrderID := piece(BAOrderList.Strings[i],';',1)+ ';1'; + GetBADxListForOrder(baseDxRec, currentOrderID); + if baseDxRec.FBADxCode <> '' then + begin + NewBillingList.Add(currentOrderString +'^'+ baseDxRec.FBADxCode +'^'+ baseDxRec.FBASecDx1+ + '^'+ baseDxRec.FBASecDx2+'^'+ baseDxRec.FBASecDx3); + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBACore.rpcSaveBillingDxEntered()');{$endif} + raise; + end; + end; + + rpcSaveCIDCData(NewBillingList); + if Assigned(NewBillingList) then FreeAndNil(NewBillingList); + end; +end; + +procedure rpcGetSC4Orders; +begin + RPCBrokerV.Param[0].PType := literal; + RPCBrokerV.Param[0].Value := Patient.DFN; + RPCBrokerV.RemoteProcedure := 'ORWDBA1 SCLST'; + CallBroker; +end; + +procedure rpcGetProviderPatientDaysDx(ProviderIEN: string;PatientIEN: string); +var + tmplst: TStringList; +begin + tmplst := TStringList.Create; + uDxLst := TStringList.Create; + tmplst.clear; + uDxLst.Clear; + tCallV(tmplst, 'ORWDBA2 GETDUDC', [ProviderIEN, PatientIEN]); + UBACore.UDxLst.Assign(tmplst); + tmplst.clear; +end; + + +function rpcGetTFHintData:TStringList; +begin + tCallv(BATFHints,'ORWDBA3 HINTS', [nil]); + Result := BATFHints; +end; + +// call made to determine if order type is billable +// if order type NOT billable, flagged with "NA". +function rpcNonBillableOrders(pOrderList: TStringList):TStringList; +var x: string; + i: integer; + rList: TStringList; + begin + rList := TStringList.Create; + rList.Clear; + NonBillableOrderList.Clear; + // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0 + tCallV(rList,'ORWDBA1 ORPKGTYP',[pOrderList]); + for i := 0 to rList.Count-1 do + begin + x := rList[i]; + if rList[i] <> BILLABLE_ORDER then + NonBillableOrderList.Add(pOrderList[i] + U + 'NA'); + end; + Result := NonBillableOrderList; +end; + + +procedure rpcBuildSCIEList(pOrderList: TList); +var AnOrder: TOrder; + OrderIDList: TStringList; + rList: TStringList; + i: integer; + begin + OrderIDList := TStringList.Create; + rList := TStringList.Create; + if Assigned(OrderListSCEI) then OrderListSCEI.Clear; + OrderIDList.Clear; + rList.Clear; + for i := 0 to pOrderList.Count -1 do + begin + AnOrder := TOrder(pOrderList.Items[i]); + OrderIDList.Add(AnOrder.ID); + end; + // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0 + tCallV(rList,'ORWDBA1 ORPKGTYP',[OrderIDList]); + + for i := 0 to rList.Count-1 do + begin + if rList.Strings[i] = BILLABLE_ORDER then + OrderListSCEI.Add(OrderIDList.Strings[i]); + end; +end; + +procedure rpcSaveCIDCData(pCIDCList: TStringList); +var + CIDCList :TStringList; +begin + CIDCList := TStringList.create; + CIDCList.Clear; + // insure record contain valid orderid + if pCIDCList.Count > 0 then + begin + CIDCList := VerifyOrderIdExists(pCIDCList); + if CIDCList.Count > 0 then + CallV('ORWDBA1 RCVORCI',[CIDCList]); + end; + if Assigned(CIDCList) then FreeAndNil(CIDCList); +end; + +function rpcIsPatientInsured(pPatientDFN: string):boolean; +begin + Result := (sCallV('ORWDBA7 ISWITCH',[pPatientDFN]) = '1'); + +end; + + +function OrdersHaveDx(pOrderList:TStringList):boolean; +var + i: integer; + thisOrderID: string; + thisRec: string; + tempDxRec: TBADxRecord; +begin + Result := TRUE; + tempDxRec := nil; + tempDxRec := TBADxRecord.Create; + UBAGlobals.InitializeNewDxRec(tempDxRec); + + try + for i := 0 to pOrderList.Count-1 do + begin + thisRec := pOrderList.Strings[i]; + thisOrderID := piece(thisRec,';',1) + ';1'; //rebuild orderID pass to M. + if not tempDxNodeExists(thisOrderID) then + begin + Result := FALSE; + Break; + end + else + begin + GetBADxListForOrder(tempDxRec, thisOrderID); + if tempDxRec.FBADxCode = '' then + begin + Result := FALSE; + Break; + end; + end; + + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBACore.OrdersHaveDx()');{$endif} + raise; + end; + end; + + if Assigned(tempDxRec) then + FreeAndNil(tempDxRec); +end; + + + + +procedure LoadUnsignedOrderRec(var thisRetVal: TBAUnsignedBillingRec;UnsignedBillingInfo:string); +var + thisString : String; +begin + thisString := UnsignedBillingInfo; + with thisRetVal do + begin + FBAOrderID := Piece(thisString,U,1) + ';1'; + FBASTSFlags := Piece(thisString,U,2); + FBADxCode := (Piece(thisString,U,4)+ U + (Piece(thisString,U,3))); + FBASecDx1 := (Piece(thisString,U,6)+ U + (Piece(thisString,U,5))); + FBASecDx2 := (Piece(thisString,U,8)+ U + (Piece(thisString,U,7))); + FBASecDx3 := (Piece(thisString,U,10)+ U + (Piece(thisString,U,9))); + // if codes are absent then get rid of '^'. + if FBADxCode = U then FBADxCode := DXREC_INIT_FIELD_VAL; + if FBASecDx1 = U then FBASecDx1 := DXREC_INIT_FIELD_VAL; + if FBASecDx2 = U then FBASecDx2 := DXREC_INIT_FIELD_VAL; + if FBASecDx3 = U then FBASecDx3 := DXREC_INIT_FIELD_VAL; + end; +end; + +procedure AttachPLTFactorsToDx(var Dest:String;ProblemRec:string); +var + TFResults: string; + thisRec: TBAPLFactorsIN; +begin + TFResults := ''; + thisRec := TBAPLFactorsIN.Create; + thisRec.FBADxText := Piece(ProblemRec,'(',1); + thisRec.FBADxText := Piece(thisRec.FBADxText,U,2); + thisRec.FBADxCode := Piece(ProblemRec,U,3); + thisRec.FBASC := Piece(ProblemRec,U,5); + thisRec.FBASC_YN := Piece(ProblemRec,U,6); + //HDS8409 + if StrPos(PChar(ProblemRec),'(') <> nil then + thisRec.FBATreatFactors := ProcessProblemTFactors(ProblemRec) + else + begin + thisRec.FBATreatFactors := Piece(ProblemRec,')',1); + thisRec.FBATreatFactors := Piece(thisRec.FBATreatFactors,'(',2); + end; + //HDS8409 + with thisRec do + begin + if StrLen(pchar(FBATreatFactors)) > 0 then // 0 Treatment Factors exist + //build string containing Problem List Treatment Factors + TFResults := ( FBADXCode + U + FBADxText + ' (' + FBASC + '/' + FBATreatFactors + ') ' ) + else + if StrLen(PChar(FBASC)) > 0 then + TFResults := ( FBADxCode + U + FBADxText + ' (' + FBASC + ') ' ) + else + TFResults := ( FBADxCode + U + FBADxText ); + end; + + Dest := TFResults; +end; + + +// this code is to handle adding Problem List(only) TF's when selected +procedure BALoadStsFlagsAsIs(StsFlagsIN: String); +var + x: string; +begin + x:= Piece(StsFlagsIN,U,2); + UBAGlobals.SC := Copy(x,1,1); + UBAGlobals.AO := Copy(x,2,1); + UBAGlobals.IR := Copy(x,3,1); + UBAGlobals.EC := Copy(x,4,1); + UBAGlobals.MST := Copy(x,5,1); + UBAGlobals.HNC := Copy(x,6,1); + UBAGlobals.CV := Copy(x,7,1); +end; + + +// this code is to handle adding Problem List(only) TF's when selected + +procedure SetTreatmentFactors(TFactors: string); +var + strTFactors : string; + strFlagsOut: string; + FlagsIN : TStringList; + Idx: string; + i : integer; +begin + UBAGlobals.BAFlagsOUT := TStringList.Create; + UBAGlobals.BAFlagsOUT.Clear; + FlagsIN := TStringList.Create; + FlagsIN.Clear; + FlagsIN := UBAGlobals.PLFactorsIndexes; + + for i:= 0 to FlagsIN.Count-1 do + begin + BALoadStsFlagsAsIs(FlagsIN.Strings[i]); + IDX := Piece(FlagsIN.Strings[i],U,1); + + strTFactors := TFactors; + + if UBAGlobals.SC <> 'N' then + if StrPos(PChar(strTFactors),PChar(SERVICE_CONNECTED)) <> nil then + UBAGlobals.SC := 'C' ; + + if UBAGlobals.SC <> 'N' then + if StrPos(PChar(strTFactors),PChar(NOT_SERVICE_CONNECTED)) <> nil then + UBAGlobals.SC := 'U'; + + if UBAGlobals.AO <>'N' then + if StrPos(PChar(strTFactors),PChar(AGENT_ORANGE)) <> nil then + UBAGlobals.AO := 'C'; + + if UBAGlobals.IR <>'N' then + if StrPos(PChar(strTFactors),PChar(IONIZING_RADIATION)) <> nil then + UBAGlobals.IR := 'C'; + + if UBAGlobals.EC <>'N' then + if StrPos(PChar(strTFactors),PChar(ENVIRONMENTAL_CONTAM)) <> nil then + UBAGlobals.EC := 'C'; + + if UBAGlobals.MST <>'N' then + if StrPos(PChar(strTFactors),PChar(MILITARY_SEXUAL_TRAUMA)) <> nil then + UBAGlobals.MST := 'C'; + + if UBAGlobals.CV <>'N' then + if StrPos(PChar(strTFactors),PChar(COMBAT_VETERAN)) <> nil then + UBAGlobals.CV := 'C'; + + if UBAGlobals.HNC <>'N' then + if StrPos(PChar(strTFactors),PChar(HEAD_NECK_CANCER)) <> nil then + UBAGlobals.HNC := 'C'; + + // Build Treatment Factor List to be passed to fOrdersSign form + strFlagsOut := (SC + AO + IR + EC + MST + HNC + CV); + UBAGlobals.BAFlagsOUT.Add(IDX + '^' + strFlagsOut ); + end; + end; + + +function StripTFactors(FactorsIN: string):string; +var strDxCode,strDxName:string; +begin + Result := ''; + strDxCode := Piece(FactorsIN,U,2); + strDxName := Piece(FactorsIN,'(',1); + Result := (strDxName + U + strDxCode); +end; + +function AddProviderPatientDaysDx(Dest: TStringList; ProviderIEN: string;PatientIEN: string) : TStringList; +var i:integer; + x: string; + tmplst: TStringList; +begin + tmplst := TStringList.Create; + tmplst.clear; + tCallV(tmplst, 'ORWDBA2 GETDUDC', [ProviderIEN, PatientIEN]); + + try + for i := 0 to tmplst.count-1 do + x := tmplst.Strings[i]; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBACore.AddProviderPatientDaysDx()');{$endif} + raise; + end; + end; + + Result := tmplst; +end; + + +function OrderRequiresSCEI(pOrderID: string):boolean; +var i:integer; + +begin + Result := False; + + try + for i := 0 to UBAGlobals.OrderListSCEI.Count-1 do + begin + if pOrderID = UBAGlobals.OrderListSCEI.Strings[i] then + begin + Result := True; + Break; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBACore.OrderRequiresSCEI()');{$endif} + raise; + end; + end; +end; + +procedure SaveUnsignedOrders(pOrderRec:String); +begin + // save all unsigned orders, keeping freview and fordersSign in sync + // this change may have an impact on response time?????? + // change from save orders with dx to save all. 06/24/04 + // / if not clear treatment factors for order is non cidc + uBAGlobals.UnsignedOrders.Add(pOrderRec); + +end; + +function rpcRetrieveSelectedOrderInfo(pOrderIDList: TStringList):TStringList; +var + rList : TStringList; + newList:TStringList; + i: integer; + x: string; +begin + rList := TStringList.Create; + newList := TStringList.Create; + if Assigned(rList) then rList.Clear; + if Assigned(newList) then newList.Clear; + + for i := 0 to pOrderIDList.Count-1 do + begin + newList.Add(Piece(pOrderIDList.Strings[i],';',1)); + x := newlist.strings[i]; + end; + if newList.Count > 0 then + tCallV(rList,'ORWDBA4 GETTFCI',[newList]); + Result := rList; + + +end; + +procedure BuildSaveUnsignedList(pOrderList: TStringList); +var + thisList: TStringList; + rList: TStringList; +begin + + thisList := TStringList.Create; + rList := TStringList.Create; + if Assigned(rList) then rList.Clear; + if Assigned(thisList)then thisList.Clear; + SaveBillingData(pOrderList); // save unsigned info to be displayed when recalled at later time +end; + +function rpcGetUnsignedOrdersBillingData(pOrderList: TStringList):TStringList; +var + i:integer; + newList:TStringList; + rList:TStringList; +begin + newList := TStringList.Create; + rList := TStringList.Create; + if Assigned(newList) then newList.Clear; + if Assigned(rList) then rList.Clear; + Result := rList; + + if pOrderList.Count = 0 then Exit; + for i := 0 to pOrderList.Count-1 do + begin + newList.Add(Piece(pOrderList.Strings[i],';',1)); + end; + tCallV(rList,'ORWDBA4 GETTFCI',[newList]); + Result := rList; +end; + +procedure CompleteUnsignedBillingInfo(pOrderList:TStringList); +var +i: integer; +RecOut : TBADxRecord; +copyList: TStringList; +begin + copyList := TStringList.Create; + if Assigned(copyList) then copyList.Clear; + + if Assigned(BAUnSignedOrders) then BAUnSignedOrders.Clear; + + if not Assigned(UBAGlobals.UnsignedBillingRec) then + begin + UBAGlobals.UnSignedBillingRec := UBAGlobals.TBAUnsignedBillingRec.Create; + UBAGlobals.InitializeUnsignedOrderRec(UBAGlobals.UnsignedBillingRec); + end; + + UBAGlobals.InitializeUnsignedOrderRec(UnsignedBillingRec); + + try + for i := 0 to pOrderList.Count-1 do + begin + LoadUnsignedOrderRec(UBAGlobals.UnsignedBillingRec, pOrderList.Strings[i]); + if Not UBAGlobals.tempDxNodeExists(UnsignedBillingRec.FBAOrderID) then + begin + SimpleAddTempDxList(UnSignedBillingRec.FBAOrderID); + RecOut := TBADxRecord.Create; + RecOut.FExistingRecordID := UnSignedBillingRec.FBAOrderID; + RecOut.FBADxCode := UnsignedBillingRec.FBADxCode; + RecOut.FBASecDx1 := UnsignedBillingRec.FBASecDx1; + RecOut.FBASecDx2 := UnsignedBillingRec.FBASecDx2; + RecOut.FBASecDx3 := UnsignedBillingRec.FBASecDx3; + RecOut.FTreatmentFactors := UnSignedBillingRec.FBASTSFlags; + PutBADxListForOrder(RecOut, RecOut.FExistingRecordID); + UBAGlobals.BAUnSignedOrders.Add(UnSignedBillingRec.FBAOrderID + '^' + UnSignedBillingRec.FBASTSFlags); + end + else + begin + RecOut := TBADxRecord.Create; + if tempDxNodeExists(UnSignedBillingRec.FBAOrderID) then + begin + GetBADxListForOrder(RecOut, UnSignedBillingRec.FBAOrderID); //load data from source + copyList.Add(UnSignedBillingRec.FBAOrderID + '^' + UnSignedBillingRec.FBASTSFlags); + BuildSaveUnsignedList(copyList); + end; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBACore.CompleteUnsignedBillingInfo()');{$endif} + raise; + end; + end; +end; + +function GetUnsignedOrderFlags(pOrderID: string; pFlagList: TStringList):string; +var + i: integer; +begin + Result := ''; + try + for i := 0 to pFlagList.Count-1 do + begin + if pOrderID = Piece(pFlagList.Strings[i],U,1) then + begin + Result := Piece(pFlagList.Strings[i],U,2); // STSFlags + Break; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBACore.GetUnsignedOrderFlags()');{$endif} + raise; + end; + end; + +end; + +// BuildTFHintRec is meant to run once, first user of the session +// contains the information to be displayed while mouse-over in fOrdersSign and fReview. +procedure BuildTFHintRec; +var +hintList :TStringList; +i: integer; +x: string; +begin + hintList := TStringList.Create; + if Assigned(hintList) then hintList.Clear; + hintList := rpcGetTFHintData; + if hintList.Count > 0 then UBAGlobals.BAFactorsRec.FBAFactorActive := TRUE; + + try + for i := 0 to hintList.Count -1 do + begin + x := hintList.Strings[i]; + if piece(x,U,1) = SERVICE_CONNECTED then + begin + if piece(x,U,2) = '1' then + UBAGlobals.BAFactorsRec.FBAFactorSC := Piece(x,U,3) + else + UBAGlobals.BAFactorsRec.FBAFactorSC := ( UBAGlobals.BAFactorsRec.FBAFactorSC + CRLF + Piece(x,U,3) ); + end + else + if piece(x,U,1) = AGENT_ORANGE then + begin + if piece(x,U,2) = '1' then + UBAGlobals.BAFactorsRec.FBAFactorAO := Piece(x,U,3) + else + UBAGlobals.BAFactorsRec.FBAFactorAO := (UBAGlobals.BAFactorsRec.FBAFactorAO + CRLF + Piece(x,U,3) ); + end + else + if piece(x,U,1) = IONIZING_RADIATION then + begin + if piece(x,U,2) = '1' then + UBAGlobals.BAFactorsRec.FBAFactorIR := Piece(x,U,3) + else + UBAGlobals.BAFactorsRec.FBAFactorIR := (UBAGlobals.BAFactorsRec.FBAFactorIR + CRLF + Piece(x,U,3) ); + end + else + if piece(x,U,1) = ENVIRONMENTAL_CONTAM then + begin + if piece(x,U,2) = '1' then + UBAGlobals.BAFactorsRec.FBAFactorEC := Piece(x,U,3) + else + UBAGlobals.BAFactorsRec.FBAFactorEC := (UBAGlobals.BAFactorsRec.FBAFactorEC + CRLF + Piece(x,U,3) ); + end + else + if piece(x,U,1) = HEAD_NECK_CANCER then + begin + if piece(x,U,2) = '1' then + UBAGlobals.BAFactorsRec.FBAFactorHNC := Piece(x,U,3) + else + UBAGlobals.BAFactorsRec.FBAFactorHNC := (UBAGlobals.BAFactorsRec.FBAFactorHNC + CRLF + Piece(x,U,3) ); + end + else + if piece(x,U,1) = MILITARY_SEXUAL_TRAUMA then + begin + if piece(x,U,2) = '1' then + UBAGlobals.BAFactorsRec.FBAFactorMST := Piece(x,U,3) + else + UBAGlobals.BAFactorsRec.FBAFactorMST := (UBAGlobals.BAFactorsRec.FBAFactorMST + CRLF + Piece(x,U,3) ); + end + else + if piece(x,U,1) = COMBAT_VETERAN then + begin + if piece(x,U,2) = '1' then + UBAGlobals.BAFactorsRec.FBAFactorCV := Piece(x,U,3) + else + UBAGlobals.BAFactorsRec.FBAFactorCV := (UBAGlobals.BAFactorsRec.FBAFactorCV + CRLF + Piece(x,U,3) ); + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBACore.BuileTFHintRec()');{$endif} + raise; + end; + end; +end; + + +function IsAllOrdersNA(pOrderList:TStringList):boolean; +var + i:integer; + rList: TStringList; +begin + rList := TStringList.Create; + if Assigned(rList) then rList.Clear; + Result := True;// disables dx button + + // call returns boolean, orders is billable=1 or nonbillable=0 or discontinued = 0 + tCallV(rList,'ORWDBA1 ORPKGTYP',[pOrderList]); + + for i := 0 to rList.Count-1 do + begin + if rList.Strings[i] = BILLABLE_ORDER then + begin + Result := False; + Break; + end; + end; +end; + +function PrepOrderID(pOrderID:String): String; +var + newOrderID: String; +begin + newOrderID := ''; + if pos(';',pOrderID) > 0 then + newOrderID := Piece(pOrderID,';',1) + else + newOrderID := pOrderID ; + + Result := newOrderID; +end; + +procedure ClearSelectedOrderDiagnoses(pOrderIDList: TStringList); +var + RecOut: TBADXRecord; + i: integer; +begin + try + for i := 0 to pOrderIDList.Count-1 do + begin + if UBAGlobals.tempDxNodeExists(pOrderIDList.Strings[i]) then + begin + RecOut := TBADxRecord.Create; + GetBADxListForOrder(RecOut, pOrderIDList.Strings[i]); + RecOut.FOrderID := RecOut.FOrderID; + RecOut.FBADxCode := DXREC_INIT_FIELD_VAL; + RecOut.FBASecDx1 := DXREC_INIT_FIELD_VAL; + RecOut.FBASecDx2 := DXREC_INIT_FIELD_VAL; + RecOut.FBASecDx3 := DXREC_INIT_FIELD_VAL; + PutBADxListForOrder(RecOut, pOrderIDList.Strings[i]); + frmReview.lstReview.Refresh; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBACore.ClearSelectedORdersDiagnoses()');{$endif} + raise; + end; + end; +end; + +procedure LoadConsultOrderRec(var thisRetVal: TBAConsultOrderRec; pOrderID: String; pDxList: TStringList); +var + thisString, thisFlags:String; + dx1,dx2,dx3,dx4: string; + i: integer; +begin + thisFlags := ''; + dx1 := ''; + dx2 := ''; + dx3 := ''; + dx4 := ''; + UBAGlobals.BAConsultDxList.Sort; + + try + for i := 0 to UBAGlobals.BAConsultDxList.Count -1 do + begin + thisString := UBAGlobals.BAConsultDxList[i]; + + if i = 0 then + begin + if pos( '(', thisString) > 0 then + begin + thisFlags := Piece(thisString,'(',2); + thisFlags := Piece(thisFlags,')',1); + UBAGlobals.BAConsultPLFlags.Add(pOrderID + U + thisFlags); + dx1 := Piece(thisString,U,2); + dx1 := Piece(dx1,'(',1) + U + Piece(thisString,':',2); + end + else + begin + dx1 := Piece(thisString,U,2); + dx1 := Piece(dx1,':',1)+ U + Piece(thisString,':',2); + end + end + else + if i = 1 then + begin + if pos( '(', thisString) > 0 then + begin + dx2 := Piece(thisString,U,2); + dx2 := Piece(dx2,'(',1)+ U + Piece(thisString,':',2); + end + else + begin + dx2 := Piece(thisString,U,2); + dx2 := Piece(dx2,':',1)+ U + Piece(thisString,':',2); + end + end + else + if i = 2 then + begin + if pos( '(', thisString) > 0 then + begin + dx3 := Piece(thisString,U,2); + dx3 := Piece(dx3,'(',1)+ U + Piece(thisString,':',2); + end + else + begin + dx3 := Piece(thisString,U,2); + dx3 := Piece(dx3,':',1)+ U + Piece(thisString,':',2); + end + end + else + if i = 3 then + begin + if pos( '(', thisString) > 0 then + begin + dx4 := Piece(thisString,U,2); + dx4 := Piece(dx4,'(',1)+ U + Piece(thisString,':',2); + end + else + begin + dx4 := Piece(thisString,U,2); + dx4 := Piece(dx4,':',1)+ U + Piece(thisString,':',2); + end; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBACore.LoadConsultOrderRec()');{$endif} + raise; + end; + end; + + with thisRetVal do + begin + FBAOrderID := pOrderID; + FBATreatmentFactors:= thisFlags; + FBADxCode := dx1; + FBASecDx1 := dx2; + FBASecDx2 := dx3; + FBASecDx3 := dx4; + end; +end; + +procedure LoadTFactorsInRec(var thisRetVal: TBATreatmentFactorsInRec; pOrderID:string; pEligible: string; pTFactors:string); +begin + with thisRetVal do + begin + FBAOrderID := pOrderID; + FBAEligible := pEligible; + FBATFactors := pTFactors; + end; +end; + +procedure CompleteConsultOrderRec(pOrderID: string; pDxList: TStringList); +var + RecOut : TBADxRecord; + TfFlags,dxRec: string; + orderList : TStringList; + tmpOrderList: TStringList; +begin + orderList := TStringList.Create; + tmpOrderList := TStringList.Create; + orderList.Clear; + tmpOrderList.Clear; + if not Assigned(uBAGlobals.ConsultOrderRec)then + begin + UBAGlobals.ConsultOrderRec := UBAGlobals.TBAConsultOrderRec.Create; + InitializeConsultOrderRec(UBAGlobals.ConsultOrderRec); + end + else + InitializeConsultOrderRec(UBAGlobals.ConsultOrderRec); + // call rpc to load list with boolean values based on orders package type. + UBAGlobals.NonBillableOrderList.Clear; + tmpOrderList.Add(UBAGLobals.BAOrderID); + rpcNonBillableOrders(tmpOrderList); + if IsOrderBillable(uBAGlobals.BAOrderID) then + begin + if not UBAGlobals.tempDxNodeExists(uBAGlobals.BAOrderID) then + begin + LoadConsultOrderRec(UBAGlobals.ConsultOrderRec,UBAGlobals.BAOrderID,uBAGlobals.BAConsultDxList); + if NOT UBAGlobals.tempDxNodeExists(pOrderID) then + SimpleAddTempDxList(pOrderID); + RecOut := TBADxRecord.Create; + RecOut.FExistingRecordID := pOrderID; + RecOut.FBADxCode := ConsultOrderRec.FBADxCode; + RecOut.FBASecDx1 := ConsultOrderRec.FBASecDx1; + RecOut.FBASecDx2 := ConsultOrderRec.FBASecDx2; + RecOut.FBASecDx3 := ConsultOrderRec.FBASecDx3; + RecOut.FTreatmentFactors := ConsultOrderRec.FBATreatmentFactors; + PutBADxListForOrder(RecOut, RecOut.FExistingRecordID); +// HDS00003380 + if IsUserNurseProvider(User.DUZ) then + begin + dxRec := BuildConsultDxRec(ConsultOrderRec); + orderList.Add(RecOut.FExistingRecordID); + // TfFlags := Piece(GetPatientTFactors(orderList),U,2); + TfFlags := GetPatientTFactors(orderList); + TfFlags := ConvertPIMTreatmentFactors(TfFlags); + orderList.Clear; + // if strLen(PChar(dxRec)) > 0 then + // orderList.Add(RecOut.FExistingRecordID +TfFlags + '^'+ BuildConsultDxRec(ConsultOrderRec) ) + // else + orderList.Add(RecOut.FExistingRecordID +TfFlags); + SaveBillingData(OrderList); // save unsigned info to be displayed when re + end; + end; + end; +end; + +function GetConsultFlags(pOrderID:String; pFlagList:TStringList;FlagsAsIs:string):string; +var + i: integer; //add code to match order id..... +begin + Result := ''; + for i := 0 to pFlagList.Count -1 do + begin + if pOrderID = Piece(pFlagList.Strings[i],U,1) then + begin + Result := SetConsultFlags( Piece(pFlagList.Strings[i],U,2), FlagsAsIs); + break; + end; + end; + +end; + +function SetConsultFlags(pPLFactors: string; pFlagsAsIs:string):string; // return updated flags. +var + strFlagsAsIs: string; + strTFactors: string; + strFlagsOut,x: string; + +begin + strFlagsAsIs := pFlagsAsIs; // flags from pims + strTFactors := pPLFactors; // value selected from problem list + strFlagsOut := ''; // flags updated with selected values from problem list + x := strFlagsAsIs; + Result := ''; + + UBAGlobals.SC := Copy(x,1,1); + UBAGlobals.AO := Copy(x,2,1); + UBAGlobals.IR := Copy(x,3,1); + UBAGlobals.EC := Copy(x,4,1); + UBAGlobals.MST := Copy(x,5,1); + UBAGlobals.HNC := Copy(x,6,1); + UBAGlobals.CV := Copy(x,7,1); // load factors to global vars; + + if UBAGlobals.SC <> 'N' then + if StrPos(PChar(strTFactors),PChar(SERVICE_CONNECTED)) <> nil then + UBAGlobals.SC := 'C' ; + + if UBAGlobals.SC <> 'N' then + if StrPos(PChar(strTFactors),PChar(NOT_SERVICE_CONNECTED)) <> nil then + UBAGlobals.SC := 'U'; + + if UBAGlobals.AO <>'N' then + if StrPos(PChar(strTFactors),PChar(AGENT_ORANGE)) <> nil then + UBAGlobals.AO := 'C'; + + if UBAGlobals.IR <>'N' then + if StrPos(PChar(strTFactors),PChar(IONIZING_RADIATION)) <> nil then + UBAGlobals.IR := 'C'; + + if UBAGlobals.EC <>'N' then + if StrPos(PChar(strTFactors),PChar(ENVIRONMENTAL_CONTAM)) <> nil then + UBAGlobals.EC := 'C'; + + if UBAGlobals.MST <>'N' then + if StrPos(PChar(strTFactors),PChar(MILITARY_SEXUAL_TRAUMA)) <> nil then + UBAGlobals.MST := 'C'; + + if UBAGlobals.HNC <> 'N' then + if StrPos(PChar(strTFactors),PChar(HEAD_NECK_CANCER)) <> nil then + UBAGlobals.HNC := 'C'; + + if UBAGlobals.CV <>'N' then + if StrPos(PChar(strTFactors),PChar(COMBAT_VETERAN)) <> nil then + UBAGlobals.CV := 'C'; + + strFlagsOut := (UBAGlobals.SC + UBAGlobals.AO + UBAGlobals.IR + + UBAGlobals.EC + UBAGlobals.MST + UBAGlobals.HNC + + UBAGlobals.CV); + Result := strFlagsOut; +end; + +procedure GetBAStatus(pProvider:int64; pPatientDFN: string); +begin + // sets global switch, based in value returned from server. + // True -> Billing Aware Switch ON. else OFF + + UBACore.rpcSetBillingAwareSwitch(pProvider,pPatientDFN); + + if Assigned(UBAGlobals.BAPCEDiagList) then UBAGlobals.BAPCEDiagList.Clear; + frmFrame.SetBADxList; + if not UBAGlobals.BAFactorsRec.FBAFactorActive then + UBACore.BuildTFHintRec; +end; + +function IsICD9CodeActive(ACode: string; LexApp: string; ADate: TFMDateTime = 0): boolean; +var + inactiveChar : string; +begin + inactiveChar := '#'; + if StrPos(PChar(ACode),PChar(inactiveChar) ) <> nil then + ACode := Piece(ACode,'#',1); // remove the '#' added for inactive code. + Result := (sCallV('ORWPCE ACTIVE CODE',[ACode, LexApp, ADate]) = '1'); +end; + +function BuildConsultDxRec(ConsultRec: TBAConsultOrderRec): string; +var +newString: string; +begin + if strLen(PChar(ConsultRec.FBADxCode)) > 0 then + newString := Piece(ConsultRec.FBADxCode,U,2) + else + if strLen(PChar(ConsultRec.FBASecDx1)) > 0 then + newString := newString + '^' + Piece(ConsultRec.FBASecDx1,U,2) + else + if strLen(PChar(ConsultRec.FBASecDx2)) > 0 then + newString := newString + '^' + Piece(ConsultRec.FBASecDx2,U,2) + else + if strLen(PChar(ConsultRec.FBASecDx3)) > 0 then + newString := newString + '^' + Piece(ConsultRec.FBASecDx3,U,2); + Result := newString; +end; + +function ConvertPIMTreatmentFactors(pTFactors:string):string; +var + strSC,strAO, strIR: string; + strEC, strMST, strHNC, strCV: string; + +begin + Result := ''; + if StrPos(PChar(pTFactors),PChar(SERVICE_CONNECTED)) <> nil then + strSC := '?' + else + strSC := 'N'; + + if StrPos(PChar(pTFactors),PChar(AGENT_ORANGE)) <> nil then + strAO := '?' + else + strAO := 'N'; + + if StrPos(PChar(pTFactors),PChar(IONIZING_RADIATION)) <> nil then + strIR := '?' + else + strIR := 'N'; + + if StrPos(PChar(pTFactors),PChar(ENVIRONMENTAL_CONTAM)) <> nil then + strEC := '?' + else + strEC := 'N'; + + if StrPos(PChar(pTFactors),PChar(MILITARY_SEXUAL_TRAUMA)) <> nil then + strMST := '?' + else + strMST := 'N'; + + if StrPos(PChar(pTFactors),PChar(HEAD_NECK_CANCER)) <> nil then + strHNC := '?' + else + strHNC := 'N'; + + if StrPos(PChar(pTFactors),PChar(COMBAT_VETERAN)) <> nil then + strCV := '?' + else + strCV := 'N'; + + Result := (strSC + strAO + strIR + strEC + strMST + strHNC + strCV); +end; + + +// Delete dc'd orders from BACopiedOrderList to keep things in sync. +procedure DeleteDCOrdersFromCopiedList(pOrderID:string); +var i:integer; + holdList: TStringList; + x: string; +begin + holdList := TStringList.Create; + holdList.Clear; + holdList.Assign(UBAGlobals.BACopiedOrderFlags); + UBAGlobals.BACopiedOrderFlags.Clear; + for i := 0 to holdList.Count-1 do + begin + x := Piece(holdList.Strings[i],';',1); + if pOrderID = Piece(holdList.Strings[i],';',1) then + continue + else + UBAGlobals.BACopiedOrderFlags.Add(holdList.Strings[i]); + end; +end; + +procedure UpdateBAConsultOrderList(pDcOrders: TStringList); +var + x: string; + var i,j: integer; + holdList : TStringList; +begin + // remove order enteries from the dx list that are being discontinued. + for i := 0 to pDcOrders.Count -1 do + begin + UBAGlobals.RemoveOrderFromDxList(pDcOrders.Strings[i]); + end; + if UBAGlobals.BAConsultPLFlags.Count > 0 then + begin + holdList := TStringList.Create; + holdList.Clear; + holdList.Assign(UBAGlobals.BAConsultPLFlags); + UBAGlobals.BAConsultPLFlags.Clear; + for i := 0 to holdList.Count-1 do + begin + x := holdList.Strings[i]; + for j := 0 to pDcOrders.Count-1 do + begin + if x = pDcOrders.Strings[j] then + continue + else + UBAGlobals.BAConsultPLFlags.Add(x); + end; + end; + end; +end; + +// loop thru CIDC records remove records with invalid orderid +function VerifyOrderIdExists(pOrderList: TStringList): TStringList; +var + goodList: TStringList; + tOrderID: integer; + i: integer; +begin + goodList := TStringList.Create; + goodList.clear; + + if pOrderList.Count > 0 then + begin + for i := 0 to pOrderList.Count-1 do + begin + tOrderID := StrToIntDef(Piece(pOrderList.Strings[i],';',1), 0); + if tOrderID > 0 then + goodList.add(pOrderList.Strings[i]); + end; + end; + result := goodList; +end; + +// parse string return Treatment Factors when text inlcudes multiple "(())" +//HDS8409 +function ProcessProblemTFactors(pText:String):String; +var AText1,x: string; + i,j: integer; +begin + if StrPos(PChar(pText),'(') = nil then exit; + AText1 := Piece(pText,U,2); + i := 1; + j := 0; + while j = 0 do + begin + x := Piece(AText1,'(',i); + if Length(x) > 0 then + inc(i) + else + begin + x := Piece(AText1,'(',i-1); + x := Piece(x,')',1); + j := 1; + Result := x; + end; + end; +end; + +end. + + + Index: cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBAGlobals.pas =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBAGlobals.pas (revision 541) +++ cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBAGlobals.pas (revision 541) @@ -0,0 +1,1183 @@ +//kt -- Modified with SourceScanner on 8/8/2007 + unit UBAGlobals; + +{$OPTIMIZATION OFF} + +{$define debug} + +interface + +uses + Classes, ORNet, uConst, ORFn, Sysutils, Dialogs, Windows,Messages, rOrders; + +type + + {Problem List Record Used To Add New DX From SignOrders Form } + TBAPLRec = class(TObject) + constructor Create(PLlist:TStringList); + function BuildProblemListDxEntry(pDxCode:string):TStringList; + function FMToDateTime(FMDateTime: string): TDateTime; + + end; + + {patient qualifiers} + TBAPLPt=class(TObject) + PtVAMC:string; + PtDead:string; + PtBid:string; + PtServiceConnected:boolean; + PtAgentOrange:boolean; + PtRadiation:boolean; + PtEnvironmental:boolean; + PtHNC:boolean; + PtMST:boolean; + constructor Create(Alist:TStringList); + function GetGMPDFN(dfn:string;name:String):string; + public + function rpcInitPt(const PatientDFN: string): TStrings ; + procedure LoadPatientParams(AList:TstringList); + + end; + + TBAGlobals = class(TObject) + private + FOrderNum: string; + protected + public + constructor Create; + published + property OrderNum: string read FOrderNum write FOrderNum; + procedure AddBAPCEDiag(DiagStr:string); + procedure ClearBAPCEDiagList; + end; + + TBADxRecord = class(TObject) + FExistingRecordID: string; + FOrderID: string; + FBADxCode: string; //Primary Dx + FBASecDx1: string; //Secondary Dx 1 + FBASecDx2: string; //Secondary Dx 2 + FBASecDx3: string; //Secondary Dx 3 + FDxDescCode: string; + FDxDesc1: string; + FDxDesc2: string; + FDxDesc3: string; + FTreatmentFactors: string; + end; + + TBACopiedOrderFlags = class + OrderID: string; +end; + + TBATreatmentFactorsInRec = class(TObject) + FBAOrderID: string; + FBAEligible: string; + FBATFactors: string; + end; + + TBAUnsignedBillingRec = class(TObject) + FBAOrderID: string; + FBASTSFlags: string; + FBADxCode: string; + FBASecDx1: string; + FBASecDx2: string; + FBASecDx3: string; + end; + + TBAConsultOrderRec = class(TObject) + FBAOrderID: string; + FBADxCode: string; + FBASecDx1: string; + FBASecDx2: string; + FBASecDx3: string; + FBATreatmentFactors: string; + end; + + TBAClearedBillingRec = class(TObject) + FBAOrderID: string; + FBASTSFlags: string; + FBADxCode: string; + FBASecDx1: string; + FBASecDx2: string; + FBASecDx3: string; + end; + + TBAFactorsRec = class(TObject) + FBAFactorActive : boolean; + FBAFactorSC : string; + FBAFactorMST : string; + FBAFactorAO : string; + FBAFactorIR : string; + FBAFactorEC : string; + FBAFactorHNC : string; + FBAFactorCV : string; + end; + + TBAPLFactorsIN = class(TOBject) + FPatientID : string; // UProblems.piece 1 + FBADxText : string; // UProblems.piece 2 + FBADxCode : string; // UProblems.piece 3 + FBASC : string; // UProblems.piece 5 + FBASC_YN : string; // UProblems.piece 6 + FBATreatFactors : string; //(......) + end; + + TBACBStsFlagsIN = class(TOBject) // Y/N/U + CB_Sts_Flags :string; + // CB_SC :string; + CB_AO :string; + CB_IR :string; + CB_EC :string; + CB_MST :string; + CB_HNC :string; + CB_CV :string; + end; + +procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string); //BAPHII 1.3.1 +procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string); //BAPHII 1.3.1 +function GetPrimaryDx(thisOrderID: string) : string; //BAPHII 1.3.1 +function tempDxNodeExists(thisOrderID: string) : boolean; +function GetDxNodeIndex(thisOrderID: string) : smallint; +function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean; +function CountSelectedOrders(const Caller: smallint) : smallint; +function CompareOrderDx(const Caller: smallint) : boolean; +procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string); +procedure DestroyDxList; +procedure SetBADxList; +procedure SimpleAddTempDxList(thisOrderID: string); +procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string); +function AllSelectedDxBlank(const Caller: smallint) : boolean; +function SecondaryDxFull(thisOrderID: string) : boolean; +procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string); +procedure InitializeNewDxRec(var thisDxRec: TBADxRecord); +procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec); +procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec); +procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec); +procedure BACopyOrder(sourceOrderList: TStringList); //BAPHII 1.3.2 +procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string); //BAPHII 1.3.2 +procedure CopyTreatmentFactorsDxsToRenewedOrder; //BAPHII 1.3.2 +function GetTFCIForOrder(thisIndex: integer) : string; //BAPHII 1.3.2 +procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string); + +procedure ResetOrderID(fromID: string; toID: string); +procedure RemoveOrderFromDxList(thisOrderID: string); +function IsUserNurseProvider(pUserID: int64): boolean; +function GetPatientTFactors(pOrderList:TStringList): String; + +var + BAGlobals : TBAGlobals; + BAPLPt : TBAPLPt; + BAPLRec : TBAPLRec; + PLlist : TStringList; + BADiagnosisList : TStringList; + BALocation : integer; + BAPCEDiagList : TStringList; + BAOrderIDList : TStringList; + tempDxList : TList; + globalDxRec : TBADxRecord; + UnsignedBillingRec : TBAUnsignedBillingRec; + ClearedBillingRec : TBAClearedBillingRec; + ConsultOrderRec : TBAConsultOrderRec; + BAFactorsInRec : TBATreatmentFactorsInRec; + BAFactorsRec : TBAFactorsRec; + BAOrderList : TStringList; + UpdatedBAOrderList: TStringList; + ChangeItemOrderNum: string; + i : integer; + OrderIDList : TStringList; + OrderBillableList : TStrings; + BAOrderID : string; + BILLING_AWARE : boolean; + + BAtmpOrderList : TStringList; + BAFlagsIN : string; + BAFlagsOUT : TStringList; + + SourceOrderID : string; //BAPHII 1.3.2 + TargetOrderID : string; //BAPHII 1.3.2 + BACopiedOrderFlags: TStringList; //BAPHII 1.3.2 + BANurseConsultOrders: TStringList; + + // Used to display Dx's on fordersSign and fReview grids + Dx1 : string; + Dx2 : string; + Dx3 : string; + Dx4 : string; + TFactors : string; + SC,AO,IR : string; + MST,HNC,CV,EC : string; + PLFactorsIndexes : TStringList; + BAHoldPrimaryDx : string; // used to verify primart dx has been changed. + BAPrimaryDxChanged: boolean; +// OrdersReqDxLst : TStringList; // List of selected Orders flagged collect DX Y/N + NonBillableOrderList : TStringList; // contains reference to those selected orders that are non billable + OrderListSCEI : TSTringList; // OrderID Exists SCEI are required. + UnsignedOrders : TStringList; // List of Orders from fReview when "don't sign" action + BAUnSignedOrders : TStringList; // OrderID^StsFlags ie., 12345^NNNNNNN + BATFHints : TStringList; + BASelectedList : TStringList; // contains list of orders selected for signature. + BAConsultDxList: TStringList; // contains dx^code^DxRequired(consults Only) selected for consults. + BAConsultPLFlags: TStringList; // orderid^flags contains TF's if dx is selected from Problem list and Problem had TF associated. + BAFWarningShown: boolean; // flag used to determine if Inactive ICD Code has been shown. + BAPersonalDX: boolean; +// BAConsultOrdersRequireDx: TStringList; //orderid - if orderid exists - consult order that requires dx... + BADeltedOrders: TStringList; + +implementation + +uses fBALocalDiagnoses, fOrdersSign, fReview, uCore, rCore, rPCE,uPCE, UBAConst, UBAMessages, UBACore; + +procedure RemoveOrderFromDxList(thisOrderID: string); +{ + This routine written for CQ4589. Called from fOrdersDC.ExecuteDCOrders(). +} +var + i: integer; +begin + if tempDxList.Count > 0 then + for i := 0 to tempDxList.Count-1 do + if tempDxNodeExists(thisOrderID) then + if ((TBADxRecord(tempDxList[i]).FOrderID = thisOrderID) and (tempDxList[i] <> nil)) then + begin + //tempDxList.Items[i] := nil; //remove reference to this item, effectively deleting it from the list (see Delphi help) + BACopiedOrderFlags.Clear; + UBAGlobals.SourceOrderID := ''; + UBAGlobals.TargetOrderID := ''; + tempDxList.Delete(i); //remove this item from the CIDC Dx list + end; +end; + +procedure ResetOrderID(fromID: string; toID: string); +var + i: integer; +begin + for i := 0 to tempDxList.Count-1 do + begin + if TBADxRecord(tempDxList[i]).FOrderID = fromID then + TBADxRecord(tempDxList[i]).FOrderID := toID; + end; +end; + +function GetTFCIForOrder(thisIndex: integer) : string; +{ + Retrieve BA flags for 'thisOrderID', and convert them to CPRS type uSignItems.StsChar array. +} +begin + Result := BACopiedOrderFlags[thisIndex]; +end; + +procedure CopyTFCIToTargetOrder(thisTargetOrderID: string; thisCheckBoxStatus: string); +var + i: integer; +begin + for i := 0 to tempDxList.Count - 1 do + if TBADxRecord(tempDxList[i]).FOrderID = thisTargetOrderID then + TBADxRecord(tempDxList[i]).FTreatmentFactors := thisCheckBoxStatus; +end; + +procedure BACopyOrder(sourceOrderList: TStringList); +{ BAPHII 1.3.2 + Copy source order to target order, including Dx's, Dx descriptions, Treatment Factors and Clinical Indicators +} +var + newList,rList: TStringList; + i: integer; + x: string; + +begin + newList := TStringList.Create; + rList := TSTRingList.Create; + newList.Clear; + rList.Clear; + + CopyDxRecord(UBAGlobals.SourceOrderID, UBAGlobals.TargetOrderID); //copy dx's to tempDxList record + newList.Add(UBAGlobals.SourceOrderID); + rList := rpcGetUnsignedOrdersBillingData(newList); + + if RList.Count > 0 then + begin + for i := 0 to rList.Count-1 do + begin + x := rList.Strings[i]; + BACopiedOrderFlags.Add(TargetOrderID + '^' + Piece(x,U,2) ); + end; + end + else + begin + BACopiedOrderFlags.Add(TargetOrderID + '^' + frmSignOrders.GetCheckBoxStatus(sourceOrderID) ); + end; +end; + +procedure CopyTreatmentFactorsDxsToCopiedOrder(pSourceOrderID:string; pTargetOrderID:string); +{ + BAPHII 1.3.2 +} +var + sourceOrderList: TStringList; + sourceOrderID: TStringList; + targetOrderIDLst: TStringList; +begin + //Retrieve TF's/CI's from SOURCE Order + sourceOrderList := TStringList.Create; + targetOrderIDLst := TStringList.Create; + sourceOrderList.Clear; + targetOrderIDLst.Clear; + sourceOrderID := TStringList.Create; + sourceOrderID.Clear; + sourceOrderID.Add(Piece(pSourceOrderID, ';', 1)); + targetOrderIDLst.Add(pTargetOrderID); + { if targetORderID is not billable do not create entry in BADXRecord - List fix HDS00003130} + rpcNonBillableOrders(targetOrderIDLst); + if IsOrderBillable(pTargetOrderID) then + begin + tCallV(sourceOrderList, 'ORWDBA4 GETTFCI', [sourceOrderID]); + BACopyOrder(sourceOrderList); + end; +end; + +procedure CopyTreatmentFactorsDxsToRenewedOrder; +{ + BAPHII 1.3.2 +} +var + sourceOrderList: TStringList; + sourceOrderID: TStringList; + targetOrderList: TStringList; +begin + //Retrieve TF's/CI's from SOURCE Order + sourceOrderList := TStringList.Create; + sourceOrderList.Clear; + sourceOrderID := TStringList.Create; + sourceOrderID.Clear; + targetOrderList := TStringList.Create; + targetOrderList.Clear; + sourceOrderID.Add(Piece(UBAGlobals.sourceOrderID, ';', 1)); + { if targetORderID is not billable do not create entry in BADXRecord - List fix HDS00003130} + rpcNonBillableOrders(targetOrderList); + if IsOrderBillable(UBAGLobals.TargetOrderID) then + begin + tCallV(sourceOrderList, 'ORWDBA4 GETTFCI', [sourceOrderID]); + BACopyOrder(sourceOrderList); //BAPHII 1.3.2 + end; +end; + +procedure PutBADxListForOrder(var thisRecord: TBADxRecord; thisOrderID: string); +{ //existingRecord //targetOrderID } +var + i: integer; + thisRec: TBADxRecord; +begin + if UBAGlobals.tempDxNodeExists(thisOrderID) then + begin + if Assigned(tempDxList) then + + try + for i := 0 to (tempDxList.Count - 1) do + begin + thisRec := TBADxRecord(tempDxList.Items[i]); + + if Assigned(thisRec) then + if (thisRec.FOrderID = thisOrderID) then + begin + thisRec.FBADxCode := thisRecord.FBADxCode; + thisRec.FBASecDx1 := thisRecord.FBASecDx1; + thisRec.FBASecDx2 := thisRecord.FBASecDx2; + thisRec.FBASecDx3 := thisRecord.FBASecDx3; + thisRec.FTreatmentFactors := thisRecord.FTreatmentFactors; + end; + end; + + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.PutBADxListForOrder()');{$endif} + raise; + end; + end; + end; +end; + +procedure CopyDxRecord(sourceOrderID: string; targetOrderID: string); + { + BAPHII 1.3.1 + Copy contents of one TBADxRecord to another. + If target record does NOT exist, then add it to the Dx list. + If target record DOES exist, then change its contents to those of source record. + } + var + thisRecord: TBADxRecord; + thatRecord: TBADxRecord; + billingInfo: TstringList; + orderList: TStringList; +begin + thisRecord := TBADxRecord.Create; + thatRecord := TBADxRecord.Create; + billingInfo := TStringList.Create; + orderList := TStringList.Create; + if Assigned(billingInfo) then billingInfo.Clear; + if Assigned(orderList) then orderList.Clear; + + if tempDxNodeExists(sourceOrderID) then + GetBADxListForOrder(thisRecord, sourceOrderID); //load data from source + + if not tempDxNodeExists(targetOrderID) then + begin + SimpleAddTempDxList(targetOrderID); + orderList.Add(sourceOrderID); + billingInfo := rpcRetrieveSelectedOrderInfo(orderList); + if billingInfo.Count > 0 then + begin + thisRecord.FBADxCode := Piece(billingInfo.Strings[0],U,4) + U + + Piece(billingInfo.Strings[0],U,3); + thisRecord.FBASecDx1 := Piece(billingInfo.Strings[0],U,6) + U + + Piece(billingInfo.Strings[0],U,5); + thisRecord.FBASecDx2 := Piece(billingInfo.Strings[0],U,8) + U + + Piece(billingInfo.Strings[0],U,7); + thisRecord.FBASecDx3 := Piece(billingInfo.Strings[0],U,10) + U + + Piece(billingInfo.Strings[0],U,9); + if thisRecord.FBADxCode = CARET then thisRecord.FBADxCode := DXREC_INIT_FIELD_VAL; + if thisRecord.FBASecDx1 = CARET then thisRecord.FBASecDx1 := DXREC_INIT_FIELD_VAL ; + if thisRecord.FBASecDx2 = CARET then thisRecord.FBASecDx2 := DXREC_INIT_FIELD_VAL ; + if thisRecord.FBASecDx3 = CARET then thisRecord.FBASecDx3 := DXREC_INIT_FIELD_VAL ; + + end + else + PutBADxListForOrder(thisRecord, targetOrderID); + //copy source data to temporary record + with thatRecord do + begin + FOrderID := targetOrderID; + FBADxCode := thisRecord.FBADxCode; + FBASecDx1 := thisRecord.FBASecDx1; + FBASecDx2 := thisRecord.FBASecDx2; + FBASecDx3 := thisRecord.FBASecDx3; + PutBADxListForOrder(thatRecord, targetOrderID); + end; + end; +end; + + +function GetPrimaryDx(thisOrderID: string) : string; +{ +BAPHII 1.3.1 +} +var + retVal: TBADxRecord; +begin + retVal := TBADxRecord.Create; + GetBADxListForOrder(retVal, thisOrderID); + Result := retVal.FBADxCode; +end; + +function AllSelectedDxBlank(const Caller: smallint) : boolean; +var + i: smallint; + selectedOrderID: string; +begin + Result := true; + + case Caller of + F_ORDERS_SIGN: begin + try + for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do + if (frmSignOrders.clstOrders.Selected[i]) then + begin + selectedOrderID := TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID; + if (tempDxNodeExists(selectedOrderID)) then + Result := false; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.AllSelectedDxBlank() - F_ORDERS_SIGN');{$endif} + raise; + end; + end; + end; + F_REVIEW: begin + try + for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do + if (fReview.frmReview.lstReview.Selected[i]) then + begin + selectedOrderID := TOrder(fReview.frmReview.lstReview.Items.Objects[i]).ID; + if tempDxNodeExists(selectedOrderID) then + Result := false; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.AllSelectedDxBlank() - F_REVIEW');{$endif} + raise; + end; + end; + end; + end; //case +end; + +function GetDxNodeIndex(thisOrderID: string) : smallint; +var + i: integer; + thisRec: TBADxRecord; +begin + Result := 0; + + if Assigned(tempDxList) then + + try + for i := 0 to (tempDxList.Count - 1) do + begin + thisRec := TBADxRecord(tempDxList.Items[i]); + if Assigned(thisRec) then + if (thisRec.FOrderID = thisOrderID) then + Result := i; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.GetDxNodeIndex()');{$endif} + raise; + end; + end; +end; + +function DiagnosesMatch(var List1: TStringList; var List2: TStringList) : boolean; +var + i: smallint; +begin + Result := false; + + // If the number of Dx's in the lists differs, then bail + if (List1.Count <> List2.Count) then + begin + Result := false; + Exit; + end; + + List1.Sort; + List2.Sort; + + try + for i := 0 to (List1.Count - 1) do + if (List1.Strings[i] <> List2.Strings[i]) then + Result := false + else + Result := true; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.DiagnosesMatch()');{$endif} + raise; + end; + end; +end; + +function CountSelectedOrders(const Caller: smallint) : smallint; +var + i: integer; + selectedOrders: smallint; +begin + selectedOrders := 0; + + // How many orders selected? + case Caller of + F_ORDERS_SIGN: begin + try + for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do + if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then + Inc(selectedOrders); + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.CountSelectedOrders() - F_ORDERS_SIGN');{$endif} + raise; + end; + end; + end; + F_REVIEW: begin + try + for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do + if (fReview.frmReview.lstReview.Selected[i]) then + Inc(selectedOrders); + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.CountSelectedOrders() - F_REVIEW');{$endif} + raise; + end; + end; + end; + end; //case + + Result := selectedOrders; + +end; + +function CompareOrderDx(const Caller: smallint) : boolean; +var + i: integer; + firstSelectedID: string; + thisOrderID: string; + firstDxRec: TBADxRecord; + compareDxRec: TBADxRecord; + thisStringList: TStringList; + thatStringList: TStringList; +begin + Result := false; + firstSelectedID := ''; + firstDxRec := nil; + firstDxRec := TBADxRecord.Create; + thisStringList := TStringList.Create; + thisStringList.Clear; + thatStringList := TStringList.Create; + thatStringList.Clear; + + case Caller of + F_ORDERS_SIGN: begin + try + for i := 0 to (fOrdersSign.frmSignOrders.clstOrders.Items.Count-1) do + if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then + begin + firstSelectedID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID; + Break; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif} + raise; + end; + end; + end; + F_REVIEW: begin + try + for i := 0 to (fReview.frmReview.lstReview.Items.Count-1) do + if (fReview.frmReview.lstReview.Selected[i]) then + begin + firstSelectedID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID; + Break; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif} + raise; + end; + end; + end; + end; //case + + firstDxRec := TBADxRecord.Create; + InitializeNewDxRec(firstDxRec); + GetBADxListForOrder(firstDxRec, firstSelectedID); + + // first string to compare + thisStringList.Add(firstDxRec.FBADxCode); + thisStringList.Add(firstDxRec.FBASecDx1); + thisStringList.Add(firstDxRec.FBASecDx2); + thisStringList.Add(firstDxRec.FBASecDx3); + + case Caller of + F_ORDERS_SIGN: begin + try + for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do + if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then + begin + thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID; + // If order ID is same as the first selected order, then skip it + if thisOrderID = firstSelectedID then + Continue + else + begin + compareDxRec := TBADxRecord.Create; + InitializeNewDxRec(compareDxRec); + GetBADxListForOrder(compareDxRec, thisOrderID); + + thatStringList.Add(compareDxRec.FBADxCode); + thatStringList.Add(compareDxRec.FBASecDx1); + thatStringList.Add(compareDxRec.FBASecDx2); + thatStringList.Add(compareDxRec.FBASecDx3); + + if DiagnosesMatch(thisStringList, thatStringList) then + Result := true; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_ORDERS_SIGN');{$endif} + raise; + end; + end; + end; + F_REVIEW: begin + try + for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do + if (fReview.frmReview.lstReview.Selected[i]) then + begin + thisOrderID := TChangeItem(fReview.frmReview.lstReview.Items.Objects[i]).ID; + // If order ID is same as the first selected order, then skip it + if thisOrderID = firstSelectedID then + Continue + else + begin + compareDxRec := TBADxRecord.Create; + InitializeNewDxRec(compareDxRec); + GetBADxListForOrder(compareDxRec, thisOrderID); + + thatStringList.Add(compareDxRec.FBADxCode); + thatStringList.Add(compareDxRec.FBASecDx1); + thatStringList.Add(compareDxRec.FBASecDx2); + thatStringList.Add(compareDxRec.FBASecDx3); + + if DiagnosesMatch(thisStringList, thatStringList) then + Result := true; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.CompareOrderDx() - F_REVIEW');{$endif} + raise; + end; + end; + end; + end; //case + + if Assigned(thisStringList) then + FreeAndNil(thisStringList); + + if Assigned(thatStringList) then + FreeAndNil(thatStringList); +end; + +procedure GetBADxListForOrder(var thisRetVal: TBADxRecord; thisOrderID: string); +var + i: integer; + thisRec: TBADxRecord; +begin + if UBAGlobals.tempDxNodeExists(thisOrderID) then + begin + + if Assigned(tempDxList) then + for i := 0 to (tempDxList.Count - 1) do + begin + thisRec := TBADxRecord(tempDxList.Items[i]); + + if Assigned(thisRec) then + if (thisRec.FOrderID = thisOrderID) then + begin + with thisRetVal do + begin + FOrderID := thisRec.FOrderID; + FBADxCode := StringReplace(thisrec.FBADxCode,'^',':',[rfReplaceAll]); + FBASecDx1 := StringReplace(thisrec.FBASecDx1,'^',':',[rfReplaceAll]); + FBASecDx2 := StringReplace(thisrec.FBASecDx2,'^',':',[rfReplaceAll]);; + FBASecDx3 := StringReplace(thisrec.FBASecDx3,'^',':',[rfReplaceAll]); + end; + end; + end; + end; +end; + +procedure DestroyDxList; +var + i: integer; +begin + if Assigned(tempDxList) then + for i := 0 to pred(UBAGlobals.tempDxList.Count) do + TObject(tempDxList[i]).Free; + + tempDxList := nil; + FreeAndNil(tempDxList); +end; + +procedure SimpleAddTempDxList(thisOrderID: string); +var + tempDxRec: TBADxRecord; +begin + frmBALocalDiagnoses.LoadTempRec(tempDxRec, thisOrderID); + UBAGlobals.tempDxList.Add(TBADxRecord(tempDxRec)); +end; + +procedure SetBADxList; +var + i: smallint; +begin + if not Assigned(UBAGlobals.tempDxList) then + begin + UBAGlobals.tempDxList := TList.Create; + UBAGlobals.tempDxList.Count := 0; + end + else + begin + //Kill the old Dx list + for i := 0 to pred(UBAGlobals.tempDxList.Count) do + TObject(UBAGlobals.tempDxList[i]).Free; + + UBAGlobals.tempDxList := nil; + + //Create new Dx list for newly selected patient + if not Assigned(UBAGlobals.tempDxList) then + begin + UBAGlobals.tempDxList := TList.Create; + UBAGlobals.tempDxList.Count := 0; + end; + end; +end; + +procedure SetBADxListForOrder(thisRec: TBADxRecord; thisOrderID: string); +var + i: integer; + foundRec: TBADxRecord; +begin + if UBAGlobals.tempDxNodeExists(thisOrderID) then + begin + foundRec := TBADxRecord.Create; + + if Assigned(tempDxList) then + try + for i := 0 to (tempDxList.Count - 1) do + begin + foundRec := TBADxRecord(tempDxList.Items[i]); + + if Assigned(thisRec) then + if (thisOrderID = foundRec.FOrderID) then + begin + with foundRec do + begin + FOrderID := thisRec.FOrderID; + FBADxCode := thisRec.FBADxCode; + FBASecDx1 := thisRec.FBASecDx1; + FBASecDx2 := thisRec.FBASecDx2; + FBASecDx3 := thisRec.FBASecDx3; + PutBADxListForOrder(foundRec, thisOrderID); + end; + Break; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.SetBADxListForOrder()');{$endif} + raise; + end; + end; + end; +end; + +function SecondaryDxFull(thisOrderID: string) : boolean; +var + i: integer; + thisRec: TBADxRecord; +begin + Result := false; + + try + for i := 0 to tempDxList.Count - 1 do + begin + thisRec := TBADxRecord(tempDxList.Items[i]); + + if Assigned(thisRec) then + if thisRec.FOrderID = thisOrderID then + begin + if (thisRec.FBADxCode <> UBAConst.DXREC_INIT_FIELD_VAL) then + if (thisRec.FBASecDx1 <> UBAConst.DXREC_INIT_FIELD_VAL) then + if (thisRec.FBASecDx2 <> UBAConst.DXREC_INIT_FIELD_VAL) then + if (thisRec.FBASecDx3 <> UBAConst.DXREC_INIT_FIELD_VAL) then + Result := true; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.SecondaryDxFull()');{$endif} + raise; + end; + end; +end; + +procedure AddSecondaryDx(thisOrderID: string; thisDxCode: string); +// Add a Secondary Dx to the first open slot in DxRec, if there IS an open slot +var + thisRec: TBADxRecord; + i: integer; +begin + + try + for i := 0 to tempDxList.Count - 1 do + begin + thisRec := TBADxRecord(tempDxList.Items[i]); + + if thisRec.FOrderID = thisOrderID then + begin + if (thisRec.FBASecDx1 = UBAConst.DXREC_INIT_FIELD_VAL) then + thisRec.FBASecDx1 := thisDxCode + else + if (thisRec.FBASecDx2 = UBAConst.DXREC_INIT_FIELD_VAL) then + thisRec.FBASecDx2 := thisDxCode + else + if (thisRec.FBASecDx3 = UBAConst.DXREC_INIT_FIELD_VAL) then + thisRec.FBASecDx3 := thisDxCode; + end + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.AddSecondaryDx()');{$endif} + raise; + end; + end; +end; + +procedure InitializeConsultOrderRec(var thisDxRec: TBAConsultOrderRec); +begin + with thisDxRec do + begin + FBAOrderID := UBAConst.DXREC_INIT_FIELD_VAL; + FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL; + FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL; + FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL; + FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL; + FBATreatmentFactors:= UBAConst.DXREC_INIT_FIELD_VAL; + end; +end; + + +procedure InitializeNewDxRec(var thisDxRec: TBADxRecord); +begin + with thisDxRec do + begin + FExistingRecordID := UBAConst.DXREC_INIT_FIELD_VAL; + FOrderID := UBAConst.DXREC_INIT_FIELD_VAL; + FBADxCode := UBAConst.DXREC_INIT_FIELD_VAL; + FBASecDx1 := UBAConst.DXREC_INIT_FIELD_VAL; + FBASecDx2 := UBAConst.DXREC_INIT_FIELD_VAL; + FBASecDx3 := UBAConst.DXREC_INIT_FIELD_VAL; + end; +end; + +procedure InitializeUnsignedOrderRec(var thisUnsignedRec: TBAUnsignedBillingRec); +begin + with thisUnsignedRec do + begin + FBAOrderID := UNSIGNED_REC_INIT_FIELD_VAL; + FBASTSFlags := UNSIGNED_REC_INIT_FIELD_VAL; + FBADxCode := UNSIGNED_REC_INIT_FIELD_VAL; + FBASecDx1 := UNSIGNED_REC_INIT_FIELD_VAL; + FBASecDx2 := UNSIGNED_REC_INIT_FIELD_VAL; + FBASecDx3 := UNSIGNED_REC_INIT_FIELD_VAL; + end; +end; + +procedure InitializeTFactorsInRec(var thisTFactorsRecIn: TBATreatmentFactorsInRec); +begin + with thisTFactorsRecIn do + begin + FBAOrderID := UNSIGNED_REC_INIT_FIELD_VAL; + FBAEligible := UNSIGNED_REC_INIT_FIELD_VAL; + FBATFactors := UNSIGNED_REC_INIT_FIELD_VAL; + end; +end; +constructor TBAGlobals.Create; +begin + inherited Create; +end; +// This procedure is called from uPCE.pas only -- do not delete..... +procedure TBAGlobals.AddBAPCEDiag(DiagStr:string); +begin + if (BAPCEDiagList.Count <= 0) then + BAPCEDiagList.Add('^Encounter Diagnoses'); + + BAPCEDiagList.Add(DiagStr); +end; + +procedure TBAGlobals.ClearBAPCEDiagList; +begin + + BAPCEDiagList.Clear; +end; + +constructor TBAPLRec.Create; +begin + inherited Create; +end; + +function TBAPLRec.BuildProblemListDxEntry(pDxCode:string): TStringList; +// StringList used to store DX Codes selected from Encounter Form +var + BADxIEN: string; + BAProviderStr, BAProviderName : string; + AList: TStringList; +begin +// Build Problem List record to be saved for selection. + PLlist := TStringList.Create; + AList := TStringList.Create; + AList.Clear; + PLlist.Clear; + BALocation := Encounter.Location; + BAProviderStr := IntToStr(Encounter.Provider); + BAProviderName := Encounter.ProviderName; + BADxIEN := sCallV('ORWDBA7 GETIEN9', [Piece(pDxCode,U,1)]); + BAPLPt.LoadPatientParams(AList); + + //BAPLPt.PtVAMC + PLlist.Add('GMPFLD(.01)='+'"' +BADxIEN+ '^'+Piece(pDxCode,U,1)+'"'); + PLlist.Add('GMPFLD(.03)=' +'"'+'0^' +'"'); + PLlist.Add('GMPFLD(.05)=' + '"' +'^'+Piece(pDxCode,U,2)+ '"'); + PLlist.Add('GMPFLD(.08)=' + '"'+ '^'+FloatToStr(FMToday)+'"'); + PLlist.Add('GMPFLD(.12)=' + '"' + 'A^ACTIVE'+ '"'); + PLlist.Add('GMPFLD(.13)=' + '"' + '^'+ '"'); + PLlist.Add('GMPFLD(1.01)=' + '"'+ Piece(pDxCode,U,2) + '"'); + PLlist.Add('GMPFLD(1.02)=' + '"'+'P' + '"'); + PLlist.Add('GMPFLD(1.03)=' + '"'+ BAProviderStr + '^'+ BAProviderName + '"'); + PLlist.Add('GMPFLD(1.04)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"'); + PLlist.Add('GMPFLD(1.05)=' + '"'+ BAProviderStr + '^' + BAProviderName + '"'); + PLlist.Add('GMPFLD(1.08)=' +'"' + IntToStr(BALocation) + '^' + Encounter.LocationName + '"'); + PLlist.Add('GMPFLD(1.09)=' + '"'+ FloatToStr(FMToday) +'"'); + PLlist.Add('GMPFLD(10,0)=' + '"'+'0'+ '"'); + Result := PLlist; + +end; + +function TBAPLRec.FMToDateTime(FMDateTime: string): TDateTime; +var + x, Year: string; +begin + { Note: TDateTime cannot store month only or year only dates } + x := FMDateTime + '0000000'; + if Length(x) > 12 then x := Copy(x, 1, 12); + if StrToInt(Copy(x, 9, 4)) > 2359 then x := Copy(x,1,7) + '.2359'; + Year := IntToStr(17 + StrToInt(Copy(x,1,1))) + Copy(x,2,2); + x := Copy(x,4,2) + '/' + Copy(x,6,2) + '/' + Year + ' ' + Copy(x,9,2) + ':' + Copy(x,11,2); + Result := StrToDateTime(x); +end; + +{-------------------------- TPLPt Class ----------------------} +constructor TBAPLPT.Create(Alist:TStringList); +var + i: integer; +begin + for i := 0 to AList.Count - 1 do + case i of + 0: PtVAMC := Copy(Alist[i],1,999); + 1: PtDead := AList[i]; + 2: PtServiceConnected := (AList[i] = '1'); + 3: PtAgentOrange := (AList[i] = '1'); + 4: PtRadiation := (AList[i] = '1'); + 5: PtEnvironmental := (AList[i] = '1'); + 6: PtBID := Alist[i]; + 7: PtHNC := (AList[i] = '1'); + 8: PtMST := (AList[i] = '1'); + end; +end; + +function TBAPLPt.GetGMPDFN(dfn:string;name:string):string; +begin + Result := dfn + u + name + u + PtBID + u + PtDead; +end; + +procedure TBAPLPt.LoadPatientParams(AList:TstringList); +begin + AList.Assign(rpcInitPt(Patient.DFN)); + BAPLPt := TBAPLPt.create(Alist); +end; + +function TBAPLPt.rpcInitPt(const PatientDFN: string): TStrings ; //*DFN* +begin + CallV('ORQQPL INIT PT',[PatientDFN]); + Result := RPCBrokerV.Results; +end ; + +function tempDxNodeExists(thisOrderID: string) : boolean; +// Returns true if a node with the specified Order ID exists, false otherwise. +var + i: integer; + thisRec: TBADxRecord; +begin + Result := false; + if Assigned(tempDxList) then + try + for i := 0 to (tempDxList.Count - 1) do + begin + thisRec := TBADxRecord(tempDxList.Items[i]); + + if Assigned(thisRec) then + if (thisRec.FOrderID = thisOrderID) then + begin + Result := true; + Break; + end; + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in UBAGlobals.tempDxNodeExists()');{$endif} + raise; + end; + end; +end; + // HDS00003380 +function IsUserNurseProvider(pUserID: int64):boolean; +begin + Result := False; + if BILLING_AWARE then + begin + if (pUserID <> 0) and PersonHasKey(pUserID, 'PROVIDER') then + if (uCore.User.OrderRole = OR_NURSE) then + Result := True; + end; +end; + +function GetPatientTFactors(pOrderList:TStringList):String; +begin + Result := ''; + Result := sCallV('ORWDBA1 SCLST',[Patient.DFN,pOrderList]); +end; + + +Initialization + BAPrimaryDxChanged := False; + BAFWarningShown := False; + BAPersonalDX := False; + BAHoldPrimaryDx := DXREC_INIT_FIELD_VAL; + NonBillableOrderList := TStringList.Create; + BAPCEDiagList := TStringList.Create; + OrderListSCEI := TStringList.Create; + BAOrderList := TStringList.Create; + UnSignedOrders := TStringList.Create; + BAOrderIDList := TStringList.Create; + BAUnSignedOrders := TStringList.Create; + BATFHints := TStringList.Create; + BAFactorsRec := TBAFactorsRec.Create; + BAFactorsInRec := TBATreatmentFactorsInRec.Create; + BASelectedList := TStringList.Create; + PLFactorsIndexes := TStringList.Create; + BAtmpOrderList := TStringList.Create; + BACopiedOrderFlags := TStringList.Create; //BAPHII 1.3.2 + OrderIDList := TStringList.Create; + BAConsultDxList := TStringList.Create; + BAConsultPLFlags := TStringList.Create; + BANurseConsultOrders := TStringList.Create; + BADeltedOrders := TStringList.Create; + // BAConsultOrdersRequireDx := TStringList.Create; + BAConsultDxList.Clear; + NonBillableOrderList.Clear; + OrderListSCEI.Clear; + UnSignedOrders.Clear; + BAOrderIDList.Clear; + BAUnSignedOrders.Clear; + BATFHints.Clear; + PLFactorsIndexes.Clear; + BASelectedList.Clear; + BAtmpOrderList.Clear; + OrderIDList.Clear; + BAConsultPLFlags.Clear; + BAPCEDiagList.Clear; + BANurseConsultOrders.Clear; + BADeltedOrders.Clear; + //BAConsultOrdersRequireDx.Clear; + +end. + + + Index: cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBAMessages.pas =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBAMessages.pas (revision 541) +++ cprs/branches/tmg-cprs/CPRS-Chart/Consults/UBAMessages.pas (revision 541) @@ -0,0 +1,142 @@ +//kt -- Modified with SourceScanner on 8/8/2007 +unit UBAMessages; + +{$OPTIMIZATION OFF} +{.$define debug} + +interface + + + {$ifdef debug} +const +//BA_ASSRTF = 'Assertion failed' + #13; <-- original line. //kt 8/8/2007 +function BA_ASSRTF : string; + {$endif} + +const + //CPRS User Messages +//BA_MAX_DX_ALLOWED = 'Can Not Add Diagnosis' + #13 + <-- original line. //kt 8/8/2007 +// 'Reason: Maximum (4) diagnoses have already been applied to this order.' + #13 + <-- original line. //kt 8/8/2007 +// 'You may use the ''Diagnosis Editor'' to manage diagnoses for order(s).'; <-- original line. //kt 8/8/2007 +//BA_NO_ORDERS_SELECTED = 'No orders have been selected. Select one or more orders to be signed.'; <-- original line. //kt 8/8/2007 +//BA_CONFIRM_DX_OVERWRITE = '''Lookup Diagnoses'' action will overwrite any existing diagnoses for selected orders.'+#13+'Do you wish to proceed?'; <-- original line. //kt 8/8/2007 +//BA_MAX_DX = 'A maximum of 4 diagnosis can be selected'; <-- original line. //kt 8/8/2007 +//BA_BILLING_DATA_SAVE_FAILED = 'Error: Billing data was not saved'; <-- original line. //kt 8/8/2007 + +//BA_NA_COPY_DISALLOWED = 'Can''t copy ''N/A'' orders. Select non-''N/A'' order(s), and retry the copy.'; <-- original line. //kt 8/8/2007 +//BA_NA_PASTE_DISALLOWED = 'Selected Diagnoses will not be pasted to orders flagged with N/A.'; <-- original line. //kt 8/8/2007 + +//BA_ONE_ORDER_ONLY = 'Only 1 order at a time may be selected for copying'; <-- original line. //kt 8/8/2007 +//BA_PERSONAL_LIST_UPDATED = 'Personal Diagnoses List Updated.'; <-- original line. //kt 8/8/2007 +//BA_NO_BILLABLE_ORDERS = 'No billable orders have been selected.'; <-- original line. //kt 8/8/2007 + +//BA_INACTIVE_CODE = 'Inactive Code'; <-- original line. //kt 8/8/2007 +//BA_INACTIVE_ICD9_CODE_1 = 'The diagnosis code ('; <-- original line. //kt 8/8/2007 +//BA_INACTIVE_ICD9_CODE_2 = ') is not active as of today''s date,' + #13#10+ <-- original line. //kt 8/8/2007 +// 'Please select another.'; <-- original line. //kt 8/8/2007 + + BA_DATA_NOT_REQD = '9'; + +//BA_DUP_DX = 'Duplicate Diagnosis.'; <-- original line. //kt 8/8/2007 +//BA_DUP_DX_DISALLOWED_1 = 'Diagnosis ('; <-- original line. //kt 8/8/2007 +//BA_DUP_DX_DISALLOWED_2 = ') has already been selected.'; <-- original line. //kt 8/8/2007 + + +function BA_MAX_DX_ALLOWED : string; +function BA_NO_ORDERS_SELECTED : string; +function BA_CONFIRM_DX_OVERWRITE : string; +function BA_MAX_DX : string; +function BA_BILLING_DATA_SAVE_FAILED : string; +function BA_NA_COPY_DISALLOWED : string; +function BA_NA_PASTE_DISALLOWED : string; +function BA_ONE_ORDER_ONLY : string; +function BA_PERSONAL_LIST_UPDATED : string; +function BA_NO_BILLABLE_ORDERS : string; +function BA_INACTIVE_CODE : string; +function BA_INACTIVE_ICD9_CODE_1 : string; +function BA_INACTIVE_ICD9_CODE_2 : string; +function BA_DUP_DX : string; +function BA_DUP_DX_DISALLOWED_1 : string; +function BA_DUP_DX_DISALLOWED_2 : string; + + +implementation + +uses DKLang; //kt + + {$ifdef debug} +function BA_ASSRTF : string; +begin Result := DKLangConstW('UBAMessages_Assertion_failed') + #13; //kt added 8/8/2007 +end; + {$endif} + +function BA_MAX_DX_ALLOWED : string; +begin Result := DKLangConstW('UBAMessages_Can_Not_Add_Diagnosis') + #13 + //kt added 8/8/2007 + DKLangConstW('UBAMessages_Reasonx_Maximum_x4x_diagnoses_have_already_been_applied_to_this_orderx') + #13 + //kt added 8/8/2007 + DKLangConstW('UBAMessages_You_may_use_the_xxDiagnosis_Editorxx_to_manage_diagnoses_for_orderxsxx'); //kt added 8/8/2007 +end; + +function BA_NO_ORDERS_SELECTED : string; +begin Result := DKLangConstW('UBAMessages_No_orders_have_been_selectedx__Select_one_or_more_orders_to_be_signedx'); //kt added 8/8/2007 +end; + +function BA_CONFIRM_DX_OVERWRITE : string; +begin Result := DKLangConstW('UBAMessages_Lookup_Diagnosesxx_action_will_overwrite_any_existing_diagnoses_for_selected_ordersx')+#13+DKLangConstW('UBAMessages_Do_you_wish_to_proceedx'); //kt added 8/8/2007 +end; + +function BA_MAX_DX : string; +begin Result := DKLangConstW('UBAMessages_A_maximum_of_4_diagnosis_can_be_selected'); //kt added 8/8/2007 +end; + +function BA_BILLING_DATA_SAVE_FAILED : string; +begin Result := DKLangConstW('UBAMessages_Errorx_Billing_data_was_not_saved'); //kt added 8/8/2007 +end; + +function BA_NA_COPY_DISALLOWED : string; +begin Result := DKLangConstW('UBAMessages_Canxxt_copy_xxNxAxx_ordersx__Select_nonxxxNxAxx_orderxsxx_and_retry_the_copyx'); //kt added 8/8/2007 +end; + +function BA_NA_PASTE_DISALLOWED : string; +begin Result := DKLangConstW('UBAMessages_Selected_Diagnoses_will_not_be_pasted_to_orders_flagged_with_NxAx'); //kt added 8/8/2007 +end; + +function BA_ONE_ORDER_ONLY : string; +begin Result := DKLangConstW('UBAMessages_Only_1_order_at_a_time_may_be_selected_for_copying'); //kt added 8/8/2007 +end; + +function BA_PERSONAL_LIST_UPDATED : string; +begin Result := DKLangConstW('UBAMessages_Personal_Diagnoses_List_Updatedx'); //kt added 8/8/2007 +end; + +function BA_NO_BILLABLE_ORDERS : string; +begin Result := DKLangConstW('UBAMessages_No_billable_orders_have_been_selectedx'); //kt added 8/8/2007 +end; + +function BA_INACTIVE_CODE : string; +begin Result := DKLangConstW('UBAMessages_Inactive_Code'); //kt added 8/8/2007 +end; + +function BA_INACTIVE_ICD9_CODE_1 : string; +begin Result := DKLangConstW('UBAMessages_The_diagnosis_code_x'); //kt added 8/8/2007 +end; + +function BA_INACTIVE_ICD9_CODE_2 : string; +begin Result := DKLangConstW('UBAMessages_x_is_not_active_as_of_todayxxs_datex') + #13#10+ //kt added 8/8/2007 + DKLangConstW('UBAMessages_Please_select_anotherx'); //kt added 8/8/2007 +end; + +function BA_DUP_DX : string; +begin Result := DKLangConstW('UBAMessages_Duplicate_Diagnosisx'); //kt added 8/8/2007 +end; + +function BA_DUP_DX_DISALLOWED_1 : string; +begin Result := DKLangConstW('UBAMessages_Diagnosis_x'); //kt added 8/8/2007 +end; + +function BA_DUP_DX_DISALLOWED_2 : string; +begin Result := DKLangConstW('UBAMessages_x_has_already_been_selectedx'); //kt added 8/8/2007 +end; + + + +end. Index: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBALocalDiagnoses.dfm =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBALocalDiagnoses.dfm (revision 541) +++ cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBALocalDiagnoses.dfm (revision 541) @@ -0,0 +1,296 @@ +object frmBALocalDiagnoses: TfrmBALocalDiagnoses + Left = 257 + Top = 104 + Width = 620 + Height = 544 + Caption = 'Assign Diagnoses to Order(s)' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + KeyPreview = True + OldCreateOrder = False + Position = poScreenCenter + ShowHint = True + OnActivate = FormActivate + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object pnlTop: TPanel + Left = 0 + Top = 0 + Width = 612 + Height = 96 + Align = alTop + Caption = 'pnlTop' + TabOrder = 0 + DesignSize = ( + 612 + 96) + object lbOrders: TListBox + Left = 7 + Top = 25 + Width = 599 + Height = 69 + Anchors = [akLeft, akTop, akRight, akBottom] + IntegralHeight = True + ItemHeight = 13 + TabOrder = 2 + OnMouseMove = lbOrdersMouseMove + end + object ORStaticText1: TORStaticText + Left = 216 + Top = 8 + Width = 169 + Height = 14 + AutoSize = False + Caption = 'Selected Orders' + TabOrder = 1 + TabStop = True + OnEnter = ORStaticText1Enter + OnExit = ORStaticText1Exit + end + object lblPatientName: TStaticText + Left = 11 + Top = 9 + Width = 76 + Height = 17 + Caption = 'PatientName' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + TabOrder = 0 + TabStop = True + end + end + object pnlMain: TPanel + Left = 0 + Top = 96 + Width = 612 + Height = 252 + Align = alClient + TabOrder = 1 + object lbSections: TORListBox + Left = 9 + Top = 16 + Width = 238 + Height = 201 + Style = lbOwnerDrawVariable + IntegralHeight = True + ItemHeight = 13 + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnClick = lbSectionsClick + OnDrawItem = lbSectionsDrawItem + Caption = 'Diagnosis Section' + ItemTipColor = clWindow + LongList = False + Pieces = '3' + CheckEntireLine = True + end + object btnOther: TButton + Left = 155 + Top = 219 + Width = 92 + Height = 20 + Caption = 'Other &Diagnosis' + TabOrder = 2 + OnClick = btnOtherClick + end + object lbDiagnosis: TORListBox + Left = 248 + Top = 16 + Width = 353 + Height = 225 + IntegralHeight = True + ItemHeight = 13 + ParentShowHint = False + ShowHint = True + TabOrder = 4 + OnClick = lbDiagnosisClick + Caption = 'Diagnosis Section' + ItemTipColor = clWindow + LongList = False + Pieces = '1,2,3' + end + object ORStaticText2: TORStaticText + Left = 8 + Top = 1 + Width = 241 + Height = 17 + AutoSize = False + BevelKind = bkFlat + Caption = 'Diagnosis Section' + TabOrder = 0 + TabStop = True + OnEnter = ORStaticText1Enter + OnExit = ORStaticText1Exit + end + object ORStaticText3: TORStaticText + Left = 248 + Top = 1 + Width = 353 + Height = 17 + AutoSize = False + BevelKind = bkFlat + Caption = 'Diagnosis Codes' + TabOrder = 3 + TabStop = True + OnEnter = ORStaticText1Enter + OnExit = ORStaticText1Exit + end + end + object pnlBottom: TORAutoPanel + Left = 0 + Top = 348 + Width = 612 + Height = 162 + Align = alBottom + TabOrder = 2 + DesignSize = ( + 612 + 162) + object lvDxGrid: TListView + Left = 12 + Top = 19 + Width = 445 + Height = 85 + Color = clInfoBk + Columns = < + item + Caption = 'Add To PL/PD' + Width = 85 + end + item + Caption = 'Primary' + MinWidth = 65 + Width = 65 + end + item + Caption = 'Diagnosis for Selected Orders' + MinWidth = 275 + Width = 290 + end> + Ctl3D = False + HideSelection = False + MultiSelect = True + ReadOnly = True + RowSelect = True + TabOrder = 1 + ViewStyle = vsReport + OnClick = lvDxGridClick + OnKeyDown = lvDxGridKeyDown + OnKeyUp = lvDxGridKeyUp + end + object cbAddToPDList: TCheckBox + Left = 459 + Top = 33 + Width = 129 + Height = 17 + Caption = 'Add to Personal Dx List' + TabOrder = 3 + OnClick = cbAddToPDListClick + end + object cbAddToPL: TCheckBox + Left = 459 + Top = 17 + Width = 149 + Height = 16 + Anchors = [akLeft, akTop, akRight, akBottom] + Caption = 'Add To Problem List' + TabOrder = 2 + OnClick = cbAddToPLClick + end + object btnPrimary: TButton + Left = 480 + Top = 57 + Width = 72 + Height = 19 + Caption = '&Primary' + TabOrder = 4 + OnClick = btnPrimaryClick + end + object btnRemove: TButton + Left = 480 + Top = 81 + Width = 72 + Height = 19 + Caption = '&Remove' + TabOrder = 5 + OnClick = btnRemoveClick + end + object btnSelectAll: TButton + Left = 385 + Top = 108 + Width = 72 + Height = 18 + Caption = '&Select All' + TabOrder = 6 + OnClick = btnSelectAllClick + end + object buOK: TButton + Left = 384 + Top = 136 + Width = 72 + Height = 21 + Caption = '&OK' + TabOrder = 7 + OnClick = buOKClick + end + object buCancel: TButton + Left = 482 + Top = 136 + Width = 72 + Height = 21 + Caption = '&Cancel' + TabOrder = 8 + OnClick = buCancelClick + end + object ORStaticText4: TORStaticText + Left = 14 + Top = 3 + Width = 219 + Height = 14 + AutoSize = False + Caption = 'Provisional Diagnosis' + TabOrder = 0 + TabStop = True + OnEnter = ORStaticText1Enter + OnExit = ORStaticText1Exit + end + end + object DKLanguageController1: TDKLanguageController + Left = 296 + Top = 256 + LangData = { + 130066726D42414C6F63616C446961676E6F7365730101000000010000000700 + 43617074696F6E01140000000600706E6C546F70010100000002000000070043 + 617074696F6E0008006C624F726465727300000D004F52537461746963546578 + 7431010100000003000000070043617074696F6E000E006C626C50617469656E + 744E616D65010100000004000000070043617074696F6E000700706E6C4D6169 + 6E00000A006C6253656374696F6E73010100000005000000070043617074696F + 6E00080062746E4F74686572010100000006000000070043617074696F6E000B + 006C62446961676E6F736973010100000007000000070043617074696F6E000D + 004F525374617469635465787432010100000008000000070043617074696F6E + 000D004F52537461746963546578743301010000000900000007004361707469 + 6F6E000900706E6C426F74746F6D000008006C7644784772696401030000000A + 0000001200436F6C756D6E735B305D2E43617074696F6E0B0000001200436F6C + 756D6E735B315D2E43617074696F6E0C0000001200436F6C756D6E735B325D2E + 43617074696F6E000D006362416464546F50444C69737401010000000D000000 + 070043617074696F6E0009006362416464546F504C01010000000E0000000700 + 43617074696F6E000A0062746E5072696D61727901010000000F000000070043 + 617074696F6E00090062746E52656D6F76650101000000100000000700436170 + 74696F6E000C0062746E53656C656374416C6C01010000001100000007004361 + 7074696F6E00040062754F4B010100000012000000070043617074696F6E0008 + 00627543616E63656C010100000013000000070043617074696F6E000D004F52 + 5374617469635465787434010100000014000000070043617074696F6E00} + end +end Index: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBALocalDiagnoses.pas =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBALocalDiagnoses.pas (revision 541) +++ cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBALocalDiagnoses.pas (revision 541) @@ -0,0 +1,1593 @@ +//kt -- Modified with SourceScanner on 8/15/2007 +unit fBALocalDiagnoses; + {.$define debug} +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls,fPCELex, uConsults, ORFn, + rPCE,DBCtrls, DB, DBClient, uPCE, fEncounterFrame, ComCtrls, Grids, UBAGlobals, + Buttons, Menus, UBACore, UCore, DKLang; + +type + DxRecord = Record + DxFiller1 : string; + DxFiller2 : string; + DxAddToPL : string; + DxPrimary : string; + DxCode : string; + end; + TfrmBALocalDiagnoses = class(TfrmAutoSz) + pnlTop: TPanel; + lbOrders: TListBox; + pnlMain: TPanel; + lbSections: TORListBox; + pnlBottom: TORAutoPanel; + lvDxGrid: TListView; + cbAddToPDList: TCheckBox; + cbAddToPL: TCheckBox; + btnPrimary: TButton; + btnRemove: TButton; + btnSelectAll: TButton; + buOK: TButton; + buCancel: TButton; + btnOther: TButton; + lbDiagnosis: TORListBox; + ORStaticText1: TORStaticText; + ORStaticText2: TORStaticText; + ORStaticText3: TORStaticText; + ORStaticText4: TORStaticText; + lblPatientName: TStaticText; + procedure buOKClick(Sender: TObject); + procedure buCancelClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure Button4Click(Sender: TObject); + procedure lbSectionsClick(Sender: TObject); + procedure btnOtherClick(Sender: TObject); + procedure btnPrimaryClick(Sender: TObject); + procedure btnRemoveClick(Sender: TObject); + procedure btnSelectAllClick(Sender: TObject); + procedure cbAddToPLClick(Sender: TObject); + procedure ProcessAddToItems; + procedure lbDiagnosisClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure AddDiagnosistoPersonalDiagnosesList1Click(Sender: TObject); + procedure AddDiagnosistoPersonalDiagnosesList2Click(Sender: TObject); + + procedure cbAddToPDListClick(Sender: TObject); + procedure lbSectionsDrawItem(Control: TWinControl; Index: Integer; + Rect: TRect; State: TOwnerDrawState); + procedure lvDxGridKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure lvDxGridKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure lvDxGridClick(Sender: TObject); + procedure lbOrdersMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); + procedure ORStaticText1Enter(Sender: TObject); + procedure ORStaticText1Exit(Sender: TObject); + procedure ORStaticText3Enter(Sender: TObject); + procedure ORStaticText3Exit(Sender: TObject); + + private + { Private declarations } + inactiveCodes: integer; + procedure MainDriver; + procedure LoadEncounterForm; + procedure AddProbsToDiagnosis; + procedure AddPCEToDiagnosis;//** adds dx's if selected currently from ecf + procedure AddPersonalDxToDiagnosisList; + procedure ListDiagnosisSections(Dest: TStrings); + procedure ListDiagnosisCodes(Section : String); + procedure DiagnosisSelection(SelectedDx: String); + procedure EnsurePrimary; + function IsDxAlreadySelected(SelectedDx: string):boolean; + procedure BuildTempDxList; + procedure AssocDxToOrders; + procedure BuildBADxList; + procedure ListGlobalDx(pOrderIDList: TStringList); + procedure ListConsultDX(pOrderDxList: TStringList); + procedure DeselectGridItems; + procedure ListSelectedOrders; + procedure BuildConsultDxList(pDxList: TStringList); + function AddToWhatList(IsPLChecked:boolean; IsPDLChecked:boolean):string; + procedure AddToProblemList; + procedure AddToPersonalDxList; + procedure InactiveICDNotification; + procedure LoadTempDXLists; + procedure SetAddToCBoxStatus; + procedure SetAddToCheckBoxStatus(ADiagnosis:string); + procedure ClearAndDisableCBoxes; + procedure ProcessMultSelections; + function ProblemListDxFound(pDxCode:string):boolean; + function PersonalListDxFound(pDxCode:string):boolean; + procedure ReSetCheckBoxStatus(pDxCode:String); + + public + FLastHintItemNum: integer; + procedure Enter(theCaller: smallint; pOrderIDList: TStringList); + procedure LoadTempRec(var thisRec: TBADxRecord; thisOrderID: string); + end; + + const + TX799 = '799.9'; +//PROBLEM_LIST_SECTION = 'Problem List Items'; <-- original line. //kt 8/15/2007 +//PERSONAL_DX_SECTION = 'Personal Diagnoses List Items'; <-- original line. //kt 8/15/2007 + +function PROBLEM_LIST_SECTION : string; //kt +function PERSONAL_DX_SECTION : string; //kt + +var + deleteDX: boolean; + selectingDX: boolean; + FDxCode: string; + FDxSection: string; + PList: TextFile; + FName: string; + MaxDx : Integer; + GridItems: integer; + UpdatingGrid: boolean; + whoCalled: smallint; + currentOrderIDList: TStringList; + ProblemDxHoldList, PersonalDxHoldList: TStringList; + frmBALocalDiagnoses: TfrmBALocalDiagnoses; + lexIENHoldList: TStringList; //** OrderID^Lexicon IEN + +implementation + +uses rCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA, + uAccessibleStringGrid,ORNet, fProbs, fOrdersSign, UBAConst, + UBAMessages, fReview, uSignItems, fODConsult, fFrame; + +var + uProblems : TStringList; + BADiagnosis : TStringList; + ECFDiagnosis : TStringList; + uLastDFN : string; + uLastLocation: integer; + ListItem : TListItem; + uPrimaryDxHold: string; + PrimaryChanged: boolean; +{$R *.dfm} + +//************* Entry point *****************// + +function PROBLEM_LIST_SECTION : string; +begin Result := DKLangConstW('fBALocalDiagnoses_Problem_List_Items'); +end; + +function PERSONAL_DX_SECTION : string; +begin Result := DKLangConstW('fBALocalDiagnoses_Personal_Diagnoses_List_Items'); +end; + + +procedure TfrmBALocalDiagnoses.Enter(theCaller:smallint; pOrderIDList: TStringList); +begin + selectingDX := False; + deleteDX := False; + fBALocalDiagnoses.whoCalled := theCaller; + currentOrderIDList := pOrderIDList; + frmBALocalDiagnoses := TfrmBALocalDiagnoses.Create(Application); + ResizeFormToFont(TForm(frmBALocalDiagnoses)); + frmBALocalDiagnoses.ShowModal; + frmBALocalDiagnoses.Release; + +end; +procedure TfrmBALocalDiagnoses.FormCreate(Sender: TObject); +begin + MaxDx := 4; + inactiveCodes := 0; + MainDriver; + GridItems := 0; + PrimaryChanged := False; + FLastHintItemNum := -1; + ClearAndDisableCBoxes +end; + +procedure TfrmBALocalDiagnoses.ListDiagnosisSections(Dest: TStrings); +{ return section names in format: ListIndex^SectionName (sections begin with '^') } +var + i: Integer; + x: string; +begin + for i := 0 to BADiagnosis.Count - 1 do if CharAt(BADiagnosis[i], 1) = U then + begin + x := Piece(BADiagnosis[i], U, 2); +// if Length(x) = 0 then x := ''; <-- original line. //kt 8/15/2007 + if Length(x) = 0 then x := DKLangConstW('fBALocalDiagnoses_xNo_Section_Namex'); //kt added 8/15/2007 + Dest.Add(IntToStr(i) + U + Piece(BADiagnosis[i], U, 2) + U + x); + end; +end; + +procedure TfrmBALocalDiagnoses.MainDriver; +begin + BADiagnosis := TStringList.Create; + ECFDiagnosis := TStringList.Create; + uProblems := TStringList.Create; + lblPatientName.Caption := Patient.Name; + DeselectGridItems; + + if whoCalled = F_CONSULTS then + ListConsultDX(uBAGlobals.BAConsultDxList) + else + ListGlobalDx(currentOrderIDList); + + LoadEncounterForm; + ListDiagnosisSections(lbSections.Items); + ListSelectedOrders; + LoadTempDXLists; +end; + +procedure TfrmBALocalDiagnoses.LoadTempRec(var thisRec: TBADxRecord; thisOrderID: string); +begin + if frmFrame.TimedOut then exit; + thisRec := TBADxRecord.Create; + UBAGlobals.InitializeNewDxRec(thisRec); + //** Load it + thisRec.FOrderID := thisOrderID; + if pos( '(', UBAGlobals.Dx1) > 0 then + thisRec.FBADxCode := UBACore.StripTFactors(UBAGlobals.Dx1) + else + thisRec.FBADxCode := UBAGlobals.Dx1; + + if pos( '(', UBAGlobals.Dx2) > 0 then + thisRec.FBASecDx1 := UBACore.StripTFactors(UBAGlobals.Dx2) + else + thisRec.FBASecDx1 := UBAGlobals.Dx2; + + if pos( '(', UBAGlobals.Dx3) > 0 then + thisRec.FBASecDx2 := UBACore.StripTFactors(UBAGlobals.Dx3) + else + thisRec.FBASecDx2 := UBAGlobals.Dx3; + + if pos( '(', UBAGlobals.Dx4) > 0 then + thisRec.FBASecDx3 := UBACore.StripTFactors(UBAGlobals.Dx4) + else + thisRec.FBASecDx3 := UBAGlobals.Dx4; + + //** Verify Diagnosis exists prior to adding to list. + if UBAGlobals.Dx1 <> '' then + BADiagnosis.Add(UBAGlobals.Dx1); + if UBAGlobals.Dx2 <> '' then + BADiagnosis.Add(UBAGlobals.Dx2); + if UBAGlobals.Dx3 <> '' then + BADiagnosis.Add(UBAGlobals.Dx3); + if UBAGlobals.Dx4 <> '' then + BADiagnosis.Add(UBAGlobals.Dx4); +end; + +procedure TfrmBALocalDiagnoses.AssocDxToOrders; +var + tmpFlagList: TStringList; + i: integer; + thisOrderID: string; + tempDxRec: TBADxRecord; + {$ifdef debug}thismsg: string;{$endif} +begin + //** Initialize + if Assigned(UBAGlobals.OrderIDList) then + UBAGlobals.OrderIDList.Clear; + tmpFlagList := TStringList.Create; + + //** Associate Dx's to Orders + if whoCalled = F_ORDERS_SIGN then + begin + for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do + begin + if (frmSignOrders.clstOrders.Selected[i]) then + begin + thisOrderID := TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID; + if Not UBACore.IsOrderBillable(thisOrderID) then Continue; //BAPHII 1.4.16 + LoadTempRec(tempDxRec, thisOrderID); + if ((UBAGlobals.tempDxList <> nil) and (not UBAGlobals.tempDxNodeExists(thisOrderID))) then + UBAGlobals.tempDxList.Add(TBADxRecord(tempDxRec)) + else + begin + //** Order already exists in Dx list, so modifiy existing Dx record + SetBADxListForOrder(tempDxRec, thisOrderID); + end; + //** Add it to OrderID string list + if Assigned(UBAGlobals.OrderIDList) then + UBAGlobals.OrderIDList.Add(thisOrderID); + end; //** if + end; //** for + end + else + if whoCalled = F_REVIEW then + begin + DeselectGridItems; + for i := 0 to fReview.frmReview.lstReview.Items.Count-1 do + begin + if (frmReview.lstReview.Selected[i]) then + begin + thisOrderID := TOrder(fReview.frmReview.lstReview.Items.Objects[i]).ID; + if Not UBACore.IsOrderBillable(thisOrderID) then Continue; //BAPHII 1.4.16 + LoadTempRec(tempDxRec, thisOrderID); + if ((UBAGlobals.tempDxList <> nil) and (not UBAGlobals.tempDxNodeExists(thisOrderID))) then + UBAGlobals.tempDxList.Add(TBADxRecord(tempDxRec)) + else + begin + //** Order already exists in Dx list, so modifiy existing Dx record + SetBADxListForOrder(tempDxRec, thisOrderID); + GetUnsignedOrderFlags(thisOrderID,tmpFlagList); + end; + + //** Add it to OrderID string list + if Assigned(UBAGlobals.OrderIDList) then + UBAGlobals.OrderIDList.Add(thisOrderID); + end; + end; //for + end; +end; + +procedure TfrmBALocalDiagnoses.buOKClick(Sender: TObject); +begin + inherited; +//*** Load selected diagnosis to Temp List*** ///// + + if whoCalled <> F_CONSULTS then + begin + BuildTempDxList; //** Loop thru dx grid and build list of dx's + BuildBADxList; //** Save selected Dx passed to PCE-Diagnosis Tab + AssocDxToOrders; //** Add selected Dx to TList for display and tracking. + end + else + begin + BuildConsultDxList(UBAGlobals.BAConsultDxList); //** Loop thru dx grid and build list of dx's + fODConsult.consultQuickOrder := False; // allow multiple dx's if first selection was a quick order + end; + ProcessAddToItems; //** Items flagged with 'add' will be added to the Problem list table + lvDxGrid.Clear; + frmBALocalDiagnoses.Close; + +end; + +procedure TfrmBALocalDiagnoses.LoadEncounterForm; +{ load the major coding lists that are used by the encounter form for a given location } +var + i: integer; + uTempList: TStringList; + EncDt: TFMDateTime; +begin + uLastLocation := Encounter.Location; + EncDt := Trunc(FMToday); + // ** add problems to the top of diagnoses. + uTempList := TstringList.Create; + BADiagnosis.clear; + tCallV(uTempList,'ORWPCE DIAG', [uLastLocation, EncDt]); + BADiagnosis.add(utemplist.strings[0]); + AddProbsToDiagnosis; + + // ** Loading Diagnoses if previously entered via the Encounter Form + AddPersonalDxToDiagnosisList; + + if Assigned(BAPCEDiagList) then + begin + AddPCEToDiagnosis; + end; + + for i := 1 to (uTempList.Count-1) do + BADiagnosis.add(uTemplist.strings[i]); + +end; + +// ** Add problem-list enteries to Diagnosis selection list +procedure TfrmBALocalDiagnoses.AddProbsToDiagnosis; +var + i : integer; + EncDt: TFMDateTime; + ProblemListTFactors: string; +begin + // ** Get problem list + EncDt := Trunc(FMToday); + uLastDFN := Patient.DFN; + tCallV(UProblems, 'ORWPCE ACTPROB', [Patient.DFN, EncDT]); + + if uProblems.Count > 0 then + begin +// BADiagnosis.add('^Problem List Items'); <-- original line. //kt 8/15/2007 + BADiagnosis.add('^'+DKLangConstW('fBALocalDiagnoses_Problem_List_Items')); //kt added 8/15/2007 + for i := 1 to (uProblems.count-1) do + begin + // ** add PL Treatment Factors to Dx Display List. + //HDS00006194 if (Piece(uproblems.Strings[i],U,3) = '799.9') then continue; + //HDS00006194 if (Piece(uproblems.Strings[i],U,2) = '799.9') then continue; + // change made to allow 799.9 into selection list + AttachPLTFactorsToDx(ProblemListTFactors,uProblems.Strings[i]); + + if (Piece(uproblems.Strings[i], U, 11) = '#') then + begin + BADiagnosis.add(Piece(uProblems.Strings[i],U,3) + U + // PL code inactive + Piece(uProblems.Strings[i],U,2) + U + '#'); + inc(inactiveCodes); + end + else if (Piece(uproblems.Strings[i], U, 10) = '') then // no inactive date for code + BADiagnosis.add(ProblemListTFactors) + else if (Trunc(StrToFloat(Piece(uProblems.Strings[i], U, 10))) > EncDT) then // code active as of EncDt + BADiagnosis.add(Piece(uProblems.Strings[i],U,3) + U + + ProblemListTFactors ) + else + BADiagnosis.add(Piece(uProblems.Strings[i],U,3) + U + // PL code inactive + Piece(uProblems.Strings[i],U,2) + U + '#'); + end; + end; +end; + +procedure TfrmBALocalDiagnoses.AddPCEToDiagnosis; +var + i: integer; +begin + for i := 0 to (BAPCEDiagList.Count-1) do + begin + if CharAt(BAPCEDiagList.Strings[i], 1) = U then + BADiagnosis.Add(BAPCEDiagList.Strings[i]) //** section header + else + BADiagnosis.add(Piece(BAPCEDiagList.Strings[i],U,1) + U + Piece(BAPCEDiagList.Strings[i],U,2)); + end; +end; + +procedure TfrmBALocalDiagnoses.AddPersonalDxToDiagnosisList; +var + personalDxList: TStringList; + personalDxListSorted: TStringList; + i,z: integer; +begin + + personalDxList := TStringList.Create; + personalDxListSorted := TStringlist.Create; + personalDxList.Clear; + personalDxListSorted.Clear; + personalDxList := rpcGetPersonalDxList(User.DUZ); + for i := 0 to personalDxList.Count-1 do + personalDxListSorted.Add(Piece(personalDXList.Strings[i],U,2) + U + (Piece(personalDXList.Strings[i],U,1)) ); + //****** sort personal dx list alphabetical by code name + personalDxListSorted.Sorted := False; + personalDxListSorted.Sorted := True ; + personalDxList.Clear; + for z := 0 to personalDxListSorted.Count-1 do + personalDxList.Add(Piece(personalDXListSorted.Strings[z],U,2) + U + (Piece(personalDXListSorted.Strings[z],U,1)) ); + + + if personalDxList.Count > 0 then + begin + BADiagnosis.add(U + DX_PERSONAL_LIST_TXT); + for i := 0 to personalDxList.Count-1 do + BADiagnosis.Add(personalDxList.Strings[i]); + end + else +// BADiagnosis.add('^NO Personal Diagnoses Available'); <-- original line. //kt 8/15/2007 + BADiagnosis.add('^'+DKLangConstW('fBALocalDiagnoses_NO_Personal_Diagnoses_Available')); //kt added 8/15/2007 +end; + + +procedure TfrmBALocalDiagnoses.buCancelClick(Sender: TObject); +begin + lvDxGrid.Clear; + fODConsult.displayDXCode := 'DXCANCEL';// retain original dx in consult dialog + uBAGlobals.TFactors := ''; // clear treatment factors from last order.// hds00006266 + Close; +end; + +procedure TfrmBALocalDiagnoses.Button4Click(Sender: TObject); +begin + Close; +end; + +procedure TfrmBALocalDiagnoses.lbSectionsClick(Sender: TObject); +var i: integer; +begin + for i := 0 to lbSections.Items.Count-1 do + begin + if(lbSections.Selected[i]) then + begin + lvDxGrid.ClearSelection; + ClearAndDisableCBoxes; + ListDiagnosisCodes(lbSections.Items[i]); + FDXSection := lbSections.Items[i]; + Break; + end; + end; +end; + +procedure TfrmBALocalDiagnoses.ListDiagnosisCodes(Section: String); +var +i,j: integer; +a: string; +begin + lbDiagnosis.Clear; + + for i := 0 to BADiagnosis.Count-1 do + begin + a := BADiagnosis.Strings[i]; + if Piece(BADiagnosis[i], U, 2) = (Piece(Section,U,2)) then + Break; + end; + + inc(i); + + for j := i to BADiagnosis.Count-1 do + begin + if Piece(BADiagnosis[j], U, 0) = '' then + break + else + begin + a := Piece(BADiagnosis[j], U, 2) + U + Piece(BADiagnosis[j], U, 1) + U + ' ' + Piece(BADiagnosis[j], U, 3) ; +// if a = '' then showmessage('found nothing'); <-- original line. //kt 8/15/2007 + if a = '' then showmessage(DKLangConstW('fBALocalDiagnoses_found_nothing')); //kt added 8/15/2007 + lbDiagnosis.Items.Add(a); + end; + end; +end; + +procedure TfrmBALocalDiagnoses.btnOtherClick(Sender: TObject); +var + Match: string; + selectedDx: string; + i: integer; + lexIEN: string; +begin + lvDxGrid.ClearSelection; + ProvDx.Code := ''; //** init + lexIEN := ''; + BAPersonalDX := True; //** returns LexIEN in piece 3 + //** Execute LEXICON + LexiconLookup(Match, LX_ICD); + if Match = '' then Exit; + fOrdersSign.ProvDx.Code := Piece(Match, U, 1); + fOrdersSign.ProvDx.Text := Piece(Match, U, 2); + lexIEN := Piece(Match, U, 3); + i := Pos(' (ICD', fOrdersSign.ProvDx.Text); + if i = 0 then i := Length(ProvDx.Text) + 1; + if fOrdersSign.ProvDx.Text[i-1] = '*' then i := i - 2; + fOrdersSign.ProvDx.Text := Copy(fOrdersSign.ProvDx.Text, 1, i - 1); + fOrdersSign.ProvDx.Text := StringReplace(fOrdersSign.ProvDx.Text,':',' ',[rfReplaceAll]); + fOrdersSign.ProvDx.Code := StringReplace(fOrdersSign.ProvDx.Code,':',' ',[rfReplaceAll]); + + selectedDx := (fOrdersSign.ProvDx.Text + ':' + fOrdersSign.ProvDx.Code); + if strLen(PChar(lexIEN) ) > 0 then + lexIENHoldList.Add(fOrdersSign.ProvDx.Code + U + lexIEN); + + //** Begin CQ4819 + if not IsDxAlreadySelected(selectedDx) then + begin + if UBACore.IsICD9CodeActive(fOrdersSign.ProvDx.Code,'ICD',0) then + DiagnosisSelection(selectedDx) + else + InfoBox(BA_INACTIVE_ICD9_CODE_1 + fOrdersSign.ProvDx.Code + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK); + end; + //** End CQ4819 + BAPersonalDX := False; + SetAddToCheckBoxStatus(selectedDX); + +end; + +procedure TfrmBALocalDiagnoses.btnPrimaryClick(Sender: TObject); +var + i: shortint; + Primary: boolean; +begin + inherited; + Primary := FALSE; + if lvDxGrid.Items.Count = 0 then Exit; //** Exit if list empty + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if(lvDxGrid.Items[i].Selected) then + begin + if not Primary then + begin + LvDxGrid.Items[i].SubItems[0] := UBAConst.PRIMARY_DX; + Primary :=TRUE; + end; + end + else + LvDxGrid.Items[i].SubItems[0] := UBAConst.SECONDARY_DX ; + end; + + if not Primary then EnsurePrimary; +end; + +procedure TfrmBALocalDiagnoses.btnRemoveClick(Sender: TObject); +begin + inherited; + deleteDX := True; + lvDxGrid.DeleteSelected; + ClearAndDisableCBoxes; + DeselectGridItems; + EnsurePrimary; + deleteDX := False; + // if all dx's removed, clear out displaycode + if lvDxGrid.items.Count = 0 then FODConsult.displayDXCode := ''; +end; + +procedure TfrmBALocalDiagnoses.btnSelectAllClick(Sender: TObject); +var + i: integer; +begin + inherited; + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if cbAddToPDList.Enabled then + SetAddToCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]); //** personal dx + if cbAddToPL.Enabled then + SetAddToCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]);; //** problem dx + end; + + lvDxGrid.MultiSelect := true; + lvDxGrid.SelectAll; + lvDxGrid.Setfocus; +end; + +procedure TfrmBALocalDiagnoses.DiagnosisSelection(SelectedDx: String); +begin +// ** Set up Dx grid + if lvDxGrid.Items.Count < MaxDx then + begin + if lvDxGrid.Items.count = 0 then + begin + ListItem := lvDxGrid.Items.Add; // ** add the row instance prior to adding text // adding text. + ListItem.SubItems.Add(UBAConst.PRIMARY_DX); + ListItem.SubItems.Add(SelectedDX); + end + else + begin + DeselectGridItems; + ListItem := lvDxGrid.Items.Add; // ** add the row instance prior to adding text. + ListItem.SubItems.Add(UBAConst.SECONDARY_DX); + ListItem.SubItems.Add(SelectedDX); + end; + end + else + begin + DeselectGridItems; + ShowMessage(BA_MAX_DX); //** max 4 diagnoses per order + end; +end; + +// insure unique diagnoses entered. +function TfrmBALocalDiagnoses.IsDxAlreadySelected(SelectedDx: string):boolean; +var i: integer; +x: string; +begin + Result := False; + with lvDxGrid do + begin + for i := 0 to lvDxGrid.Items.Count-1 do + begin + x := lvDxGrid.Items[i].Subitems[1]; + if Piece(x,':',2) = Piece(SelectedDx,':',2) then + begin + Result := True; + Break; + end; + end; + end; +end; + +function TFrmBALocalDiagnoses.ProblemListDxFound(pDxCode:string):boolean; +var + i: integer; + problemDx: string; +begin + Result := False; + for i := 0 to ProblemDXHoldList.Count -1 do + begin + problemDX := ProblemDXHoldList.Strings[i]; + problemDX := Piece(ProblemDX,':',2); + if pDxCode = problemDX then + begin + Result := True; + break; + end; + end;//** for +end; + +function TFrmBALocalDiagnoses.PersonalListDxFound(pDxCode:string):boolean; +var + i: integer; + personalDx: string; +begin + Result := False; + for i := 0 to PersonalDxHoldList.Count -1 do + begin + personalDX := PersonalDXHoldList.Strings[i]; + personalDX := Piece(personalDX,':',2); + if pDxCode = personalDX then + begin + Result := True; + break; + end; + end; +end; + + +procedure TfrmBALocalDiagnoses.EnsurePrimary; +var + Primary: boolean; + i : integer; +begin + Primary := False; + + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if LvDxGrid.Items[i].SubItems[0] = UBAConst.PRIMARY_DX then + begin + Primary := True; + Break; + end; + end; + + if not Primary then + begin + if lvDxGrid.Items.Count > 0 then + lvDxGrid.Items[0].Subitems[0] := UBAConst.PRIMARY_DX; + end; +end; + +procedure TfrmBALocalDiagnoses.cbAddToPLClick(Sender: TObject); +var i: integer; +begin + inherited; + if cbAddToPL.Checked then + begin + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if(lvDxGrid.Items[i].Selected) then + begin + lvDxGrid.Items[i].Caption := AddToWhatList(cbAddToPL.Checked,cbAddToPDList.Checked); + cbaddToPL.Checked := true; + lvDxGrid.Items[i].Selected := True; + lvDxGrid.SetFocus; + end; + end; + end + else + begin + if not cbaddToPL.Checked then + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if(lvDxGrid.Items[i].Selected) then + begin + lvDxGrid.Items[i].Caption := AddToWhatList(cbAddToPL.Checked,cbAddToPDList.Checked); + lvDxGrid.Items[i].Selected := True; + lvDxGrid.SetFocus; + end; + end; +end; + EnsurePrimary; +end; + +procedure TfrmBALocalDiagnoses.ProcessAddToItems; +begin + AddToProblemList; + AddToPersonalDxList; +end; + + +procedure TfrmBALocalDiagnoses.AddToPersonalDxList; +var + i,j: integer; + tempcode,thisCode : string; + tempList, addToPDList: TStringList; +begin + templist := TStringList.Create; + addToPDList := TStringList.Create; + tempList.Clear; + addTOPDList.Clear; + with lvDxGrid do + begin + for i := 0 to Items.Count-1 do + begin + if StrPos(PChar(LvDxGrid.Items[i].Caption),PChar(ADD_TO_PERSONAL_DX_LIST)) <> nil then + begin + tempCode := lvDxGrid.Items[i].Subitems[1]; + tempCode := Piece(tempCode, ':', 2); + tempList.Add(tempCode); + end; + end; + end; + + //** add Lexicon IEN to list (if any) + for i := 0 to tempList.Count -1 do + begin + thisCode := tempList.Strings[i]; + if lexIENHoldList.Count > 0 then //HDS6393 + begin + for j := 0 to lexIENHoldList.Count-1 do + begin + if thisCode = Piece(lexIENHoldList.Strings[j],U,1) then + AddToPDList.Add(thisCode + U + Piece(lexIENHoldList.Strings[j],U,2) ) // code was selected from Lexicon + else + AddToPDList.Add(thisCode); + end; + end + else //HDS6393 + AddToPDList.Add(thisCode); // code was not selected from the Lexicon. //HDS6393 + end; + if AddToPDList.Count > 0 then + rpcAddToPersonalDxList(User.DUZ,AddToPDList); +end; + + +procedure TfrmBALocalDiagnoses.AddToProblemList; +var + i: integer; + tempCode, passCode: string; + NewList: TStringList; + PatientInfo:string; + ProviderID:string; + ptVAMC:string; + +begin + PatientInfo := Patient.DFN + U + Patient.Name + U; + ProviderID := IntToStr(Encounter.Provider); + ptVAMC := ''; + NewList := TStringList.Create; + NewList.Clear; + // ** Add Diagnosis to Problem List if flagged with 'Add' in First Col. + with lvDxGrid do + begin + for i := 0 to Items.Count-1 do + begin + if StrPos(PChar(LvDxGrid.Items[i].Caption),PChar(ADD_TO_PROBLEM_LIST)) <> nil then + begin + tempCode := lvDxGrid.Items[i].Subitems[1]; + // ** passCode consists of Dx Code '^' Dx Desc ///// + passCode := Piece(tempCode,':',2) + U + Piece(tempCode,':',1); + if Piece(passCode,U,1) <> TX799 then + begin + NewList := BAPLRec.BuildProblemListDxEntry(passCode); + CallV('ORQQPL ADD SAVE',[PatientInfo, ProviderID, BAPLPt.PtVAMC, NewList]); + NewList.Free; + end; + end; + end; + end; +end; + +procedure TfrmBALocalDiagnoses.BuildConsultDxList(pDxList: TStringList); // ** adds grid items to BAConsultDxList - uConsults +var + i: integer; + x: string; +begin + UBAGlobals.BAConsultDxList.Clear; + + if lvDxGrid.Items.Count > 0 then + with lvDxGrid do + begin + for i := 0 to Items.Count-1 do + begin + if i = 0 then fODConsult.displayDXCode := lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]; + x:= lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]; + if Piece(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1],U,1) = PRIMARY_DX then + fODConsult.displayDXCode := Piece(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1],U,2); + uBAGlobals.BAConsultDxList.Add(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]); + end; + uBAGlobals.BAConsultDxList.Sort; + end + else + uBAGlobals.BAConsultDxList.Clear; +end; + + +procedure TfrmBALocalDiagnoses.BuildTempDxList; +var + i : integer; + tempStr1,tempStr2, tempStr3: string; + tempFactor1,x: string; + tempStrList: TStringList; +begin + tempStrList := TStringList.Create; + if Assigned(tempStrList) then tempStrList.Clear; + + UBAGlobals.Dx1 := ''; + UBAGlobals.Dx2 := ''; + UBAGlobals.Dx3 := ''; + UBAGlobals.Dx4 := ''; + UBAGlobals.TFactors := ''; + tempstr1 := ''; + tempstr2 := ''; + tempstr3 := ''; + tempFactor1 := ''; + + if lvDxGrid.Items.Count > 0 then + with lvDxGrid do + begin + for i := 0 to Items.Count-1 do + begin + x := lvDxGrid.Items[i].Subitems[0]; + x := lvDxGrid.Items[i].Subitems[1]; + x:= lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]; + tempStrList.Add(lvDxGrid.Items[i].Subitems[0] + '^' + lvDxGrid.Items[i].Subitems[1]); + end; + if tempStrList.Count > 0 then + tempStrList.Sort; //** Sort list Ascending order. + with tempStrList do + begin + tempFactor1 := (Piece(tempStrList.Strings[0],'(',2)); //** 0 = Primary + tempFactor1 := (Piece(tempFactor1,')',1) ); + if (Length(tempFactor1) > 0) then + UBAGLobals.TFactors := tempFactor1; + for i := 0 to tempStrList.Count-1 do + begin + tempstr1 := (Piece(tempStrList.Strings[i],U,2)); + tempstr2 := (Piece(tempstr1,':',1) + '^'+ Piece(tempstr1,':',2)); + if i = 0 then //** has primary dx changed + begin + if tempStr2 <> uPrimaryDxHold then + begin + if tempStr2 <> '' then + PrimaryChanged := True; + end; + end; + if tempstr2 = U then + tempstr2 := DXREC_INIT_FIELD_VAL; + case i of + 0: UBAGlobals.Dx1 := tempStr2; + 1: UBAGlobals.Dx2 := tempStr2; + 2: UBAGlobals.Dx3 := tempStr2; + 3: UBAGlobals.Dx4 := tempStr2; + else + Exit; + end; + end; + end; + end + else + if lvDxGrid.Items.Count = 0 then + begin + UBAGlobals.Dx1 := DXREC_INIT_FIELD_VAL; + UBAGlobals.Dx2 := DXREC_INIT_FIELD_VAL; + UBAGlobals.Dx3 := DXREC_INIT_FIELD_VAL; + UBAGlobals.Dx4 := DXREC_INIT_FIELD_VAL; + end; +end; + +procedure TfrmBALocalDiagnoses.BuildBADxList; +begin + if not assigned(BADiagnosisList) then + begin + BADiagnosisList := TStringList.Create; + BADiagnosisList.Duplicates := dupIgnore; + BADiagnosisList.Sorted := True; + end; + + if UBAGlobals.Dx1 <> '' then + BADiagnosisList.Add(U + UBAGlobals.Dx1 + U); + + if UBAGlobals.Dx2 <> '' then + BADiagnosisList.Add(U + UBAGlobals.Dx2 + U); + + if UBAGlobals.Dx3 <> '' then + BADiagnosisList.Add(U + UBAGlobals.Dx3 + U); + + if UBAGlobals.Dx4 <> '' then + BADiagnosisList.Add(U + UBAGlobals.Dx4 + U); +end; + +procedure TfrmBALocalDiagnoses.ListConsultDX(pOrderDxList: TStringList); +var + i: integer; + dx1,dx2,dx3,dx4: string; + begin + if UBAGlobals.BAConsultDxList.Count = 0 then Exit; + dx1 := ''; + dx2 := ''; + dx3 := ''; + dx4 := ''; + for i := 0 to BAConsultDxList.Count-1 do + begin + case i of + 0: dx1 := BAConsultDxList.Strings[i]; + 1: dx2 := BAConsultDxList.Strings[i]; + 2: dx3 := BAConsultDxList.Strings[i]; + 3: dx4 := BAConsultDxList.Strings[i]; + end; + end; + + ListItem := lvDxGrid.Items.Add; + if Length(dx1) > 0 then + ListItem.SubItems.Add(UBAConst.PRIMARY_DX) + else + ListItem.SubItems.Add(DXREC_INIT_FIELD_VAL); + ListItem.SubItems.Add(Piece(dx1,U,2)); + + if Length(dx2) > 1 then + begin + ListItem := lvDxGrid.Items.Add; + ListItem.SubItems.Add(UBAConst.SECONDARY_DX); + ListItem.SubItems.Add(Piece(dx2,U,2)); + end; + + if Length(dx3) > 1 then + begin + ListItem := lvDxGrid.Items.Add; + ListItem.SubItems.Add(UBAConst.SECONDARY_DX); + ListItem.SubItems.Add(Piece(dx3,U,2)); + end; + + if Length(dx4) > 1 then + begin + ListItem := lvDxGrid.Items.Add; + ListItem.SubItems.Add(UBAConst.SECONDARY_DX); + ListItem.SubItems.Add(Piece(dx4,U,2)); + end; +end; + +procedure TfrmBALocalDiagnoses.ListGlobalDx(pOrderIDList: TStringList); // need to get rec based on orderid +var + i :integer; +begin + + if not Assigned(UBAGlobals.globalDxRec) then Exit; + + if (Assigned(UBAGlobals.globalDxRec)) and (UBAGlobals.globalDxRec.FBADxCode = '') then Exit; + + for i := 0 to pOrderIDList.Count-1 do + begin + if tempDxNodeExists(pOrderIDList.Strings[i]) then + begin + UBAGlobals.globalDxRec.FOrderID := pOrderIDList.Strings[i]; + break; + end; + end; + ListItem := lvDxGrid.Items.Add; + if Length(UBAGlobals.globalDxRec.FBADxCode) > 0 then + ListItem.SubItems.Add(UBAConst.PRIMARY_DX) + else + ListItem.SubItems.Add(DXREC_INIT_FIELD_VAL); + uPrimaryDxHold := UBAGlobals.globalDxRec.FBADxCode; + ListItem.SubItems.Add(UBAGlobals.globalDxRec.FBADxCode); + + if Length(UBAGlobals.globalDxRec.FBASecDx1) > 1 then + begin + ListItem := lvDxGrid.Items.Add; + ListItem.SubItems.Add(UBAConst.SECONDARY_DX); + ListItem.SubItems.Add(UBAGlobals.globalDxRec.FBASecDx1); + end; + + if Length(UBAGlobals.globalDxRec.FBASecDx2) > 1 then + begin + ListItem := lvDxGrid.Items.Add; + ListItem.SubItems.Add(UBAConst.SECONDARY_DX); + ListItem.SubItems.Add(UBAGlobals.globalDxRec.FBASecDx2); + end; + + if Length(UBAGlobals.globalDxRec.FBASecDx3) > 1 then + begin + ListItem := lvDxGrid.Items.Add; + ListItem.SubItems.Add(UBAConst.SECONDARY_DX); + ListItem.SubItems.Add(UBAGlobals.globalDxRec.FBASecDx3); + end; +end; + +procedure TfrmBALocalDiagnoses.lbDiagnosisClick(Sender: TObject); +var + i : integer; + newDxCode, initDxCode: string; +begin + inherited; + for i := 0 to lbDiagnosis.Count-1 do + begin + if(lbDiagnosis.Selected[i]) then + begin + initDxCode := StringReplace(lbDiagnosis.Items[i],':',' ',[rfReplaceAll]); + newDxCode := (Piece(initDxCode,U,1) + ':'+ Piece(initDxCode,U,2)); + if UBACore.IsICD9CodeActive(Piece(newDxCode,':',2),'ICD',Encounter.DateTime) then + begin + if not IsDxAlreadySelected(newDxCode) then + begin + DiagnosisSelection(newDxCode); + SetAddToCheckBoxStatus(newDxCode); + end + else + begin + DeselectGridItems; + lvDxGrid.Items[lvDxGrid.items.Count-1].Selected := true; + InfoBox(BA_DUP_DX_DISALLOWED_1 + Piece(newDxCode,':',2) + BA_DUP_DX_DISALLOWED_2,BA_DUP_DX ,MB_ICONINFORMATION or MB_OK); + end; + end + else + InfoBox(BA_INACTIVE_ICD9_CODE_1 + Piece(newDxCode,':',2) + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK); + end; + end; +end; + + +procedure TfrmBALocalDiagnoses.DeselectGridItems; +var +i: integer; +begin + if lvDxGrid.Items.Count = 0 then + lvDxGrid.Clear + else + begin + for i := 0 to lvDxGrid.Items.Count-1 do + lvDxGrid.Items[i].Selected := false; + end; +end; + +procedure TfrmBALocalDiagnoses.FormActivate(Sender: TObject); +begin + inherited; + InactiveICDNotification; +end; + +procedure TfrmBALocalDiagnoses.FormShow(Sender: TObject); +begin + lbSections.Selected[0] := false; + + if lbSections.Count > 0 then + ListDiagnosisCodes(lbSections.Items[0]); +end; + +procedure TfrmBALocalDiagnoses.ListSelectedOrders; +var i: integer; +begin + if BAtmpOrderList.Count > 0 then + try + for i:= 0 to BAtmpOrderList.Count -1 do + begin + lbOrders.Items.Add(StringReplace(BAtmpOrderList.Strings[i],CRLF,' ',[rfReplaceAll]) ); + + end; + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in frmBALocalDiagnoses.ListSelectedOrders()');{$endif} + raise; + end; + end; //try + +end; + +procedure TfrmBALocalDiagnoses.AddDiagnosistoPersonalDiagnosesList1Click(Sender: TObject); +var + i: integer; + pCodeList: TStringList; + selectedList: TStringList; +begin + inherited; + pCodeList := TStringList.Create; + selectedList := TStringList.Create; + + if Assigned(pCodeList) then pCodeList.Clear; + if Assigned(selectedList) then selectedList.Clear; + + try + for i := 0 to lbDiagnosis.Items.Count-1 do + if(lbDiagnosis.Selected[i]) then + selectedList.Add((Piece(lbDiagnosis.Items[i],U,2)) ); + except + on EListError do + begin + {$ifdef debug}ShowMessage('EListError in frmBALocalDiagnoses.AddDiagnosisToPersonalDiagnosesListClick()');{$endif} + raise; + end; + end; //try + + if selectedList.Count > 0 then + if UBACore.rpcAddToPersonalDxList(User.DUZ,selectedList) then + begin + ShowMessage(UBAMessages.BA_PERSONAL_LIST_UPDATED); + LoadEncounterForm; + Refresh; + end; + +end; + +procedure TfrmBALocalDiagnoses.AddDiagnosistoPersonalDiagnosesList2Click( + Sender: TObject); + var i:integer; + selectedList: TStringList; +begin + inherited; + selectedList := TStringList.Create; + if Assigned(selectedList) then selectedList.create; + + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if(lvDxGrid.Items[i].Selected) then + selectedList.Add( piece(LvDxGrid.Items[i].SubItems[1],':',2) ); + end; + if UBACore.rpcAddToPersonalDxList(User.DUZ,selectedList) then + begin + ShowMessage(UBAMessages.BA_PERSONAL_LIST_UPDATED); + LoadEncounterForm; + Refresh; + end; +end; + + +procedure TfrmBALocalDiagnoses.cbAddToPDListClick(Sender: TObject); +var i: integer; +begin + inherited; + + if cbAddToPDList.Checked then + begin + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if(lvDxGrid.Items[i].Selected) then + begin + lvDxGrid.Items[i].Caption := AddToWhatList(cbAddToPL.Checked,cbAddToPDList.Checked); + cbaddToPDList.Checked := true; + lvDxGrid.SetFocus; + end + else + if(lvDxGrid.Items[i].Selected) then + begin + lvDxGrid.Items[i].Caption := AddToWhatList(cbAddToPL.Checked,cbAddToPDList.Checked); + cbaddToPL.Checked := false; + lvDxGrid.SetFocus; + end; + end; + end + else + begin + if not cbaddToPDList.Checked then + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if(lvDxGrid.Items[i].Selected) then + lvDxGrid.Items[i].Caption := AddToWhatList(cbAddToPL.Checked,cbAddToPDList.Checked); + end; +end; + EnsurePrimary; +end; + +function TfrmBALocalDiagnoses.AddToWhatList(IsPLChecked:boolean; IsPDLChecked:boolean):string; +begin + Result := ''; + + if IsPLChecked and IsPDLChecked then + Result := 'PL/PD' + else + if IsPLChecked then + Result := 'PL' + else + if IsPDLChecked then + Result := 'PD'; + +end; + +procedure TfrmBALocalDiagnoses.InactiveICDNotification; +begin + if inactiveCodes > 0 then + begin + if (not BAFWarningShown) and (inactiveCodes > 0) then + begin +// InfoBox('There are ' + IntToStr(inactiveCodes) + ' active problem(s) flagged with a "#" as having' + #13#10 + <-- original line. //kt 8/15/2007 + InfoBox(DKLangConstW('fBALocalDiagnoses_There_are')+' ' + IntToStr(inactiveCodes) + DKLangConstW('fBALocalDiagnoses_active_problemxsx_flagged_with_a_xxx_as_having') + #13#10 + //kt added 8/15/2007 +// 'inactive ICD codes as of today''s date. Please correct these' + #13#10 + <-- original line. //kt 8/15/2007 + DKLangConstW('fBALocalDiagnoses_inactive_ICD_codes_as_of_todayxxs_datex__Please_correct_these') + #13#10 + //kt added 8/15/2007 +// 'problems via the Problems Tab - Change" option.', 'Inactive ICD Codes Found', MB_ICONWARNING or MB_OK); <-- original line. //kt 8/15/2007 + DKLangConstW('fBALocalDiagnoses_problems_via_the_Problems_Tab_x_Changex_optionx'), DKLangConstW('fBALocalDiagnoses_Inactive_ICD_Codes_Found'), MB_ICONWARNING or MB_OK); //kt added 8/15/2007 + BAFWarningShown := True; + end; + end; +end; + +procedure TfrmBALocalDiagnoses.lbSectionsDrawItem(Control: TWinControl; + Index: Integer; Rect: TRect; State: TOwnerDrawState); +begin + inherited; + lbsections.Font.Size := MainFontSize; + if (control as Tlistbox).items[index] = DX_PROBLEM_LIST_TXT then + (Control as TListBox).Canvas.Font.Style := [fsBold] + else + if (control as Tlistbox).items[index] = DX_PERSONAL_LIST_TXT then + (Control as TListBox).Canvas.Font.Style := [fsBold] + else + if (control as Tlistbox).items[index] = DX_ENCOUNTER_LIST_TXT then + (Control as TListBox).Canvas.Font.Style := [fsBold]; + + (Control as TListBox).Canvas.TextOut(Rect.Left+2, Rect.Top+1, (Control as + TListBox).Items[Index]); {** display the text } +end; + +//** Loads string lists containing Diagnoses contained in the Problem and Personal DX List. +//** These lists will be used to insure duplicates can not be entered via add to check boxes. +procedure TfrmBALocalDiagnoses.LoadTempDXLists; +var + i: integer; + sChar,probDX,x: string; + updatingProblemList, updatingPersonalList: boolean; +begin + sChar := ')'; + updatingProblemList := FALSE; + updatingPersonalList := FALSE; + if Assigned(ProblemDxHoldList) then ProblemDxHoldList.Clear; + if Assigned(PersonalDxHoldList) then PersonalDxHoldList.Clear; + for i := 0 to BADiagnosis.Count - 1 do + begin + x := BADiagnosis.Strings[i]; + if CharAt(BADiagnosis[i], 1) = U then + begin + if Piece(BADiagnosis.Strings[i],U,2) = PROBLEM_LIST_SECTION then + begin + updatingProblemList := TRUE; + updatingPersonalList := FALSE; + end + else + begin + if Piece(BADiagnosis.Strings[i],U,2) = PERSONAL_DX_SECTION then + begin + updatingProblemList := FALSE; + updatingPersonalList := TRUE; + end + else + begin + updatingProblemList := FALSE; + updatingPersonalList := FALSE; + end; + end; + end; + if updatingProblemList then + begin + if Piece(BADiagnosis.Strings[i],U,2) = PROBLEM_LIST_SECTION then lbSections.Selected[0] := true; + if strPos(pChar(BADiagnosis.Strings[i]) , pChar(sChar) ) <> nil then + begin + probDX := StringReplace(BADiagnosis.Strings[i],'(','^',[rfReplaceAll]); + probDX := StringReplace(probDX,')','^',[rfReplaceAll]); + probDX := Piece(probDX,U,2) + ':' + Piece(probDX,U,1); + probDX := StringReplace(probDX,' ','',[rfReplaceAll]); + ProblemDXHoldList.Add(probDX); + end + else + ProblemDxHoldList.Add(Piece(BADiagnosis.Strings[i],U,2) +':' +Piece(BADiagnosis.Strings[i],U,1) ); + end + else + if updatingPersonalList then + PersonalDxHoldList.Add(Piece(BADiagnosis.Strings[i],U,2) + ':' + Piece(BADiagnosis.Strings[i],U,1) ); + end; +end; + +procedure TfrmBALocalDiagnoses.lvDxGridKeyDown(Sender: TObject; + var Key: Word; Shift: TShiftState); +begin + inherited; + if(ssShift in Shift) or(ssCtrl in Shift) then + selectingDX := True; +end; + +//** set Add To Check Boxes status. +procedure TfrmBALocalDiagnoses.SetAddToCBoxStatus; +var + i: integer; + x: string; +begin + UpdatingGrid := False; + + // ** detemine status of "add to" check boxes..... + + //** if dx selected already exists in Problem or Personal Dx List then + //** add to checkboxes are disabled. + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if lvDxGrid.Items[i].Selected then + begin + x:= lvDxGrid.Items[i].Subitems[1]; + lvDxGrid.Items[i].Selected := True; + SetAddToCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]); + lvDxGrid.SetFocus; + end; + end; + + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if lvDxGrid.Items[i].Selected then + if lvDxGrid.Items[i].Caption = 'PL/PD' then + begin + UpdatingGrid := True; + lvDxGrid.Items[i].Selected := True; + cbaddToPL.Checked := True; + cbAddToPDList.Checked := true; + ResetCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]); + lvDxGrid.SetFocus; + end + else if lvDxGrid.Items[i].Caption = 'PL' then + begin + UpdatingGrid := True; + lvDxGrid.Items[i].Selected := True; + cbaddToPL.Checked := True; + cbAddToPDList.Checked := False; + ResetCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]); + lvDxGrid.SetFocus; + end + else if lvDxGrid.Items[i].Caption = 'PD' then + begin + UpdatingGrid := True; + lvDxGrid.Items[i].Selected := True; + cbaddToPL.Checked := False; + cbAddToPDList.Checked := True; + ResetCheckBoxStatus(lvDxGrid.Items[i].Subitems[1]); + lvDxGrid.SetFocus; + end; + end; + // ** end determine check box status................ +end; + + +procedure TfrmBALocalDiagnoses.lvDxGridKeyUp(Sender: TObject; + var Key: Word; Shift: TShiftState); +begin + inherited; + selectingDX := False; +end; + +procedure TfrmBALocalDiagnoses.lvDxGridClick(Sender: TObject); +begin + inherited; +if deleteDX then Exit; + +if lvDxGrid.SelCount > 1 then + ProcessMultSelections +else + SetAddToCBoxStatus; +end; + +procedure TfrmBALocalDiagnoses.lbOrdersMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +var + lstIndex: integer; +begin + inherited; + //** CQ4739 + with lbOrders do + begin + lstIndex := SendMessage(Handle, LB_ITEMFROMPOINT, 0, MakeLParam(X, Y)); + if (lstIndex >= 0) and (lstIndex <= Items.Count-1) then + Hint := Items[lstIndex] + else + Hint := ''; + end; + //** end CQ4739 +end; + +procedure TfrmBALocalDiagnoses.SetAddToCheckBoxStatus(ADiagnosis:string); +var + selectedDX :string; + i: integer; + begin + if (cbAddToPL.Checked or cbAddToPDList.Checked) then + begin + for i := 0 to LvDxGrid.Items.Count-1 do + begin + if(lvDxGrid.Items[i].Selected) then + begin + if StrPos(PChar(LvDxGrid.Items[i].Caption),PChar(ADD_TO_PERSONAL_DX_LIST)) <> nil then Exit; + if StrPos(PChar(LvDxGrid.Items[i].Caption),PChar(ADD_TO_PROBLEM_LIST)) <> nil then Exit; + end; + end; + end; + + if lvDxGrid.SelCount = 0 then + begin + ClearAndDisableCBoxes; + Exit; + end; + selectedDX:= Piece(ADiagnosis,':',2); + //** loop thru problem list dx, if match check box disabled + if ProblemListDxFound(selectedDx) then + begin + cbAddToPL.Enabled := False; + cbAddToPL.Checked := False; + end + else + begin + cbAddToPL.Enabled := True; + cbAddToPL.Checked := False; + end; + + if PersonalListDxFound(selectedDx) then + begin + cbAddToPDList.Enabled := False; + cbAddToPDList.Checked := False; + end + else + begin + cbAddToPDList.Enabled := True; + cbAddToPDList.Checked := False; + end; + +end; + +procedure TfrmBALocalDiagnoses.ProcessMultSelections; +var + i: integer; + selectedDX: string; + PLFound, PDLFound: boolean; +begin + PLFound := False; + PDLFound := False; + for i := 0 to lvDxGrid.Items.Count-1 do + begin + if(lvDxGrid.Items[i].Selected) then + begin + selectedDX := lvDxGrid.Items[i].Subitems[1]; + selectedDX := Piece(selectedDX,':',2); + if not PLFound then + PLFound := ProblemListDxFound(selectedDX); + if not PDLFound then + PDLFound := PersonalListDXFound(selectedDX); + end; + end; + if not PDLFound then + begin + cbAddToPDList.Enabled := True; + cbAddTOPDList.Checked := False; + end + else + begin + cbAddToPDList.Enabled := False; + cbAddTOPDList.Checked := False; + end; + if not PLFound then + begin + cbAddToPL.Enabled := True; + cbAddToPL.Checked := False; + end + else + begin + cbAddToPL.Enabled := False; + cbAddToPL.Checked := False; + end; +end; + +procedure TfrmBALocalDiagnoses.ClearAndDisableCBoxes; +begin + cbAddToPL.Checked := False; + cbAddToPDList.Checked := False; + lvDxGrid.ClearSelection; + cbAddToPL.Enabled := False; + cbAddToPDList.Enabled := False; +end; + +procedure TfrmBALocalDiagnoses.ORStaticText1Enter(Sender: TObject); +begin + inherited; + (Sender as TORStaticText).Font.Style := [fsBold]; +end; + +procedure TfrmBALocalDiagnoses.ORStaticText1Exit(Sender: TObject); +begin + inherited; + (Sender as TORStaticText).Font.Style := []; +end; + +procedure TfrmBALocalDiagnoses.ORStaticText3Enter(Sender: TObject); +begin + inherited; + (Sender as TORStaticText).Font.Style := [fsBold]; +end; + +procedure TfrmBALocalDiagnoses.ORStaticText3Exit(Sender: TObject); +begin + inherited; + (Sender as TORStaticText).Font.Style := []; +end; + +procedure TfrmBALocalDiagnoses.ResetCheckBoxStatus(pDxCode:string); +begin + if Not ProblemListDxFound(pDxCode) then + cbAddToPL.Enabled := True; + if Not PersonalListDxFound(pDxCode) then + cbAddToPDList.Enabled := True; + + +end; + + +Initialization + BADiagnosis := TStringList.Create; + currentOrderIDList := TStringList.Create; + ProblemDxHoldList := TStringList.Create; + PersonalDxHoldList := TStringList.Create; + lexIENHoldList := TStringList.Create; + BADiagnosis.Clear; + currentOrderIDList.Clear; + PersonalDxHoldList.Clear; + ProblemDxHoldList.Clear; + lexIENHoldList.Clear; + +end. + Index: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBAOptionsDiagnoses.dfm =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBAOptionsDiagnoses.dfm (revision 541) +++ cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBAOptionsDiagnoses.dfm (revision 541) @@ -0,0 +1,327 @@ +inherited frmBAOptionsDiagnoses: TfrmBAOptionsDiagnoses + Left = 231 + Top = 183 + Width = 747 + Height = 557 + Caption = 'Personal Diagnoses List' + Constraints.MinHeight = 100 + Constraints.MinWidth = 200 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object Panel1: TPanel [0] + Left = 0 + Top = 0 + Width = 739 + Height = 523 + Align = alClient + Caption = 'Panel1' + Constraints.MinHeight = 344 + Constraints.MinWidth = 576 + TabOrder = 0 + object Panel2: TPanel + Left = 16 + Top = 10 + Width = 713 + Height = 519 + Caption = 'Panel1' + TabOrder = 0 + object Splitter1: TSplitter + Left = 458 + Top = 26 + Width = -3 + Height = 463 + end + object Splitter2: TSplitter + Left = 169 + Top = 26 + Width = 7 + Height = 463 + end + object Splitter3: TSplitter + Left = 457 + Top = 26 + Width = 1 + Height = 463 + end + object Splitter5: TSplitter + Left = 455 + Top = 26 + Width = 2 + Height = 463 + end + object pnlBottom: TPanel + Left = 1 + Top = 489 + Width = 711 + Height = 29 + Align = alBottom + BevelOuter = bvNone + Caption = ' ' + TabOrder = 0 + DesignSize = ( + 711 + 29) + object btnOther: TButton + Left = 13 + Top = 3 + Width = 129 + Height = 23 + Anchors = [akLeft, akBottom] + Caption = 'Other &Diagnoses' + Constraints.MinHeight = 23 + Constraints.MinWidth = 115 + TabOrder = 0 + OnClick = btnOtherClick + end + object btnOK: TButton + Left = 523 + Top = 3 + Width = 75 + Height = 23 + Anchors = [akRight, akBottom] + Caption = '&OK' + TabOrder = 1 + OnClick = btnOKClick + end + object Button1: TButton + Left = 632 + Top = 4 + Width = 75 + Height = 21 + Anchors = [akRight, akBottom] + Caption = '&Cancel' + TabOrder = 2 + OnClick = Button1Click + end + end + object Panel3: TPanel + Left = 1 + Top = 26 + Width = 168 + Height = 463 + Align = alLeft + BevelOuter = bvNone + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 1 + object lbSections: TORListBox + Left = 0 + Top = 17 + Width = 161 + Height = 446 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ItemHeight = 13 + ParentFont = False + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnClick = lbSectionsClick + OnEnter = lbSectionsEnter + ItemTipColor = clWindow + LongList = False + Pieces = '3' + end + object hdrCntlDxSections: THeaderControl + Left = 0 + Top = 0 + Width = 168 + Height = 17 + Sections = < + item + Alignment = taCenter + ImageIndex = -1 + Text = 'Diagnoses Sections' + Width = 50 + end> + end + end + object Panel4: TPanel + Left = 176 + Top = 26 + Width = 201 + Height = 463 + Align = alLeft + BevelOuter = bvNone + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + TabOrder = 2 + object lbDiagnosis: TORListBox + Left = 0 + Top = 17 + Width = 201 + Height = 446 + Align = alClient + ItemHeight = 13 + MultiSelect = True + ParentShowHint = False + ShowHint = True + Sorted = True + TabOrder = 0 + OnClick = lbDiagnosisChange + OnEnter = lbDiagnosisEnter + ItemTipColor = clWindow + LongList = False + Pieces = '1,2,3' + OnChange = lbDiagnosisChange + end + object hdrCntlDxAdd: THeaderControl + Left = 0 + Top = 0 + Width = 201 + Height = 17 + Sections = < + item + Alignment = taCenter + ImageIndex = -1 + Text = 'Diagnoses to add' + Width = 50 + end> + end + end + object Panel5: TPanel + Left = 455 + Top = 26 + Width = 257 + Height = 463 + Align = alClient + BevelOuter = bvNone + Caption = 'Panel5' + TabOrder = 3 + object lbPersonalDx: TORListBox + Left = 0 + Top = 17 + Width = 257 + Height = 446 + Align = alClient + Anchors = [akRight] + Color = clInfoBk + ItemHeight = 13 + MultiSelect = True + ParentShowHint = False + ShowHint = True + Sorted = True + TabOrder = 0 + OnClick = lbPersonalDxClick + ItemTipColor = clWindow + LongList = False + Pieces = '2,1,3' + end + object hdrCntlDx: THeaderControl + Left = 0 + Top = 0 + Width = 257 + Height = 17 + Sections = < + item + Alignment = taCenter + ImageIndex = -1 + MinWidth = 150 + Text = 'Diagnoses Codes' + Width = 150 + end> + OnSectionClick = hdrCntlDxSectionClick + end + end + object pnlTop: TPanel + Left = 1 + Top = 1 + Width = 711 + Height = 25 + Align = alTop + BevelOuter = bvNone + TabOrder = 4 + object StaticText3: TStaticText + Left = 472 + Top = 8 + Width = 140 + Height = 17 + Caption = 'Personal Diagnoses List' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + TabOrder = 0 + TabStop = True + end + end + object Panel7: TPanel + Left = 377 + Top = 26 + Width = 78 + Height = 463 + Align = alLeft + BevelOuter = bvNone + TabOrder = 5 + DesignSize = ( + 78 + 463) + object btnAdd: TBitBtn + Left = 1 + Top = 88 + Width = 75 + Height = 25 + Anchors = [akLeft, akTop, akRight] + Caption = '&Add' + Constraints.MinHeight = 25 + Constraints.MinWidth = 70 + Enabled = False + TabOrder = 0 + OnClick = btnAddClick + NumGlyphs = 2 + end + object btnDelete: TBitBtn + Left = 2 + Top = 136 + Width = 75 + Height = 25 + Caption = '&Remove' + Constraints.MinHeight = 25 + Constraints.MinWidth = 70 + Enabled = False + TabOrder = 1 + OnClick = btnDeleteClick + NumGlyphs = 2 + end + end + end + end + inherited DKLanguageController1: TDKLanguageController + LangData = { + 150066726D42414F7074696F6E73446961676E6F736573010100000001000000 + 070043617074696F6E0118000000060050616E656C3101010000000200000007 + 0043617074696F6E00060050616E656C32010100000003000000070043617074 + 696F6E00090053706C6974746572310000090053706C69747465723200000900 + 53706C6974746572330000090053706C69747465723500000900706E6C426F74 + 746F6D0000080062746E4F74686572010100000004000000070043617074696F + 6E00050062746E4F4B010100000005000000070043617074696F6E0007004275 + 74746F6E31010100000006000000070043617074696F6E00060050616E656C33 + 00000A006C6253656374696F6E7300001100686472436E746C44785365637469 + 6F6E73010100000007000000100053656374696F6E735B305D2E546578740006 + 0050616E656C3400000B006C62446961676E6F73697300000C00686472436E74 + 6C4478416464010100000008000000100053656374696F6E735B305D2E546578 + 7400060050616E656C35010100000009000000070043617074696F6E000C006C + 62506572736F6E616C447800000900686472436E746C447801010000000A0000 + 00100053656374696F6E735B305D2E54657874000600706E6C546F7000000B00 + 537461746963546578743301010000000B000000070043617074696F6E000600 + 50616E656C370000060062746E41646401010000000C00000007004361707469 + 6F6E00090062746E44656C65746501010000000D000000070043617074696F6E + 00} + end +end Index: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBAOptionsDiagnoses.pas =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBAOptionsDiagnoses.pas (revision 541) +++ cprs/branches/tmg-cprs/CPRS-Chart/Consults/fBAOptionsDiagnoses.pas (revision 541) @@ -0,0 +1,659 @@ +//kt -- Modified with SourceScanner on 8/8/2007 +unit fBAOptionsDiagnoses; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, fAutoSz, StdCtrls, ORCtrls, ExtCtrls, ORFn, UCore, RCore, ORNet, + UBAGlobals, fPCELex, rPCE, Buttons, UBACore, UBAMessages, UBAConst, + ComCtrls, DKLang; + +type + TfrmBAOptionsDiagnoses = class(TfrmAutoSz) + Panel1: TPanel; + Panel2: TPanel; + Splitter1: TSplitter; + Splitter2: TSplitter; + Splitter3: TSplitter; + pnlBottom: TPanel; + btnOther: TButton; + btnOK: TButton; + Panel3: TPanel; + lbSections: TORListBox; + Panel4: TPanel; + lbDiagnosis: TORListBox; + Panel5: TPanel; + lbPersonalDx: TORListBox; + pnlTop: TPanel; + Panel7: TPanel; + btnAdd: TBitBtn; + btnDelete: TBitBtn; + Splitter5: TSplitter; + Button1: TButton; + StaticText3: TStaticText; + hdrCntlDx: THeaderControl; + hdrCntlDxSections: THeaderControl; + hdrCntlDxAdd: THeaderControl; + procedure FormCreate(Sender: TObject); + procedure btnOtherClick(Sender: TObject); + procedure lbSectionsClick(Sender: TObject); + procedure lbSectionsEnter(Sender: TObject); + procedure lbDiagnosisClick(Sender: TObject); + procedure btnCancelClick(Sender: TObject); + procedure btnOKClick(Sender: TObject); + procedure btnAddClick(Sender: TObject); + procedure btnDeleteClick(Sender: TObject); + procedure lbDiagnosisChange(Sender: TObject); + procedure lbPersonalDxClick(Sender: TObject); + procedure lbDiagnosisEnter(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure Button1Click(Sender: TObject); + procedure FormActivate(Sender: TObject); + function IsDXInList(ADXCode: string):boolean; + procedure LoadPersonalDxList; + procedure btnRemoveAllClick(Sender: TObject); + procedure btnAddAllClick(Sender: TObject); + procedure hdrCntlDxSectionClick(HeaderControl: THeaderControl; + Section: THeaderSection); + procedure FormResize(Sender: TObject); + private + { Private declarations } + procedure LoadEncounterDx; + procedure ListDiagnosesSections(Dest: TStrings); + procedure AddProblemsToDxList; + procedure ListDiagnosesCodes(Section: String); + procedure InactiveICDNotification; + procedure SyncDxDeleteList; + procedure SyncDxNewList; + + public + { Public declarations } + end; + +var + + uAddToP : integer; + uDeleteFromPDL: integer; + uNewDxList : TStringList; + Problems : TStringList; + DxList : TStringList; + ECFDiagnoses : TStringList; + tmplst : TStringList; + newDxLst : TStringList; + delDxLst : TStringList; + inactiveCodes : integer; + +procedure DialogOptionsDiagnoses(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); + +implementation + +{$R *.dfm} + +var + + LastDFN : string; + LastLocation : integer; + FDxSection: string; + BADxCode: String; + +procedure DialogOptionsDiagnoses(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); +var + frmBAOptionsDiagnoses: TfrmBAOptionsDiagnoses; + begin + frmBAOptionsDiagnoses := TfrmBAOptionsDiagnoses.Create(Application); + actiontype := 0; + with frmBAOptionsDiagnoses do + begin + if (topvalue < 0) or (leftvalue < 0) then + Position := poScreenCenter + else + begin + Position := poDesigned; + Top := topvalue; + Left := leftvalue; + end; + ResizeAnchoredFormToFont(frmBAOptionsDiagnoses); + ShowModal; + end; + +end; + +procedure TfrmBAOptionsDiagnoses.FormCreate(Sender: TObject); +begin + inactiveCodes := 0; + LoadEncounterDx; + ListDiagnosesSections(lbSections.Items); + // lbPersonalDx.Items := rpcGetPersonalDxList(User.DUZ); + LoadPersonalDxList; + btnOK.Enabled := False; + hdrCntlDx.Sections[0].Width := lbPersonalDX.Width; + hdrCntlDxSections.Sections[0].Width := lbSections.Width; + hdrCntlDxAdd.Sections[0].Width := lbDiagnosis.Width; + // lbPersonalDx.Sorted := false; + // lbPersonalDx.Sorted := True; + lbPersonalDX.Repaint; +end; + + +procedure TfrmBAOptionsDiagnoses.LoadEncounterDx; +{ load the major coding lists that are used by the encounter form for a given location } +var + i: integer; + TempList: TStringList; + EncDt: TFMDateTime; +begin +//Caption := 'Personal Diagnoses List for ' + User.Name; <-- original line. //kt 8/8/2007 + Caption := DKLangConstW('fBAOptionsDiagnoses_Personal_Diagnoses_List_for') + User.Name; //kt added 8/8/2007 + LastLocation := Encounter.Location; + EncDt := Trunc(FMToday); + //add problems to the top of diagnoses. + TempList := TstringList.Create; + DxList.clear; + tCallV(TempList,'ORWPCE DIAG', [LastLocation, EncDt]); + DxList.add(templist.strings[0]); + AddProblemsToDxList; + for i := 1 to (TempList.Count-1) do + begin + DxList.add(Templist.strings[i]); + end; +end; + +procedure TfrmBAOptionsDiagnoses.ListDiagnosesSections(Dest: TStrings); +var + i: Integer; + x: string; +begin + for i := 0 to DxList.Count - 1 do if CharAt(DxList[i], 1) = U then + begin + x := Piece(DxList[i], U, 2); +// if Length(x) = 0 then x := ''; <-- original line. //kt 8/8/2007 + if Length(x) = 0 then x := DKLangConstW('fBAOptionsDiagnoses_xNo_Section_Namex'); //kt added 8/8/2007 + Dest.Add(IntToStr(i) + U + Piece(DxList[i], U, 2) + U + x); + end; +end; + +procedure TfrmBAOptionsDiagnoses.ListDiagnosesCodes(Section: String); +var +i,j: integer; +a: string; +begin + lbDiagnosis.Clear; + a := ''; + for i := 0 to DxList.Count-1 do + begin + a := DxList.Strings[i]; + if Piece(DxList[i], U, 2) = (Piece(Section,U,2)) then + break; + end; + inc(i); + for j := i to DxList.Count-1 do + begin + if Piece(DxList[j], U, 0) = '' then + break + else + begin + a := Piece(DxList[j], U, 2) + '^' + Piece(DxList[j], U, 1); + if not UBACore.IsICD9CodeActive(Piece(a,U,2),'ICD',Encounter.DateTime) then + begin + a := a + ' ' + UBAConst.BA_INACTIVE_CODE; + inc(inactiveCodes); + end; + lbDiagnosis.Items.Add(a); + end; + end; +end; + +procedure TfrmBAOptionsDiagnoses.AddProblemsToDxList; +var + i : integer; + EncDt: TFMDateTime; + x : String; +begin + //Get problem list + EncDt := Trunc(FMToday); + LastDFN := Patient.DFN; + tCallV(Problems, 'ORWPCE ACTPROB', [Patient.DFN, EncDT]); + if Problems.Count > 0 then + begin +// DxList.add('^Problem List Items'); <-- original line. //kt 8/8/2007 + DxList.add('^'+DKLangConstW('fBAOptionsDiagnoses_Problem_List_Items')); //kt added 8/8/2007 + for i := 1 to (Problems.count-1) do + begin + x :=(Piece(Problems.Strings[i],U,3) + U + + Piece(Problems.Strings[i],U,2)); + // if (Piece(Problems.Strings[i],U,3) = '799.9') then continue; // DON'T INCLUDE 799.9 CODES + + if (Piece(problems.Strings[i], U, 11) = '#') then + DxList.add(Piece(Problems.Strings[i],U,3) + U + // PL code inactive + Piece(Problems.Strings[i],U,2) + U + '#') + else if (Piece(problems.Strings[i], U, 10) = '') then // no inactive date for code + DxList.add(Piece(Problems.Strings[i],U,3) + U + + Piece(Problems.Strings[i],U,2)) + else if (Trunc(StrToFloat(Piece(Problems.Strings[i], U, 10))) > EncDT) then // code active as of EncDt + DxList.add(Piece(Problems.Strings[i],U,3) + U + + Piece(Problems.Strings[i],U,2)) + else + DxList.add(Piece(Problems.Strings[i],U,3) + U + // PL code inactive + Piece(Problems.Strings[i],U,2) + U + '#'); + end; + end; +end; + +procedure TfrmBAOptionsDiagnoses.btnOtherClick(Sender: TObject); + var + Match: string; + SelectedList : TStringList; + lexIEN: string; +begin + inherited; + BAPersonalDX := True; + SelectedList := TStringList.Create; + if Assigned (SelectedList) then SelectedList.Clear; + BADxCode := ''; //init + //Execute LEXICON + LexiconLookup(Match, LX_ICD); + if Match = '' then Exit; + if strLen(PChar(Piece(Match, U, 3)))> 0 then + lexIEN := Piece(Match, U, 3); + + BADxCode := Piece(Match,U,2) + ' ' + Piece(Match, U, 1); + if IsDXInList(Piece(Match,U,1) ) then Exit; // eliminate duplicates + if UBACore.IsICD9CodeActive(Piece(Match,U,1),'ICD',Encounter.DateTime) then + begin + lbPersonalDx.Items.Add(BADxCode); + if strLen(PChar(lexIEN)) > 0 then + newDxLst.Add(Piece(Match,U,1) + U + lexIEN) + else + newDxLst.Add(Piece(Match,U,1)); + end + else + InfoBox(BA_INACTIVE_ICD9_CODE_1 + BADxCode + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK); + + lexIEN := ''; + BAPersonalDX := False; + if newDxLst.Count > 0 then btnOK.Enabled := True; +end; + +procedure TfrmBAOptionsDiagnoses.lbSectionsClick(Sender: TObject); +var i: integer; +begin + inherited; +for i := 0 to lbSections.Items.Count-1 do +begin + if(lbSections.Selected[i]) then + begin + ListDiagnosesCodes(lbSections.Items[i]); + FDXSection := lbSections.Items[i]; + Break; + end; + end; +end; + +procedure TfrmBAOptionsDiagnoses.lbSectionsEnter(Sender: TObject); +begin + inherited; + lbSections.Selected[0] := true; +end; + +procedure TfrmBAOptionsDiagnoses.lbDiagnosisClick(Sender: TObject); +var + i : integer; + newDxCodes: TStringList; + selectedCode: String; +begin + inherited; + newDxCodes := TStringList.Create; + newDxCodes.Clear; + for i := 0 to lbDiagnosis.Items.Count-1 do + begin + if(lbDiagnosis.Selected[i]) then + begin + selectedCode := Piece(lbDiagnosis.Items[i],U,2); + newDxCodes.Add(selectedCode); + end; + if newDxCodes.Count > 0 then + begin + rpcAddToPersonalDxList(User.DUZ,NewDxCodes); + NewDxCodes.Clear; + lbPersonalDx.Items := rpcGetPersonalDxList(User.DUZ); + end; + end; +end; + +procedure TfrmBAOptionsDiagnoses.btnCancelClick(Sender: TObject); +begin + inherited; + Close; +end; + +procedure TfrmBAOptionsDiagnoses.btnOKClick(Sender: TObject); +begin + inherited; + if delDxLst.Count > 0 then + begin + // delete selected dx's + rpcDeleteFromPersonalDxList(User.DUZ,delDxLst); + delDxLst.Clear; + end; + + if newDxLst.Count > 0 then + begin + newDxLst.Sort; + newDxLst.Duplicates := dupIgnore; + // add selected dx's + rpcAddToPersonalDxList(User.DUZ,newDxLst); + newDxLst.Clear; + end; + Close; +end; + +procedure TfrmBAOptionsDiagnoses.btnAddClick(Sender: TObject); +var + i : integer; + newDxCode: string; + +begin + inherited; + for i := 0 to lbDiagnosis.Items.Count-1 do + begin + if(lbDiagnosis.Selected[i]) then + begin + newDxCode := Piece(lbDiagnosis.Items[i],U,2); + if (not IsDxInList(newDxCode) ) then + begin + if UBACore.IsICD9CodeActive(newDxCode,'ICD',Encounter.DateTime) then + begin + newDxLst.Add(newDxCode); + lbPersonalDx.Items.Add(Piece(lbDiagnosis.Items[i],U,2) + U + Piece(lbDiagnosis.Items[i],U,1) ) + end + else + InfoBox(BA_INACTIVE_ICD9_CODE_1 + Trim(Piece(newDxCode,'#',1)) + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK); + end; + end; + end; + btnAdd.Enabled := False; + lbDiagnosis.ClearSelection; + if newDxLst.Count > 0 then btnOK.Enabled := True; +end; + +procedure TfrmBAOptionsDiagnoses.btnDeleteClick(Sender: TObject); +var + i, c: integer; +begin + inherited; + SyncDxDeleteList; + SyncDxNewList; + // delete selected dx from listbox. + with lbPersonalDX do + begin + i := Items.Count - 1; + c := SelCount; + Items.BeginUpdate; + while (i >= 0) and (c > 0) do + begin + if Selected[i] = true then + begin + Dec(c); + Items.Delete(i); + end; + Dec(i); + end; + Items.EndUpdate; + end; + + btnDelete.Enabled := False; + lbDiagnosis.ClearSelection; + if delDxLst.Count > 0 then btnOK.Enabled := True; +end; + +procedure TfrmBAOptionsDiagnoses.lbDiagnosisChange(Sender: TObject); +begin + inherited; + if lbDiagnosis.Count = 0 then + btnAdd.Enabled := False + else + begin + if (lbDiagnosis.SelCount > 0) then + btnAdd.Enabled := True + else + btnAdd.Enabled := False; + end; +end; + +procedure TfrmBAOptionsDiagnoses.lbPersonalDxClick(Sender: TObject); +var i : integer; +begin + inherited; + for i := 0 to lbPersonalDX.Count-1 do + begin + if(lbPersonalDX.Selected[i]) then + begin + btnDelete.Enabled := True; + break; + end + else + btnDelete.Enabled := False; + end; +end; + +procedure TfrmBAOptionsDiagnoses.lbDiagnosisEnter(Sender: TObject); +begin + inherited; +if lbDiagnosis.Count > 0 then + lbDiagnosis.Selected[0] := true; +end; + +procedure TfrmBAOptionsDiagnoses.FormShow(Sender: TObject); +begin + inherited; + if lbSections.Count > 0 then + ListDiagnosesCodes(lbSections.Items[0]); + lbSections.SetFocus; +end; + +procedure TfrmBAOptionsDiagnoses.Button1Click(Sender: TObject); +begin + inherited; + newDxLst.Clear; + Close; +end; + +procedure TfrmBAOptionsDiagnoses.InactiveICDNotification; +begin + if inactiveCodes > 0 then + begin + if (not BAFWarningShown) and (inactiveCodes > 0) then + begin +// InfoBox('There are ' + IntToStr(inactiveCodes) + ' active problem(s) flagged with a "#" as having' + #13#10 + <-- original line. //kt 8/8/2007 + InfoBox(DKLangConstW('fBAOptionsDiagnoses_There_are')+' ' + IntToStr(inactiveCodes) + DKLangConstW('fBAOptionsDiagnoses_active_problemxsx_flagged_with_a_xxx_as_having') + #13#10 + //kt added 8/8/2007 +// 'inactive ICD codes as of today''s date. Please correct these' + #13#10 + <-- original line. //kt 8/8/2007 + DKLangConstW('fBAOptionsDiagnoses_inactive_ICD_codes_as_of_todayxxs_datex__Please_correct_these') + #13#10 + //kt added 8/8/2007 +// 'problems via the Problems Tab - Change" option.', 'Inactive ICD Codes Found', MB_ICONWARNING or MB_OK); <-- original line. //kt 8/8/2007 + DKLangConstW('fBAOptionsDiagnoses_problems_via_the_Problems_Tab_x_Changex_optionx'), DKLangConstW('fBAOptionsDiagnoses_Inactive_ICD_Codes_Found'), MB_ICONWARNING or MB_OK); //kt added 8/8/2007 + BAFWarningShown := True; + end; + end; +end; + + +procedure TfrmBAOptionsDiagnoses.FormActivate(Sender: TObject); +begin + inherited; + InactiveICDNotification; +end; + +function TfrmBAOptionsDiagnoses.IsDXInList(ADXCode: string):boolean; +var + i: integer; + //x,y: string; +begin + Result := False; + for i := 0 to lbPersonalDx.Count-1 do + if ADXCode = Piece(lbPersonalDx.Items[i],U,1) then + begin + Result := True; + Break; + end; +end; + + +procedure TfrmBAOptionsDiagnoses.LoadPersonalDxList; +var + i: integer; + dxList: TStringList; + inActiveDx: string; +begin + dxList := TStringList.Create; + dxList.Clear; + dxList := rpcGetPersonalDxList(User.DUZ); + if dxList.Count > 0 then + begin + for i := 0 to dxList.Count -1 do + begin + if not UBACore.IsICD9CodeActive(Piece(dxList.Strings[i],U,1),'ICD',Encounter.DateTime ) then + begin + inActiveDx := Piece(dxList.Strings[i],U,1) + ' ' + BA_INACTIVE_CODE + U + Piece(DxList.Strings[i],U,2); + lbPersonalDx.Items.Add(inActiveDx); + end + else + lbPersonalDx.Items.Add(dxList.Strings[i]); + end; + end; +end; + +procedure TfrmBAOptionsDiagnoses.btnRemoveAllClick(Sender: TObject); +var + i: integer; + delDxCode: string; +begin + inherited; + // save dx seleted for deletion, update file when ok is pressed + for i := 0 to lbPersonalDX.Count-1 do + begin + delDxCode := Piece(lbPersonalDX.Items[i],U,1); + delDxLst.Add(delDxCode); + end; + + + // delete selected dx from listbox. + with lbPersonalDX do + begin + i := Items.Count - 1; + Items.BeginUpdate; + while (i >= 0) do + begin + Items.Delete(i); + Dec(i); + end; + Items.EndUpdate; + end; + + btnDelete.Enabled := False; + lbDiagnosis.ClearSelection; + if delDxLst.Count > 0 then btnOK.Enabled := True; +end; + +procedure TfrmBAOptionsDiagnoses.btnAddAllClick(Sender: TObject); +var + i : integer; + newDxCode: string; + +begin + inherited; + for i := 0 to lbDiagnosis.Items.Count-1 do + begin + newDxCode := Piece(lbDiagnosis.Items[i],U,2); + if (not IsDxInList(newDxCode) ) then + begin + if UBACore.IsICD9CodeActive(newDxCode,'ICD',Encounter.DateTime) then + begin + newDxLst.Add(newDxCode); + lbPersonalDx.Items.Add(Piece(lbDiagnosis.Items[i],U,2) + U + Piece(lbDiagnosis.Items[i],U,1) ) + end + else + InfoBox(BA_INACTIVE_ICD9_CODE_1 + Trim(Piece(newDxCode,'#',1)) + BA_INACTIVE_ICD9_CODE_2 , BA_INACTIVE_CODE, MB_ICONWARNING or MB_OK); + end; + end; + btnAdd.Enabled := False; + lbDiagnosis.ClearSelection; + if newDxLst.Count > 0 then btnOK.Enabled := True; + +end; + +procedure TfrmBAOptionsDiagnoses.hdrCntlDxSectionClick( + HeaderControl: THeaderControl; Section: THeaderSection); +begin + inherited; + lbPersonalDx.Sorted := false; + lbPersonalDx.Sorted := True; + lbPersonalDX.Repaint; +end; + +procedure TfrmBAOptionsDiagnoses.FormResize(Sender: TObject); +begin + inherited; + hdrCntlDxSections.Sections[0].Width := lbSections.Width; + hdrCntlDxAdd.Sections[0].Width := lbDiagnosis.Width; + hdrCntlDx.Sections[0].Width := lbPersonalDx.Width; +end; + +procedure TfrmBAOptionsDiagnoses.SyncDxDeleteList; +var + i: integer; + delDxCode: string; +begin +// save dx selected for deletion, update file when ok is pressed + for i := 0 to lbPersonalDX.Count-1 do + begin + if(lbPersonalDX.Selected[i]) then + begin + delDxCode := Piece(lbPersonalDX.Items[i],U,1); + delDxLst.Add(delDxCode); + end; + end; +end; + +procedure TfrmBAOptionsDiagnoses.SyncDxNewList; +var +i,j :integer; +begin + // remove diagnoses selected for deletion from newdxList; + for i := 0 to lbPersonalDX.Count-1 do + begin + if lbPersonalDX.Selected[i] then + begin + for j := 0 to newDxLst.Count-1 do + begin + if (Piece(lbPersonalDX.Items[i],U,1)) = (newDxLst.Strings[j]) then + begin + newDxLst.Delete(j); + Break; + end; + end; + end; + end; +end; + + +initialization + uAddToPDL := 0; + uDeleteFromPDL := 0; + + Problems := TStringList.Create; + DxList := TStringList.Create; + ECFDiagnoses := TStringList.Create; + uNewDxList := TStringList.Create; + tmplst := TStringList.Create; + newDxLst := TStringList.Create; + delDxLst := TStringList.Create; + + Problems.Clear; + DxList.Clear; + ECFDiagnoses.Clear; + uNewDxList.Clear; + tmplst.Clear; + newDxLst.Clear; + delDxLst.Clear; + +end. Index: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fConsult513Prt.pas =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Consults/fConsult513Prt.pas (revision 453) +++ cprs/branches/tmg-cprs/CPRS-Chart/Consults/fConsult513Prt.pas (revision 541) @@ -195,5 +195,5 @@ begin FReportText.Lines.Assign(GetFormattedSF513(FConsult, ChartCopy)); - PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg); + PrintWindowsReport(FReportText, PAGE_BREAK, Self.Caption, ErrMsg, Application); //kt 8/09, Added ',Application' if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TX_ERR_CAP, MB_OK); end; Index: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fPreReq.pas =================================================================== --- cprs/branches/tmg-cprs/CPRS-Chart/Consults/fPreReq.pas (revision 453) +++ cprs/branches/tmg-cprs/CPRS-Chart/Consults/fPreReq.pas (revision 541) @@ -167,5 +167,5 @@ end; until LastLine >= memReport.Lines.Count - 1; - PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg); + PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg, Application); //kt 8/09, Added ',Application' end; finally