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