Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BKMRMLB

BKMRMLB.m

Go to the documentation of this file. 
  1. BKMRMLB ;PRXM/HC/ALA-HMS Lab Reminders ; 13 Nov 2007  4:04 PM
  1.  ;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
  1. CD4(GUI) ;EP - REM.T.01
  1.  ; CD4 Due
  1.  ; Due date = Today, if no CD4 test (T.2) documented ever.
  1.  ; Due date = Date of most recent CD4 test + 120 days (or 4 months).
  1.  ; If "Now," then text = "CD4 laboratory test may be due now; last documented [date]."
  1.  NEW LAST,DUE,LAST1,LIST
  1.  S GUI=$G(GUI,0)
  1.  S (LAST,DUE,LAST1)=""
  1.  D LABCODES^BKMVF32(DFN,"BGP CD4 TAX","BGP CD4 LOINC CODES","BGP CD4 CPTS","","",.LAST)
  1.  D LABCODES^BKMVF32(DFN,"BKMV CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES","BKMV CD4 ABS CPTS","","",.LAST1)
  1.  S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1.  I LAST'="" S DUE=+$$SCH^XLFDT("4M",LAST)
  1.  I LAST="" S DUE=DT
  1.  D ADDLINE^BKMVF32("1 REM.T.01",.LIST,"CD4",LAST,DUE)
  1.  D WRITE("1 REM.T.01",GUI)
  1.  Q
  1.  ;
  1. CHL(GUI) ;EP - REM.T.07
  1.  ; Chlamydia Test Due
  1.  ; Numerator: All patients 18 years of age and older
  1.  ; Due date = Today, if no Chlamydia test (T.3) ever documented OR
  1.  ; Due date = Today, if most recent test results for any of the following are positive
  1.  ;            since the most recent Chlamydia test and =<365 days from today:
  1.  ;            Gonorrhea (T.10); Syphilis (T.22) or (T.9). OR
  1.  ; Due date = Today, if patient has any of the following POV diagnoses
  1.  ;            since the most recent Chlamydia test and =<365 days from today:
  1.  ;            Gonorrhea (DX.4), Syphilis (DX.11), Trichomoniasis (DX.13) or other STD (DX.9) OR
  1.  ; Due date = Date of most recent positive Chlamydia test + 56 days (for retest after cure) OR
  1.  ; Due date = Date of most recent Chlamydia test + 365 days (or 12 months).
  1.  ; If "Now," then text = "Chlamydia test may be due now.  Please review your patient's recent and past history and consider ordering this test; last documented test was [date].
  1.  ; *** What happens if a Chlamydia test is done on Monday and a Gonorrhea (etc.) is found positive on Tuesday? When should the next Chlamydia be scheduled?
  1.  NEW LAST,DUE,PDATE,LAST1,LIST
  1.  S GUI=$G(GUI,0)
  1.  S (LAST,DUE,PDATE,LAST1)=""
  1.  I APCHSAGE'<18 D
  1.  . D LABCODES^BKMVF32(DFN,"BGP CHLAMYDIA TESTS TAX","BGP CHLAMYDIA LOINC CODES","BTPW CHLAMYDIA CPTS","BGP CHLAMYDIA TEST PROCEDURES","",.LAST,"","",.PDATE)
  1.  . I LAST'="" D
  1.  .. S DUE=+$$SCH^XLFDT("12M",LAST)
  1.  .. I PDATE'="" D
  1.  ... I PDATE'<LAST S DUE=$$FMADD^XLFDT(PDATE,56)
  1.  .. ; If any STD tests (except Chlamydia) are positive since the last Chlamydia test (or diagnoses found)
  1.  .. I $$STDS^BKMVF32(DFN,"CHLAMYDIA",LAST) S DUE=DT
  1.  . I LAST="" S DUE=DT
  1.  D ADDLINE^BKMVF32("20 REM.T.07",.LIST,"Chlamydia Test",LAST,DUE)
  1.  D WRITE("20 REM.T.07",GUI)
  1.  Q
  1.  ;
  1. SYPF(GUI) ;EP - REM.T.04
  1.  ; FTA-ABS (Syphilis) Due 
  1.  ; Numerator:  Patients with a positive RPR laboratory value (T.22) (defined as positive, 
  1.  ;             reactive, indeterminate or any number values) and no FTA-ABS (T.9) documented 
  1.  ;             after the date of the positive RPR
  1.  ; Due date = Date of the most recent positive RPR laboratory test + 14 days.
  1.  ; If "Now," then text = "An FTA-ABS Syphilis test is strongly recommended at this time because your patient had a positive RPR test documented on [date]."
  1.  NEW LAST,DUE,PDATE,ODATE,LIST
  1.  S GUI=$G(GUI,0)
  1.  S (LAST,DUE,PDATE,ODATE)=""
  1.  D LABCODES^BKMVF32(DFN,"BKM RPR TAX","BKM RPR LOINC CODES","BKM RPR CPTS","","","","","",.PDATE,.PR,"","",.ODATE,.OR,"$$UP^XLFSTR(RESULT)[""INDETERMINATE""!(RESULT?0.N0.1"".""1.N&(RESULT'=0))")
  1.  S PDATE=$S(PDATE>ODATE:PDATE,1:ODATE)
  1.  I PDATE'="" D
  1.  . D LABCODES^BKMVF32(DFN,"BKM FTA-ABS TEST TAX","BKM FTA-ABS LOINC CODES","BKM FTA-ABS CPTS","",PDATE,"",.LAST)
  1.  . I LAST="" S DUE=$$FMADD^XLFDT(PDATE,14)
  1.  D ADDLINE^BKMVF32("13 REM.T.04",.LIST,"FTA/ABS Syphilis Test",LAST,DUE)
  1.  D WRITE("13 REM.T.04",GUI)
  1.  Q
  1.  ;
  1. GON(GUI) ;EP - REM.T.08
  1.  ; Gonorrhea Test Due
  1.  ; Numerator:  All patients 18 years of age and older.
  1.  ; Due date = Today, if no Gonorrhea test (T.10) ever documented. OR
  1.  ; Due date = Today, if most recent test results for any of the following are positive
  1.  ;            since the most recent Gonorrhea test and =<365 days from today:
  1.  ;            Chlamydia (T.3); Syphilis (T.22) or (T.9). OR
  1.  ; Due date = Today, if patient has any of the following POV diagnoses
  1.  ;            since the most recent Gonorrhea test and =<365 days from today:
  1.  ;            Chlamydia (DX.2), Syphilis (DX.11), Trichomoniasis (DX.13) or other STD (DX.9) OR
  1.  ; Due date = Date of most recent Gonorrhea test + 365 days (or 12 months).
  1.  ; If "Now," then text = "Gonorrhea test may be due now.  Please review your patient's recent and past history and consider ordering this test; last documented test was [date]."
  1.  NEW LAST,DUE,BDATE
  1.  S (LAST,DUE)=""
  1.  I $G(BDATE)="" S BDATE=DT
  1.  I APCHSAGE'<18 D
  1.  . D LABCODES^BKMVF32(DFN,"BKM GONORRHEA TEST TAX","BKM GONORRHEA LOINC CODES","BKM GONORRHEA TESTS CPTS","","",.LAST)
  1.  . I LAST'="" D
  1.  . . S DUE=+$$SCH^XLFDT("12M",LAST)
  1.  . . ; If any STD tests (except Gonorrhea) are positive since the last Gonorrhea test (or diagnoses found)
  1.  . . I $$STDS^BKMVF32(DFN,"GONORRHEA",LAST) S DUE=BDATE
  1.  . I LAST="" S DUE=BDATE
  1.  D ADDLINE^BKMVF32("21 REM.T.08",.LIST,"Gonorrhea Test",LAST,DUE)
  1.  D WRITE("21 REM.T.08",GUI)
  1.  Q
  1.  ;
  1. HEPBR(GUI) ;EP - REM.T.13
  1.  ; Hepatitis B Retest Due
  1.  ; Numerator: All patients with 3 documented Hepatitis B immunizations (IZ.4) and no 
  1.  ;            Hepatitis B test (T.27) documented after the final immunization
  1.  ; Due date = Today
  1.  ; If "Now," then text = "Hepatitis B retest may be indicated at this time to ensure adequate coverage since this patient has completed all 3 Hepatitis B immunizations; last documented immunization was given on [date]."
  1.  NEW LAST,DUE,LAST1,VISIT,CNT,BDATE
  1.  S (LAST,DUE,LAST1,VISIT)="",CNT=0 K TEMP
  1.  I $G(BDATE)="" S BDATE=DT
  1.  D CVXTAX^BKMIXX1(DFN,"BKM HEP B IZ CVX CODES","","","TEMP(VISIT)",.LAST)
  1.  D CPTTAX^BKMIXX(DFN,"BKM HEP B IZ CPTS","","","TEMP(VISIT)",.LAST1)
  1.  S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1.  F  S VISIT=$O(TEMP(VISIT)) Q:'VISIT  S CNT=CNT+1
  1.  I CNT<3 S LAST=""
  1.  I CNT'<3 D
  1.  . S LAST1=""
  1.  . D LABCODES^BKMVF32(DFN,"BKM HEP B TAX","BKM HEP B LOINC CODES","BKM HEP B TESTS CPTS","",LAST,.LAST1)
  1.  . I LAST1'="" S LAST="" Q
  1.  . S DUE=BDATE,LAST=LAST1
  1.  D ADDLINE^BKMVF32("17 REM.T.13",.LIST,"Hep B Retest",LAST,DUE)
  1.  D WRITE("17 REM.T.13",GUI)
  1.  Q
  1.  ;
  1. HEPB(GUI) ;EP - REM.T.12
  1.  ; Hepatitis B Test Due
  1.  ; Numerator: Any patient with no Hepatitis B (DX.15) diagnosis (POV or problem list) ever AND 
  1.  ;            no Hepatitis B test results (T.27) ever documented.
  1.  ; Due date = Today
  1.  ; If "Now," then text = "This patient may benefit from a Hepatitis B Test."
  1.  NEW LAST,DUE,BDATE
  1.  S (LAST,DUE)=""
  1.  I $G(BDATE)="" S BDATE=DT
  1.  D
  1.  . D ICDTAX^BKMIXX1(DFN,"BKM HEP B DXS","","","",.LAST)
  1.  . I LAST'="" Q
  1.  . D PRBTAX^BKMIXX(DFN,"BKM HEP B DXS","","","",.LAST)
  1.  . I LAST'="" Q
  1.  . D LABCODES^BKMVF32(DFN,"BKM HEP B TAX","BKM HEP B LOINC CODES","BKM HEP B TESTS CPTS","","",.LAST)
  1.  . I LAST'="" Q
  1.  . S DUE=BDATE
  1.  D ADDLINE^BKMVF32("16 REM.T.12",.LIST,"Hep B Test",LAST,DUE)
  1.  D WRITE("16 REM.T.12",GUI)
  1.  Q
  1.  ;
  1. HEPCE(GUI) ;EP - REM.T.09
  1.  ; Hepatitis C EIA Test Due
  1.  ; Numerator: Any patient with no Hepatitis C (DX.16) diagnosis (POV or problem list) ever documented. 
  1.  ; Due date = Today, if no Hepatitis C EIA (T.13) or Hepatitis C RIBA (T.14) ever documented  OR
  1.  ; Due date = if no documented Hepatitis C EIA (T.13) test but a Hepatitis C confirmation test (T.14) is documented, date of most recent confirmation test + 365 days (1 year) OR
  1.  ; Due date = if most recent EIA test is not positive, date of most recent, not positive Hepatitis C EIA test + 365 days (or 12 months)  OR
  1.  ; Due date = if most recent EIA test is positive followed by a negative Hepatitis C RIBA test, date of EIA test +365 days (or 12 months).
  1.  ; If most recent EIA test is positive AND is not followed by documented Hep C confirmation test, then go to REM.T.14
  1.  ; If "Now," then text = "This patient may be due for a Hepatitis C testing; last documented [date]."
  1.  NEW SKIP,LAST,DUE,LAST1,EPDATE,ENDATE,RLAST,RNDATE,BDATE
  1.  ; If set to 1, skip this reminder and continue with REM.T.14
  1.  S SKIP=""
  1.  S (LAST,DUE,LAST1,EPDATE,ENDATE,RLAST,RNDATE)=""
  1.  I $G(BDATE)="" S BDATE=DT
  1.  D
  1.  . D ICDTAX^BKMIXX1(DFN,"BKM HEP C DXS","","","",.LAST1)
  1.  . I LAST1'="" Q
  1.  . D PRBTAX^BKMIXX(DFN,"BKM HEP C DXS","","","",.LAST1)
  1.  . I LAST1'="" Q
  1.  . ; Check for T.13
  1.  . D LABCODES^BKMVF32(DFN,"BKM HEP C SCREENING TAX","BKM HEP C SCREEN LOINC CODES","BKM HEP C SCREEN TESTS CPTS","","","",.LAST,"",.EPDATE,"",.ENDATE)
  1.  . ; Check for T.14
  1.  . D LABCODES^BKMVF32(DFN,"BKM HEP C CONFIRMATORY TAX","BKM HEP C CONFIRM LOINC CODES","BKM HEP C CONFIRM TESTS CPTS","","","",.RLAST,"","","",.RNDATE)
  1.  . ; If no test found for either HEP C EIA or HEP C RIBA
  1.  . I LAST="",RLAST="" S DUE=BDATE Q
  1.  . I LAST="",RLAST]"" S DUE=+$$SCH^XLFDT("12M",RLAST) Q
  1.  . I ENDATE'="",EPDATE'=LAST S DUE=+$$SCH^XLFDT("12M",LAST) Q
  1.  . ;I ENDATE'="",EPDATE'=LAST S DUE=+$$SCH^XLFDT("12M",ENDATE) Q
  1.  . I EPDATE'="",EPDATE=LAST,RNDATE'="",RNDATE>EPDATE S DUE=+$$SCH^XLFDT("12M",EPDATE)
  1.  . I EPDATE'="",EPDATE=LAST,RNDATE'>EPDATE S SKIP=1
  1.  ;. I LAST="",RLAST="" S DUE=BDATE
  1.  ;. ELSE  D
  1.  ;. . I ENDATE'="",ENDATE=LAST S DUE=+$$SCH^XLFDT("12M",ENDATE) Q
  1.  ;. . I EPDATE'="",EPDATE=LAST,RNDATE'="",RNDATE>EPDATE S DUE=+$$SCH^XLFDT("12M",EPDATE)
  1.  I 'SKIP D ADDLINE^BKMVF32("14 REM.T.09",.LIST,"Hep C EIA Test",LAST,DUE)
  1.  D WRITE("14 REM.T.09",GUI)
  1.  Q
  1.  ;
  1. HEPCR(GUI) ;EP - REM.T.14
  1.  ; Hepatitis C RIBA Test Due
  1.  ; Numerator: Patients with no Hepatitis C (DX.16) diagnosis (POV or problem list) and positive 
  1.  ;            Hepatitis C EIA test (T.13) and no documented Hepatitis C RIBA test (T.14) 
  1.  ;            occurring after EIA test date.
  1.  ; Due date = Today
  1.  ; If "Now," then text = "A Hepatitis C RIBA test is indicated because your patient had a positive Hepatitis C EIA test result documented on [date]."
  1.  NEW LAST,DUE,EPDATE,LAST1,BDATE
  1.  S (LAST,DUE,EPDATE,LAST1)=""
  1.  I $G(BDATE)="" S BDATE=DT
  1.  D
  1.  . D ICDTAX^BKMIXX1(DFN,"BKM HEP C DXS","","","",.LAST1)
  1.  . I LAST1'="" Q
  1.  . D PRBTAX^BKMIXX(DFN,"BKM HEP C DXS","","","",.LAST1)
  1.  . I LAST1'="" Q
  1.  . ; Check for T.13
  1.  . D LABCODES^BKMVF32(DFN,"BKM HEP C SCREENING TAX","BKM HEP C SCREEN LOINC CODES","BKM HEP C SCREEN TESTS CPTS","","","","","",.EPDATE)
  1.  . I EPDATE="" Q
  1.  . ; Check for T.14
  1.  . D LABCODES^BKMVF32(DFN,"BKM HEP C CONFIRMATORY TAX","BKM HEP C CONFIRM LOINC CODES","BKM HEP C CONFIRM TESTS CPTS","",EPDATE,.LAST1)
  1.  . I LAST1'="" Q
  1.  . S DUE=BDATE
  1.  D ADDLINE^BKMVF32("15 REM.T.14",.LIST,"Hep C Confirm",LAST,DUE)
  1.  D WRITE("15 REM.T.14",GUI)
  1.  Q
  1.  ;
  1. PPD(GUI) ;EP - REM.T.05
  1.  ; PPD Due
  1.  ; Numerator: Patients with:
  1.  ;   1) No TB DX (DX.14) ever
  1.  ;   2) No positive PPD results (T.21) ever (positive result or no result but PPD reading >=5 mm) 
  1.  ;   3) No TB treatment (M.08) ever
  1.  ; Due date = Today, if PPD (T.21) never documented OR
  1.  ; Due date = Date of most recent PPD + 365 days (or 12 months)
  1.  ; If "Now," then text = "PPD skin test may be due now; last documented [date]."
  1.  NEW LAST,DUE,LAST1,LRESULT,PR,OR,BDATE
  1.  S (LAST,DUE,LAST1,LRESULT,PR,OR)=""
  1.  I $G(BDATE)="" S BDATE=DT
  1.  D
  1.  . D ICDTAX^BKMIXX1(DFN,"DM AUDIT PROBLEM TB DXS","","","",.LAST1)
  1.  . I LAST1'="" Q  ; Exclude patient with a TB DX
  1.  . D NDCTAX^BKMIXX1(DFN,"BKM TB MED NDCS","","","",.LAST1)
  1.  . I LAST1'="" Q  ; Exclude patient with TB treatment
  1.  . D MEDTAX^BKMIXX(DFN,"BKM TB MEDS","","","",.LAST1)
  1.  . I LAST1'="" Q  ; Exclude patient with TB treatment
  1.  . D LABCODES^BKMVF32(DFN,"BKM PPD TAX","BKM PPD LOINC CODES","BKM PPD CPTS","BKM PPD ICDS","","",.LAST,.LRESULT,"",.PR,"","","",.OR,"RESULT'<5")
  1.  . I PR'=""!(OR'="") S LAST="" Q  ; Positive Result or PPD >= 5 mm
  1.  . ; If patient had no PPD T.21 in Labs, also check Skin Tests and Immunizations.
  1.  . K PPDTEST
  1.  . S TARGET="PPDTEST(""SKN"",VSTDT,TEST)"
  1.  . D SKNTAX^BKMIXX1(DFN,"21","","",TARGET,.LAST1)
  1.  . S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1.  . S TARGET="PPDTEST(""CVX"",VSTDT,TEST)"
  1.  . D CVXTAX^BKMIXX1(DFN,"BKM PPD CVX CODES","","",TARGET,.LAST1)
  1.  . S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1.  . I LAST="" S DUE=BDATE Q  ;If never had PPD T.21
  1.  . N PPDPOS
  1.  . S PPD="PPDTEST",PPDPOS=""
  1.  . F  S PPD=$Q(@PPD) Q:PPD=""  D  Q:PPDPOS
  1.  .. ; For Skin test use result (2nd piece) if present, if not use reading (1st piece)
  1.  .. I $P(PPD,",")="PPDTEST(""SKN""" D  Q
  1.  ... I $P(@PPD,U,2)]"" S PPDPOS=$$POSITIVE^BKMVF32($P(@PPD,U,2)) Q
  1.  ... I +@PPD'<5 S PPDPOS=1 Q
  1.  .. I $$POSITIVE^BKMVF32(@PPD)!(@PPD'<5) S PPDPOS=1 Q
  1.  . I PPDPOS S LAST="" Q  ; PPD is positive or >= 5 mm
  1.  . S DUE=+$$SCH^XLFDT("12M",LAST)
  1.  D ADDLINE^BKMVF32("11 REM.T.05",.LIST,"PPD Skin Test",LAST,DUE)
  1.  D WRITE("11 REM.T.05",GUI)
  1.  Q
  1.  ;
  1. WRITE(REM,GUI) ;  Write out the reminder
  1.  S APCHLAST=$G(LIST(REM,1,"LAST"))
  1.  I APCHLAST="" S APCHSTEX(1)="MAY BE DUE NOW"
  1.  S APCHNEXT=$G(LIST(REM,1,"DUE"))
  1.  I APCHNEXT>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)
  1.  I APCHNEXT'>DT S APCHSTEX(1)="MAY BE DUE NOW (WAS DUE "_$$DATE^APCHSMU(APCHNEXT)_")"
  1.  I 'GUI D WRITE^APCHSMU
  1.  I GUI S REMLAST=APCHLAST,REMNEXT=$G(APCHSTEX(1)),REMDUE=APCHNEXT
  1.  K APCHLAST,APCHNEXT,APCHSTEX,LIST
  1.  Q