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

BISITE2.m

Go to the documentation of this file. 
  1. BISITE2 ;IHS/CMI/MWR - EDIT SITE PARAMETERS; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**8**;MAR 15,2014
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  EDIT SITE PARAMETERS.
  1.  ;;  PATCH 1: Update text to relect DTap change in Option 1,
  1.  ;;           and allow for Option 11.  RULES+9 and TEXT-4.
  1.  ;;  PATCH 2: Update prompts and help text for HPV.  RULES+41, TEXT9+15
  1.  ;;  PATCH 5: Update help text for HPV.  TEXT8+8
  1.  ;;  PATCH 8: Changes to accommodate new TCH Forecaster   MINAGE+12, RULES+6
  1.  ;
  1.  ;
  1.  ;----------
  1. CMGR ;EP
  1.  ;---> Select Default Case Manager.
  1.  ;---> Called by Protocol BI SITE CASE MANAGER.
  1.  ;
  1.  Q:$$BISITE
  1.  D FULL^VALM1,TITLE^BIUTL5("DEFAULT CASE MANAGER"),TEXT1
  1.  D DIE^BIFMAN(9002084.02,".02",BISITE)
  1.  D RESET^BISITE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT1 ;EP
  1.  ;;The Default Case Manager is the Case Manager who will be
  1.  ;;presented automatically at all Case Manager prompts, such as
  1.  ;;when you are adding a new patient.
  1.  ;;
  1.  ;;
  1.  D PRINTX("TEXT1")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. OTHER ;EP
  1.  ;---> Select Other Location.
  1.  ;---> Called by Protocol BI SITE OTHER LOCATION.
  1.  ;
  1.  Q:$$BISITE
  1.  D FULL^VALM1,TITLE^BIUTL5("OTHER LOCATION"),TEXT2
  1.  D DIE^BIFMAN(9002084.02,".03",BISITE)
  1.  D RESET^BISITE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT2 ;EP
  1.  ;;The Other Location is an entry in the IHS LOCATION file
  1.  ;;that will serve as the Location for a PCC Visit when the
  1.  ;;actual location is not in the LOCATION File.
  1.  ;;
  1.  ;;
  1.  D PRINTX("TEXT2")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DUELET ;EP
  1.  ;---> Select Immunizations Due Letter.
  1.  ;---> Called by Protocol BI SITE DUE LETTER.
  1.  ;
  1.  Q:$$BISITE
  1.  D FULL^VALM1,TITLE^BIUTL5("IMMUNIZATIONS DUE LETTER"),TEXT3
  1.  D DIE^BIFMAN(9002084.02,".04",BISITE)
  1.  D RESET^BISITE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT3 ;EP
  1.  ;;The Immunizations Due Letter is the form letter that is sent to
  1.  ;;patients or their parents, listing their Immunization History and
  1.  ;;informing them of which immunizations are due next.  It may also
  1.  ;;contain information about where and when to receive the next
  1.  ;;immunizations.
  1.  ;;
  1.  ;;The letter selected here will be presented as the default letter
  1.  ;;to use when printing Due Letters.
  1.  ;;
  1.  ;;In order to select the letter for this Site Parameter, it must
  1.  ;;already have been created.  To create the Standard Due Letter,
  1.  ;;select LET under the Manager Menu (MGR-->LET).  Create a new letter
  1.  ;;named "Standard Due Letter," and then return to this site parameter
  1.  ;;to choose it.
  1.  ;;
  1.  D PRINTX("TEXT3")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. REPHDR ;EP
  1.  ;---> Edit Report Header.
  1.  ;---> Called by Protocol BI SITE REPORT HEADER
  1.  ;
  1.  Q:$$BISITE
  1.  D FULL^VALM1,TITLE^BIUTL5("REPORT & SCREEN HEADER"),TEXT4
  1.  N BIDFLT,DIR,DIRUT,Y
  1.  S DIR(0)="FOA",DIR("A")="     Enter the Report/Screen Header: "
  1.  S DIR("B")=$$REPHDR^BIUTL6(BISITE)
  1.  S DIR("?")="     Enter the site name as you would like it to appear"
  1.  D ^DIR
  1.  S:Y="" Y="@"
  1.  ;
  1.  ;---> CodeChange for v7.1 - IHS/CMI/MWR 12/01/2000:
  1.  ;---> Next line missing negation.
  1.  ;D:$D(DUOUT) DIE^BIFMAN(9002084.02,".06///"_Y,BISITE)
  1.  D:'$D(DUOUT) DIE^BIFMAN(9002084.02,".06///"_Y,BISITE)
  1.  ;
  1.  D RESET^BISITE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT4 ;EP
  1.  ;;The Report/Screen Header is the name of your site or institution
  1.  ;;as you would like it to appear at the top of various reports and
  1.  ;;screens throughout this software.
  1.  ;;
  1.  ;;(This may be the same as the Site Name that appears on some
  1.  ;;of screens, however, that name is often an abbreviated
  1.  ;;form of the actual site name.)
  1.  ;;
  1.  ;;Please enter the name of your facility as you would like it
  1.  ;;to appear at the top of reports and screens in this software.
  1.  ;;
  1.  D PRINTX("TEXT4")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HFSPATH ;EP
  1.  ;---> Edit Host File Server path.
  1.  ;---> Called by Protocol BI SITE HFS PATH
  1.  ;
  1.  Q:$$BISITE  N BIPOP S BIPOP=0
  1.  F  D  Q:$G(BIPOP)
  1.  .D FULL^VALM1,TITLE^BIUTL5("HOST FILE SERVER PATH"),TEXT5
  1.  .N BIFLD,BIERR,BIDFLT,BIZ,DIR,DIRUT,X,Y S BIZ=0
  1.  .;
  1.  .S DIR(0)="FOA^1:30",DIR("A")="     Please enter the Host File Path: "
  1.  .S DIR("B")=$$HFSPATH^BIUTL8(BISITE)
  1.  .S DIR("?")="     Enter the full path name of the Host File directory"
  1.  .D ^DIR
  1.  .I $D(DIRUT) S BIPOP=1 Q
  1.  .D:Y'="@" CHKSLASH(.Y,.BIZ,.BIPOP)
  1.  .Q:(BIZ=1!($G(BIPOP)))
  1.  .;D DIE^BIFMAN(9002084.02,".14////"_Y,BISITE) S BIPOP=1
  1.  .S BIFLD(.14)=Y D FDIE^BIFMAN(9002084.02,+BISITE,.BIFLD,.BIERR) S BIPOP=1
  1.  ;
  1.  D RESET^BISITE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. CHKSLASH(Y,Z,BIPOP) ;EP
  1.  ;---> Make sure there is a final slash in the path name.
  1.  ;---> Parameters:
  1.  ;     1 - Y  (req) File Path submitted for verification.
  1.  ;     2 - Z  (ret) Z=1 if path contains both "/" and "\" or other error.
  1.  ;     3 - BIPOP (ret) =1 if user ^-out.
  1.  ;
  1.  I Y["/"&(Y["\") D  S Z=1 Q
  1.  .W !!?5,"Path may not contain both ""/"" and ""\""."
  1.  .D DIRZ^BIUTL3()
  1.  ;---> Get rid of any quotes.
  1.  S Y=$TR(Y,"""","")
  1.  ;
  1.  D
  1.  .N X S X=$$VERSION^%ZOSV(1)
  1.  .;
  1.  .;---> Ensure Windows path contains drive & root path.
  1.  .I (X["Windows")&(Y'[":\") D  S Z=1  Q
  1.  ..W !!?5,"Path must contain a drive specification (e.g., C:\path...)."
  1.  ..D DIRZ^BIUTL3(.BIPOP)
  1.  .;
  1.  .;---> Ensure path terminates with appropriate slash.
  1.  .I (X["Windows")!(Y["\") D  Q
  1.  ..I $E(Y,$L(Y))'="\" S Y=Y_"\" Q
  1.  .;
  1.  .I (X["Linux")!(X["UNIX")!(Y["/") D  Q
  1.  ..I $E(Y,$L(Y))'="/" S Y=Y_"/" Q
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT5 ;EP
  1.  ;;The Host File Server Path is the directory on the Host File Server
  1.  ;;where files to be imported and exported are stored.
  1.  ;;
  1.  ;;Include ALL necessary slashes in the path name (everything except
  1.  ;;the filename itself).
  1.  ;;
  1.  ;;Examples would be: C:\TEMP\ (on a Windows PC)
  1.  ;;               or  /usr/local/ (in unix/AIX)
  1.  ;;
  1.  ;;
  1.  D PRINTX("TEXT5")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. MINDAYS ;EP
  1.  ;---> Edit the default Minimum Number of days since last letter sent.
  1.  ;---> Called by Protocol BI SITE MIN DAYS LAST LET.
  1.  ;
  1.  Q:$$BISITE
  1.  D FULL^VALM1,TITLE^BIUTL5("EDIT MINIMUM DAYS LAST LETTER"),TEXT6
  1.  N BIDFLT,DIR,DIRUT,Y
  1.  S DIR(0)="NOA^0:9999:0"
  1.  S DIR("A")="     Number of days: "
  1.  S DIR("B")=$$MINDAYS^BIUTL2(BISITE)
  1.  D ^DIR
  1.  D:'$D(DUOUT) DIE^BIFMAN(9002084.02,".05///"_+Y,BISITE)
  1.  D RESET^BISITE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT6 ;EP
  1.  ;;The Minimum Days Last Letter is the least number of days that must
  1.  ;;pass--after a letter is sent to a patient--before the software
  1.  ;;will automatically send another letter to that same patient.
  1.  ;;(This pertains only to the printing of letters.)
  1.  ;;
  1.  ;;For example, if a patient received a letter 2 weeks ago and
  1.  ;;the Minimum Days Last Letter is 60, then the software will not
  1.  ;;generate a letter for that patient today, even if the patient
  1.  ;;is due for immunizations.
  1.  ;;
  1.  ;;This Site Parameter sets only the DEFAULT Minimum Days Last Letter--
  1.  ;;the Case Manager always has the option to change it when printing
  1.  ;;Due Letters.
  1.  ;;
  1.  ;;Please enter the default Minimum number Days since Last Letter.
  1.  ;;
  1.  D PRINTX("TEXT6")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. MINAGE ;EP
  1.  ;---> Edit the parameter directing the ImmServe Forecast to return
  1.  ;---> Immunization Due dates for either the Minimum Acceptable Age
  1.  ;---> or the Recommended Age.
  1.  ;---> Called by Protocol BI SITE FORC MIN VS RECOMM
  1.  ;
  1.  Q:$$BISITE
  1.  D FULL^VALM1,TITLE^BIUTL5("SELECT MINIMUM VS RECOMMENDED AGE"),TEXT7
  1.  N BIDFLT,DIR,DIRUT,Y
  1.  S DIR(0)="SOA^M:Minimum;R:Recommended"
  1.  S DIR("A")="     Please select either MINIMUM or RECOMMENDED: "
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Change parameter prompt to default recommended.
  1.  S DIR("B")=$S($$MINAGE^BIUTL2(BISITE)=1:"Minimum",1:"Recommended")
  1.  ;**********
  1.  D ^DIR
  1.  S:Y="M" Y="A"
  1.  D:'$D(DIRUT) DIE^BIFMAN(9002084.02,".07///"_Y,BISITE)
  1.  D RESET^BISITE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT7 ;EP
  1.  ;;
  1.  ;;The Minimum vs Recommended Age parameter allows you to direct the
  1.  ;;Forecasting program to forecast Immunizations due at either the
  1.  ;;Minimum Acceptable Patient Age or at the Recommended Age.
  1.  ;;
  1.  D PRINTX("TEXT7")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. RULES ;EP
  1.  ;---> Edit the parameter directing which version of Forecasting
  1.  ;---> Rules should be used by ImmServe.
  1.  ;---> Called by Protocol BI SITE FORC RULES
  1.  ;
  1.  Q:$$BISITE
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Change parameter prompt to just Grace Period.
  1.  ;D FULL^VALM1,TITLE^BIUTL5("SELECT FORECASTING OPTIONS",1),TEXT8
  1.  N BIDFLT,BIPOP,DIR,DIRUT,X,Y
  1.  ;
  1.  ;---> For a new set of Immserve Rules, change here below and $$VALIDRUL^BIUTL2.
  1.  ;S DIR(0)="NOA^1,2,3,4,5,6,7,11"
  1.  ;S DIR("?")="     Enter a number from the left column to choose one of the Options."
  1.  ;S DIR("A")="     Select Forecasting Option: "
  1.  ;S Y=$P($G(^BISITE(BISITE,0)),U,8)
  1.  ;S:'Y Y=1 S DIR("B")=+Y
  1.  ;D ^DIR
  1.  ;---> For a new set of Immserve Rules, change here below and $$VALIDRUL^BIUTL2.
  1.  ;I (Y>7)&(Y<11) D  G RULES
  1.  ;.W !!?8,Y," is not a valid Option.  Please choose again."
  1.  ;.D DIRZ^BIUTL3(.BIPOP)
  1.  ;
  1.  ;D:'$D(DIRUT) DIE^BIFMAN(9002084.02,".08///"_+Y,BISITE,.BIPOP)
  1.  ;I $G(DIRUT) D RESET^BISITE Q
  1.  ;
  1.  ;---> Grace Period question.
  1.  ;D TITLE^BIUTL5("SELECT FORECASTING RULES"),TEXT9
  1.  D FULL^VALM1,TITLE^BIUTL5("4-DAY GRACE PERIOD OPTION",1),TEXT9
  1.  N BIDFLT,BIHELP,BIHELP1,BIPRMPT,X,Y
  1.  S BIPRMPT="     Do you wish to implement a 4-Day Grace Period"
  1.  S BIHELP1="        Enter Yes to allow a 4-day grace period."
  1.  S BIHELP="        Enter No to disallow any grace period."
  1.  S BIDFLT=$P($G(^BISITE(BISITE,0)),U,21)
  1.  S BIDFLT=$S(BIDFLT:"YES",1:"NO")
  1.  W !
  1.  D DIR^BIFMAN("YO",.Y,,BIPRMPT,BIDFLT,BIHELP,BIHELP1)
  1.  I $G(Y)="^" D RESET^BISITE Q
  1.  D DIE^BIFMAN(9002084.02,".21///"_Y,BISITE)
  1.  ;
  1.  ;---> HPV Age question.
  1.  ;D TITLE^BIUTL5("SELECT FORECASTING RULES"),TEXT10
  1.  ;N BIDFLT,BIHELP,BIPRMPT,X,Y
  1.  ;
  1.  ;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR
  1.  ;---> Update prompts and help text for HPV.
  1.  ;S BIPRMPT="     Select 1 (18 yrs) or 2 for (26f/21m yrs): "
  1.  ;S BIHELP="        Enter 1 to stop HPV at 18 yrs old; or 2 to stop"
  1.  ;S BIHELP=BIHELP_" at 26f/21m yrs."
  1.  ;**********
  1.  ;
  1.  ;S BIDFLT=+$P($G(^BISITE(BISITE,0)),U,24)  S:'BIDFLT BIDFLT=1
  1.  ;D DIR^BIFMAN("SAB^1:18;2:26",.Y,,BIPRMPT,BIDFLT,BIHELP)
  1.  ;I $G(Y)="^" D RESET^BISITE Q
  1.  ;D DIE^BIFMAN(9002084.02,".24///"_Y,BISITE)
  1.  ;**********
  1.  ;
  1.  D RESET^BISITE
  1.  Q
  1.  ;
  1.  ;
  1.  ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1.  ;---> Update HPV text below.
  1.  ;**********
  1.  ;----------
  1. TEXT8 ;EP
  1.  ;;Versions 1, 3, 5, 6, 7 and 11 forecast the first vaccines series at 6 wks;
  1.  ;;the others beginning at 2 mths.  All versions forecast Rotavirus at
  1.  ;;2 (6 wks), 4, and 6 mths, and Influenza between Aug 15 and March 14
  1.  ;;for infants 6 months-18 years (or all ages).  Options 3,4 & 6 forecast
  1.  ;;Hep A starting at 12 months, while options 1,2,5 and 11 forecast Hep A
  1.  ;;at 15 months.  Option 11 does not forecast Hep A or Hep B in persons
  1.  ;;over 18 years, regardless of prior doses. All options forecast Tdap, MCV4,
  1.  ;;and HPV for adolescents per ACIP recommendations.
  1.  ;;
  1.  ;;   Option       6 Mths         12 Mths                     15 Mths
  1.  ;;   ------       ------  -----------------------------      ----------
  1.  ;;    1) ......   IPV     Hib, MMR, Pn, Var ...........      DTaP, HepA
  1.  ;;    2) ......   ....    Hib, IPV, MMR, Pn, Var ......      DTaP, HepA
  1.  ;;    3) ......   IPV     DTaP, Hib, MMR, Pn, Var, HepA
  1.  ;;    4) ......   ....    DTaP, Hib, IPV, MMR, Pn, Var, HepA
  1.  ;;    5) ......   IPV     Hib, MMR, Var ...............      DTaP, Pn, HepA
  1.  ;;    6) ......   IPV     Hib, MMR, Var, HepA..........      DTaP, Pn
  1.  ;;    7) Comvax   IPV     DTaP, HepB, Hib, MMR, Pn, Var      Hep A
  1.  ;;   11) ......   IPV     Hib, MMR, Pn, Var ...........      DTaP, HepA
  1.  ;;
  1.  D PRINTX("TEXT8",3)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT9 ;EP
  1.  ;;The ACIP recommends that vaccine doses administered 4 days or less
  1.  ;;before the minimum interval or age be counted as valid.  (Not all
  1.  ;;states accept this "4-Day Grace Period.")
  1.  ;;
  1.  ;;Below, choose "Yes" if you would like to screen using the 4-Day Grace
  1.  ;;Period.  Choose "No" to adhere strictly to the recommended intervals.
  1.  ;;
  1.  ;;Note: The 4-Day Grace Period will not affect vaccine forecasting, only
  1.  ;;screening for the validity of the dose administered.
  1.  ;;
  1.  D PRINTX("TEXT9")
  1.  Q
  1.  ;
  1.  ;
  1.  ;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR
  1.  ;---> Update prompts and help text for HPV.
  1.  ;
  1.  ;----------
  1. TEXT10 ;EP
  1.  ;;The ACIP recommends HPV for females 11-12 years with catch up for
  1.  ;;13-26 years for females and 13-21 years for males.  But HPV is provided
  1.  ;;by the Vaccine for Children's Program only for 9-18 year olds.
  1.  ;;
  1.  ;;Please select whether HPV should forecast for all patients from age 11
  1.  ;;through 18 years, or only through age 26 for females and age 21 for males.
  1.  ;;
  1.  ;**********
  1.  D PRINTX("TEXT10")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PRINTX(BILINL,BITAB) ;EP
  1.  Q:$G(BILINL)=""
  1.  N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
  1.  F I=1:1 S X=$T(@BILINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. BISITE() ;EP
  1.  ;---> Check for local variable BISITE.
  1.  ;---> Variables:
  1.  ;     1 - BISITE (req) Site IEN in BI SITE PARAMETER File.
  1.  ;
  1.  I '$G(BISITE) D ERRCD^BIUTL2(111,,1),RESET^BISITE Q 1
  1.  I '$D(^BISITE(BISITE,0)) D ERRCD^BIUTL2(110,,1),RESET^BISITE Q 1
  1.  Q 0