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

BKMRMIM.m

Go to the documentation of this file.
  1. BKMRMIM ;PRXM/HC/ALA-HMS Immunization Reminders ; 13 Nov 2007 4:05 PM
  1. ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
  1. IZ01(GUI) ;EP - REM.IZ.01
  1. ; Pneumovax Due
  1. ; Due date = Today, if no Pneumovax vaccine (IZ.6) ever documented. OR
  1. ; Due date = Date of most recent Pneumovax vaccine + 1825 days or 5 years or 60 months).
  1. ; If "Now," then text = "Pneumovax immunization 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 CVXTAX^BKMIXX1(DFN,"BKM PNEUMO IZ CVX CODES","","","",.LAST)
  1. D ICDTAX^BKMIXX1(DFN,"BQI PNEUMO IZ DXS","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. D CPTTAX^BKMIXX(DFN,"BGP PNEUMO IZ CPTS","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. D PRCTAX^BKMIXX1(DFN,"BQI PNEUMO IZ PROCEDURES","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. I LAST'="" S DUE=+$$SCH^XLFDT("60M",LAST)
  1. I LAST="" S DUE=DT
  1. D ADDLINE^BKMVF32("25 REM.IZ.01",.LIST,"Pneumovax IZ",LAST,DUE)
  1. D WRITE("25 REM.IZ.01",GUI)
  1. Q
  1. ;
  1. IZ02(GUI) ;EP - REM.IZ.02
  1. ; Influenza IZ Due
  1. ; Due date = Today, if no Influenza vaccine (IZ.5) ever documented. OR
  1. ; Due date = Date of most recent Influenza vaccine + 365 days (or 12 months)
  1. ; If "Now," then text = "Influenza immunization 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 CVXTAX^BKMIXX1(DFN,"BGP FLU IZ CVX CODES","","","",.LAST)
  1. D ICDTAX^BKMIXX1(DFN,"BQI FLU IZ DXS","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. D CPTTAX^BKMIXX(DFN,"BGP CPT FLU","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. D PRCTAX^BKMIXX1(DFN,"BQI FLU IZ PROCEDURES","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. I LAST'="" S DUE=+$$SCH^XLFDT("12M",LAST)
  1. I LAST="" S DUE=DT
  1. D ADDLINE^BKMVF32("26 REM.IZ.02",.LIST,"Influenza IZ",LAST,DUE)
  1. D WRITE("26 REM.IZ.02",GUI)
  1. Q
  1. ;
  1. IZ03(GUI) ;EP - REM.IZ.03
  1. ; Hepatitis A IZ Due
  1. ; Due date = Today, if no Hepatitis A diagnosis (DX.5) POV or Problem list ever documented. OR
  1. ; Due date = Today, if no Hepatitis A immunization (IZ.3) ever documented.
  1. ; If "Now," then text = "Hepatitis A immunization may be due now. This patient has no documentation of either immunization for or diagnosis of Hepatitis A, and is considered at risk."
  1. NEW LASTTXT,LAST,DUE,LAST1,LIST
  1. S GUI=$G(GUI,0)
  1. S (LAST,DUE,LAST1,LASTTXT)=""
  1. D CVXTAX^BKMIXX1(DFN,"BKM HEP A IZ CVX CODES","","","",.LAST)
  1. D CPTTAX^BKMIXX(DFN,"BKM HEP A IZ CPTS","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. D ICDTAX^BKMIXX1(DFN,"BKM HEP A DXS","","","",.LAST1)
  1. I LAST1>LAST S LASTTXT=" (dx)"
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. D PRBTAX^BKMIXX(DFN,"BKM HEP A DXS","","","",.LAST1)
  1. I LAST1>LAST S LASTTXT=" (dx)"
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. I LAST="" S DUE=DT
  1. D ADDLINE^BKMVF32("24 REM.IZ.03",.LIST,"Hep A IZ",LAST,DUE,LASTTXT)
  1. D WRITE("24 REM.IZ.03",GUI)
  1. Q
  1. ;
  1. IZ04(GUI) ;EP - REM.IZ.04
  1. ; Hepatitis B IZ Due
  1. ; Due date = Today, if no Hepatitis B diagnosis (DX.15) POV or Problem list ever documented.
  1. ; Due date = Today, if no Hepatitis B immunization (IZ.4) ever documented.
  1. ; If "Now," then text = "Hepatitis B immunization may be due now. This patient has no documentation of either immunization for or diagnosis of Hepatitis B and is considered at risk."
  1. NEW LAST,DUE,LAST1,LASTTXT,LIST
  1. S GUI=$G(GUI,0)
  1. S (LAST,DUE,LAST1,LASTTXT)=""
  1. D CVXTAX^BKMIXX1(DFN,"BKM HEP B IZ CVX CODES","","","",.LAST)
  1. D CPTTAX^BKMIXX(DFN,"BKM HEP B IZ CPTS","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. D ICDTAX^BKMIXX1(DFN,"BKM HEP B DXS","","","",.LAST1)
  1. I LAST1>LAST S LASTTXT=" (dx)"
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. D PRBTAX^BKMIXX(DFN,"BKM HEP B DXS","","","",.LAST1)
  1. I LAST1>LAST S LASTTXT=" (dx)"
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. I LAST="" S DUE=DT
  1. D ADDLINE^BKMVF32("23 REM.IZ.04",.LIST,"Hep B IZ",LAST,DUE,LASTTXT)
  1. D WRITE("23 REM.IZ.04",GUI)
  1. Q
  1. ;
  1. IZ05(GUI) ;EP - REM.IZ.05
  1. ; Tetanus IZ Due
  1. ; Due date = Today, if no Tetanus immunization (IZ.7) ever documented.
  1. ; Due date = Date of most recent Tetanus immunization + 3650 days or 10 years or 120 months).
  1. ; If "Now," then text = "Tetanus immunization 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 CVXTAX^BKMIXX1(DFN,"BKM TETANUS IZ CVX CODES","","","",.LAST)
  1. D ICDTAX^BKMIXX1(DFN,"BKM TETANUS IZ DXS","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. D CPTTAX^BKMIXX(DFN,"BKM TETANUS IZ CPTS","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. D PRCTAX^BKMIXX1(DFN,"BKM TETANUS IZ PROCEDURES","","","",.LAST1)
  1. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
  1. ; $$SCH function won't accept values greater than 99, but we need to add 120.
  1. I LAST'="" S DUE=+$$SCH^XLFDT("60M",LAST),DUE=+$$SCH^XLFDT("60M",DUE)
  1. I LAST="" S DUE=DT
  1. D ADDLINE^BKMVF32("27 REM.IZ.05",.LIST,"Tetanus IZ",LAST,DUE)
  1. D WRITE("27 REM.IZ.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 $G(APCHNEXT)'="",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. I $G(BKMSUP) M REMLIST=LIST
  1. K APCHLAST,APCHNEXT,APCHSTEX,LIST
  1. Q