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

BKMRMLB1.m

Go to the documentation of this file. 
  1. BKMRMLB1 ;PRXM/HC/ALA-HMS Lab Reminders continued ; 13 Nov 2007  4:32 PM
  1.  ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1. TOX(GUI) ;EP - REM.T.11
  1.  ; Toxoplasmosis
  1.  ; Numerator: All patients with no history of positive Toxoplasmosis test (T.28)
  1.  ; Due date = Today, if no Toxoplasmosis test (T.28) ever documented. OR                  
  1.  ; Due date = Date of most recent Toxoplasmosis test + 365 days (or 12 months).
  1.  ; If "Now," then text = "A Toxoplasmosis test may be due now; last documented [date]."
  1.  NEW LAST,DUE,PDATE,BDATE
  1.  S (LAST,DUE,PDATE)=""
  1.  I $G(BDATE)="" S BDATE=DT
  1.  D LABCODES^BKMVF32(DFN,"BKM TOXOPLASMOSIS TESTS TAX","BKM TOXOPLASMOSIS LOINC CODES","BKM TOXOPLASMOSIS CPTS","","",.LAST,"","",.PDATE)
  1.  I PDATE="" D
  1.  . I LAST="" S DUE=BDATE Q
  1.  . I LAST'="" S DUE=+$$SCH^XLFDT("12M",LAST)
  1.  I PDATE'="" S LAST=""
  1.  D ADDLINE^BKMVF32("18 REM.T.11",.LIST,"Toxoplasmosis Test",LAST,DUE)
  1.  D WRITE("18 REM.T.11",GUI)
  1.  Q
  1.  ;
  1. VIR(GUI) ; REM.T.02
  1.  ; Viral Load Due
  1.  ; Due date = Today, if no Viral Load Test (T.26) ever documented.  OR
  1.  ; Due date = Most recent Viral Load Test + 120 days (or 4 months).
  1.  ; If "Now," then text = "A Viral Load test may be due now; last documented [date]."
  1.  NEW LAST,DUE,BDATE
  1.  S (LAST,DUE)=""
  1.  I $G(BDATE)="" S BDATE=DT
  1.  D LABCODES^BKMVF32(DFN,"BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES","BGP HIV VIRAL LOAD CPTS","","",.LAST)
  1.  I LAST="" S DUE=BDATE
  1.  I LAST'="" D
  1.  . S DUE=+$$SCH^XLFDT("4M",LAST)
  1.  D ADDLINE^BKMVF32("10 REM.T.02",.LIST,"Viral Load",LAST,DUE)
  1.  D WRITE("10 REM.T.02",GUI)
  1.  Q
  1.  ;
  1. SYPR(GUI) ;EP - REM.T.03
  1.  ; RPR (Syphilis) Due
  1.  ; Due date = Today, if no RPR (T.22) or FTA-ABS (T.9) tests ever documented. OR
  1.  ; Due date = Date of last FTA-ABS (T.9) test + 365 days (or 12 months) if no RPR (T.22) ever documented. OR
  1.  ; Due date = RPR test date + 90 days (or 3 months)
  1.  ;            if most recent RPR is positive and =<365 days from today. OR
  1.  ; Due date = Today, if most recent RPR is not positive (negative or undetermined)
  1.  ;            AND if most recent test results for any of the following are positive
  1.  ;            since the most recent RPR test and =<365 days from today:
  1.  ;            Gonorrhea (T.10); Chlamydia (T.3). OR
  1.  ; Due date = Today, if most recent RPR is not positive (negative or undetermined)
  1.  ;            AND if patient has any of the following POV diagnoses
  1.  ;            since the most recent RPR test and =<365 days from today:
  1.  ;            Gonorrhea (DX.4), Chlamydia (DX.2), Trichomoniasis (DX.13) or other STD (DX.9) OR
  1.  ; Due date = Date of last RPR + 365 days (or 12 months)
  1.  ; If "Now," then text = "An RPR Syphilis test may be due.  Please review your patient's history; last documented [date]."
  1.  NEW LAST,DUE,LAST1,LAST2,MLAST,DIFF,PDATE,BDATE
  1.  S (LAST,DUE,LAST1,LAST2,MLAST,DIFF,PDATE)=""
  1.  I $G(BDATE)="" S BDATE=DT
  1.  D LABCODES^BKMVF32(DFN,"BKM FTA-ABS TEST TAX","BKM FTA-ABS LOINC CODES","BKM FTA-ABS CPTS","","",.LAST)
  1.  D LABCODES^BKMVF32(DFN,"BKM RPR TAX","BKM RPR LOINC CODES","BKM RPR CPTS","","",.LAST1,"","",.PDATE)
  1.  ; If no tests found
  1.  I LAST="",LAST1="" S DUE=BDATE
  1.  ; If FTA-ABS tests (but no RPR tests) found
  1.  I LAST'="",LAST1="" S DUE=+$$SCH^XLFDT("12M",LAST)
  1.  ; If RPR tests found
  1.  I LAST1'=""  D
  1.  . ; If last RPR test result was positive and within the year
  1.  . I PDATE=LAST1,$$FMDIFF^XLFDT(BDATE,PDATE)'>365 S DUE=+$$SCH^XLFDT("3M",PDATE) Q
  1.  . ; If last RPR test result is not positive but if any STD tests (except Syphilis) are positive (or diagnoses found)
  1.  . I PDATE<LAST1,$$STDS^BKMVF32(DFN,"SYPHILIS",LAST1) S DUE=BDATE Q
  1.  . ; Otherwise, due date is 12 months from last RPR test
  1.  . S DUE=+$$SCH^XLFDT("12M",LAST1)
  1.  D ADDLINE^BKMVF32("12 REM.T.03",.LIST,"RPR Syphilis Test",LAST1,DUE)
  1.  D WRITE("12 REM.T.03",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