BISITE4 ;IHS/CMI/MWR - SELECT GPRA COMMUNITIES.; MAY 10, 2010
;;8.5;IMMUNIZATION;**14**;AUG 01,2017
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; SELECT COMMUNITIES TO BE INCLUDED IN GPRA GROUPS AND REPORTS.
;; PATCH 8: Update Help Text to exclude influenza. TEXT2+3
;; PATCH 9: Update options to include Hep B. TEXT1+24
;; PATCH 12: Use BIDUZ2. GETGPRA+9
;; PATCH 13: Add Flu Season Date Range parameter. FLUDATS+0
;; PATCH 14: Update options and Help TEXT2 to include Hep A&B RISKP+0
;
;
;----------
GPRA ;EP
;---> Select Communities for GPRA.
;---> Called by Protocol BI SITE GPRA COMS.
;
Q:$$BISITE^BISITE2
N BIITEM S BIITEM="Community"
N BITITEM S BITITEM="GPRA Community"
N BICOL S BICOL=" # Community State"
N BIID S BIID="3;I $G(X) S:$D(^DIC(5,X,0)) X=$P(^(0),U);32"
N BIGPRA,BIGPRAD,BIPOP
;
;---> Use previous GPRA List for this site as default.
D GETGPRA(.BIGPRAD,DUZ(2))
D SEL^BISELECT(9999999.05,"BIGPRA",BIITEM,,,,BIID,BICOL,.BIPOP,1,,.BIGPRAD,BITITEM)
;
;---> Now replace the previous list for this site with the newly selected list.
D
.Q:$G(BIPOP)
.;---> If user tried to select ALL Communities for GPRA, don't change.
.I $D(BIGPRA("ALL")) D Q
..W !!," * GPRA Communities *"
..W !!!," You may not select ""ALL"" for your set of GPRA Communities."
..D DIRZ^BIUTL3()
.;
.N BIK S BIK="^BISITE("_DUZ(2)_",2)" K @BIK
.S ^BISITE(DUZ(2),2,0)="^9002084.04PA"
.N N S N=0
.F S N=$O(BIGPRA(N)) Q:'N D
..S ^BISITE(DUZ(2),2,N,0)=N,^BISITE(DUZ(2),2,"B",N,N)=""
..N X S X=$P($G(^BISITE(DUZ(2),2,0)),U,4)+1
..S ^BISITE(DUZ(2),2,0)="^9002084.04PA^"_N_U_X
;
D RESET^BISITE
Q
;
;
;----------
GETGPRA(BIGPRA,BIDUZ2,BIERR) ;PEP - Return GPRA Communities Array.
;---> Retrieve GPRA Communities Array of IEN's for this DUZ(2).
;---> Parameters:
; 1 - BIGPRA (ret) Array of GPRA IEN's in the COMMUNITY file - ^AUTTCOM(.
; 2 - BIDUZ2 (req) Site IEN or DUZ(2).
; 3 - BIERR (ret) Error text, if any.
;
I '$G(BIDUZ2) S BIDUZ2=$G(DUZ(2))
I '$G(BIDUZ2) D ERRCD^BIUTL2(109,.BIERR) Q
;********** PATCH 12, v8.5, MAY 01,2016, IHS/CMI/MWR
;---> Use BIZUZ2 as passed rather than DUZ(2).
;I '$O(^BISITE(DUZ(2),2,0)) D ERRCD^BIUTL2(110,.BIERR) Q
I '$O(^BISITE(BIDUZ2,2,0)) D ERRCD^BIUTL2(110,.BIERR) Q
N N S N=0
;F S N=$O(^BISITE(DUZ(2),2,N)) Q:'N S BIGPRA(N)=""
F S N=$O(^BISITE(BIDUZ2,2,N)) Q:'N S BIGPRA(N)=""
Q
;
;
;----------
INPTCHK ;EP
;---> Edit the parameter that determines whether Inpatient Status
;---> is checked (and changed, if necessary) when storing Visits.
;---> Called by Protocol BI SITE INPATIENT CHECK ENABLE.
;
Q:$$BISITE^BISITE2
D FULL^VALM1,TITLE^BIUTL5("ENABLE/DISABLE INPATIENT VISIT CHECK"),TEXT5
N BIDFLT,DIR,DIRUT,Y
S DIR(0)="SOA^E:Enable;D:Disable"
S DIR("A")=" Please select either Enable or Disable: "
S DIR("B")=$S($$INPTCHK^BIUTL2(BISITE):"Enable",1:"Disable")
D ^DIR
D:'$D(DIRUT)
.N BIFLD,BIERR S BIFLD(.23)=Y
.D FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1)
.I BIERR]"" W !!?3,BIERR D DIRZ^BIUTL3()
D RESET^BISITE
Q
;
;
;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR
;---> Flu Season Date Range.
;----------
FLUDATS ;EP
;---> Edit the parameters that determines the start and end of the Flu
;---> forecasting season.
;
Q:$$BISITE^BISITE2
D FULL^VALM1,TITLE^BIUTL5("FLU SEASON START & END DATES"),TEXT5
;
N BIDATES,BISTART,BIEND
S BIDATES=$$FLUDATS^BIUTL8(BISITE)
N BIPOP,DIRUT
;---> Edit Start Date.
D FLUDATS1("START",BIDATES,.BISTART,.DIRUT)
;
;---> If user ^'d out, quit.
I $G(DIRUT) D Q
.W !!?10,"No changes made." D DIRZ^BIUTL3(),RESET^BISITE
;
;---> Edit End Date.
D FLUDATS1("END",BIDATES,.BIEND,.DIRUT)
;
;---> If user ^'d out, quit.
I $G(DIRUT) D Q
.W !!?10,"No changes made." D DIRZ^BIUTL3(),RESET^BISITE
;
;---> Save new (or unchanged) values for this site.
N BIFLD,BIERR S BIFLD(.31)=BISTART,BIFLD(.32)=BIEND
D FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1)
I BIERR]"" W !!?3,BIERR D DIRZ^BIUTL3(),RESET^BISITE Q
;
W !!?5,"Flu Season dates are now: ",BISTART," to ",BIEND
D DIRZ^BIUTL3()
D RESET^BISITE
Q
;
;
;----------
FLUDATS1(BIMODE,BIDATES,BIRESULT,DIRUT) ;EP
;---> Edit Start/End date.
; 1 - BIMODE (req) Equals START or END.
; 2 - BIDATES (req) Default Start & End Dates from Site Parmeter.
; 3 - BIRESULT (ret) Selected date in the form mm/dd.
; 4 - DIRUT (RET) =1 if user ^'d out.
;
F D Q:BIPOP
.N DIR,Y S BIPOP=0
.S DIR("?")=" Enter the "_BIMODE_" Date of the Flu Season as mm/dd"
.S DIR(0)="FA^3:5",DIR("A")=" Enter "_BIMODE_" Date: "
.N BIDEFLT S BIDFLT=$S(BIMODE="START":$P(BIDATES,"%"),1:$P(BIDATES,"%",2))
.S DIR("B")=BIDFLT
.D ^DIR
.I $D(DIRUT) S BIPOP=1 Q
.;
.;---> Add leading zeros if necessary.
.I $L($P(Y,"/"))=1,$P(Y,"/")>0 S Y="0"_Y
.I $L($P(Y,"/",2))=1,$P(Y,"/",2)>0 S Y=$P(Y,"/")_"/"_"0"_$P(Y,"/",2)
.;
.;---> Check pattern match.
.I Y'?2N1"/"2N D S BIPOP=0 Q
..W !!?10,"Using numbers, please enter the month, then a slash, then the day.",!
.;
.;---> Check valid month.
.I (+$P(Y,"/")<1)!(+$P(Y,"/")>12) D S BIPOP=0 Q
..W !!?10,$P(Y,"/")," is not a valid MONTH."
..W !?10,"Using numbers, please enter the month, then a slash, then the day.",!
.;
.;---> Check valid day.
.I (+$P(Y,"/",2)<1)!(+$P(Y,"/",2)>31) D S BIPOP=0 Q
..W !!?10,$P(Y,"/",2)," is not a valid DAY."
..W !?10,"Using numbers, please enter the month, then a slash, then the day.",!
.;
.;---> Check for legit day, given the month.
.I +$P(Y,"/")=2,+$P(Y,"/",2)>29 D S BIPOP=0 Q
..W !!?10,Y," is not a valid date",!
.N Z S Z=+$P(Y,"/") I (Z=4)!(Z=6)!(Z=9)!(Z=11) I +$P(Y,"/",2)>30 D S BIPOP=0 Q
..W !!?10,Y," is not a valid date",!
.;
.;---> If START is earlier than 07/01 or the END is later than 6/30, reject.
.I BIMODE="START",+$P(Y,"/")<7 D S BIPOP=0 Q
..W !!?10,"START Date cannot be before 07/01.",!
.I BIMODE="END",+$P(Y,"/")>6 D S BIPOP=0 Q
..W !?5,"END Date cannot be after 06/30.",!
.;
.;---> Set new Date.
.S BIRESULT=Y,BIPOP=1
Q
;
;
;----------
TEXT5 ;EP
;;Please select the Start and End Dates for the Influenza Season.
;;
;;Enter the dates in the numeric form: mm/dd
;;For example, August 15 would be entered as 08/15.
;; April 1st would be entered as 04/01.
;;
D PRINTX("TEXT5")
Q
;**********
;
;
;----------
TEXT1 ;EP
;;When an Immunization Visit or Skin Test Visit is stored, the default
;;Category of Visit is "Ambulatory" (Outpatient).
;;However, if the RPMS PIMS (Patient Information Management System) or
;;various Billing applications are in use, the patient may have the
;;Status of "Inpatient" at the time of the visit.
;;
;;In order to avoid conflicts that might arise from Inpatient and
;;Ambulatory Visits being listed for the same day, this software
;;can check the Inpatient Status of the patient at the time of the
;;immunization or skin test. If the patient is listed as an Inpatient
;;at the time of the immunization, the software can automatically
;;change the Category from Ambulatory to Inpatient for the immunization.
;;
;;This feature is turned on by setting "Inpatient Visit Check" to ENABLE.
;;If the "Inpatient Visit Check" feature is causing problems, however,
;;(such as conflicts with third-party Billing software), then set the
;;parameter to DISABLE and no Inpatient check will occur.
;;
D PRINTX("TEXT1")
Q
;
;
;
;;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
;---> Update options and Help TEXT2 to include Hep B and Hep A for CLD/HepC.
;----------
RISKP ;EP
;---> Edit the parameter that determines whether the Risk Status
;---> for patients with regard to Flu and Pneumo should be checked
;---> (in the Visit files) when forecasting those vaccines.
;---> Called by Protocol BI SITE INPATIENT CHECK ENABLE.
;
Q:$$BISITE^BISITE2
D FULL^VALM1,TITLE^BIUTL5("ENABLE/DISABLE RISK FACTOR CHECKS"),TEXT2
N BIERR,BIDFLT,BIDFLT1,BISEL,DIR,DIRUT,X,Y
S BIDFLT=$$RISKP^BIUTL2(BISITE),BISEL=""
S X=$E(BIDFLT,1)
I $E(BIDFLT,2)&($E(BIDFLT,2)'=9) S X=X_","_$E(BIDFLT,2)
I $E(BIDFLT,3)&($E(BIDFLT,3)'=9) S X=X_","_$E(BIDFLT,3)
S DIR("B")=X
S DIR(0)="FOA^0:5",DIR("A")=" Select one or more of the above, separated by commas: "
;
S DIR("?")=" Enter 1, 2, or 3, or any combination of them, separated by commas."
D ^DIR
I $D(DIRUT) D RESET^BISITE Q
;
;---> Save user selection.
I Y[1 S BISEL=1
I Y[2 S BISEL=BISEL_2
I Y[3 S BISEL=BISEL_3
I 'BISEL S BISEL=0
;
;---> If selection includes Pneumo, then ask about Smoking Factors.
D:(BISEL[1)
.D FULL^VALM1,TITLE^BIUTL5("INCLUDE SMOKING AS A PNEUMO RISK FACTOR"),TEXT21
.W !!," Do you wish to include a history of SMOKING in the criteria for"
.W !," the High Risk Pneumo group?",!
.S DIR("?",1)=" Enter YES to include SMOKING as a Pneumo High Risk Factor, "
.S DIR("?")=" enter NO to disregard it as a High Risk Factor."
.S DIR(0)="Y",DIR("A")=" Enter Yes or No"
.S DIR("B")=$S(BIDFLT[9:"YES",1:"NO")
.D ^DIR
.I Y S BISEL=BISEL_9
;
N BIFLD,BIERR S BIFLD(.19)=BISEL
D FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1)
I BIERR]"" W !!?3,BIERR D DIRZ^BIUTL3()
;
D RESET^BISITE
Q
;
;
;----------
TEXT2 ;EP
;;When forecasting immunizations for a patient, this program is able
;;to look at the patient's medical history of visits and attempt to
;;determine if the patient has an increased risk for pneumococcal
;;disease, hepatitis B due to Diabetes, or hepatitis A and B due to
;;chronic liver disease (CLD) or hepatitis C. If the patient fits the
;;High Risk criteria, the program will forecast the patient as due for
;;those immunizations.
;;
;;This parameter allows you to select which, if any, High Risk forecasting
;;is enabled on your system. The choices are as follows:
;;
;; 0 - None
;; 1 - Pneumo for High Risk history
;; 2 - Hep B for Diabetes Mellitus
;; 3 - Hep A and Hep B for CLD/Hep C
;;
D PRINTX("TEXT2")
Q
;**********
;
;
;----------
TEXT21 ;EP
;;You have the option to include smoking in the High Risk factors for
;;Pneumococcal disease. Specifically, the Health Factors looked for will
;;be either "Current Smoker" or "Current Smoker and Smokeless" within
;;the last two years.
;;
D PRINTX("TEXT21")
Q
;
;
;----------
IMPCPT ;EP
;---> Edit the parameter that determines whether the CPT-coded Visits
;---> should be imported into the V Immunization File if they have
;---> not already been entered.
;---> Called by Protocol BI SITE CPT VISITS IMPORT.
;
Q:$$BISITE^BISITE2
D FULL^VALM1,TITLE^BIUTL5("ENABLE/DISABLE IMPORT OF CPT-CODED VISITS"),TEXT3
N BIDFLT,DIR,DIRUT,Y
S DIR(0)="SOA^E:Enable;D:Disable"
S DIR("A")=" Please select either Enable or Disable: "
S DIR("B")=$S($$IMPCPT^BIUTL2(BISITE):"Enable",1:"Disable")
D ^DIR
D:'$D(DIRUT)
.N BIFLD,BIERR S BIFLD(.2)=$G(Y)
.D FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1)
.I BIERR]"" W !!?3,BIERR D DIRZ^BIUTL3()
D RESET^BISITE
Q
;
;
;----------
TEXT3 ;EP
;;In RPMS it is possible for some immunizations to be entered by
;;CPT Code into the CPT Visit File, rather than into the true
;;Immunization Visit File. These "CPT-coded immunizations"
;;do NOT appear on the patient's Immunization Profile, nor are
;;they always included in the Immunization Package Reports.
;;
;;When the "Import CPT-coded Visits" site parameter is enabled,
;;those immunizations that are entered only as CPT Visits will be
;;checked and automatically entered into the proper Immunization
;;Visits File if they do not already exist there.
;;
;;If this parameter is disabled, the program will make no attempt
;;to bring CPT-coded Visits into the Immunization files.
;;
D PRINTX("TEXT3")
Q
;
;
;----------
VISMNU ;EP
;---> Edit the parameter that determines whether the Risk Status
;---> for patients with regard to Flu and Pneumo should be checked
;---> (in the Visit files) when forecasting those vaccines.
;---> Called by Protocol BI SITE INPATIENT CHECK ENABLE.
;
Q:$$BISITE^BISITE2
D FULL^VALM1,TITLE^BIUTL5("ENABLE/DISABLE VISIT SELECTION MENU"),TEXT4
N BIDFLT,DIR,DIRUT,Y
S DIR(0)="SOA^E:Enable;D:Disable"
S DIR("A")=" Please select either Enable or Disable: "
S DIR("B")=$S($$VISMNU^BIUTL2(BISITE):"Enable",1:"Disable")
D ^DIR
D:'$D(DIRUT)
.N BIFLD,BIERR S BIFLD(.28)=$G(Y)
.D FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1)
.I BIERR]"" W !!?3,BIERR D DIRZ^BIUTL3()
D RESET^BISITE
Q
;
;
;----------
TEXT4 ;EP
;;When adding or editing immunizations, this program will either
;;create a NEW Visit or link the immunization to an EXISTING Visit.
;;This process can be occur automatically, or it can be controlled
;;by the user at the time the immunization is being entered.
;;
;;If the Visit Selection Menu is DISABLED, the program will look for
;;similar Visits for the patient on that day and attempt to link with
;;one if enough information matches. If no such Visits exist, a new
;;Visit will be created automatically. (This can sometimes lead to
;;Visits that are incorrectly linked and must be corrected manually.)
;;
;;If the Visit Selection Menu is ENABLED, the program will look for
;;similar Visits--and if any exist--a Visit Selection Menu will pop up.
;;The Visit Selection Menu will allow the user to either create a new
;;Visit or select from existing Visits for that day. (If there are no
;;existing Visits, a new Visit will be created automatically.)
;;
D PRINTX("TEXT4")
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
BISITE4 ;IHS/CMI/MWR - SELECT GPRA COMMUNITIES.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**14**;AUG 01,2017
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; SELECT COMMUNITIES TO BE INCLUDED IN GPRA GROUPS AND REPORTS.
+4 ;; PATCH 8: Update Help Text to exclude influenza. TEXT2+3
+5 ;; PATCH 9: Update options to include Hep B. TEXT1+24
+6 ;; PATCH 12: Use BIDUZ2. GETGPRA+9
+7 ;; PATCH 13: Add Flu Season Date Range parameter. FLUDATS+0
+8 ;; PATCH 14: Update options and Help TEXT2 to include Hep A&B RISKP+0
+9 ;
+10 ;
+11 ;----------
GPRA ;EP
+1 ;---> Select Communities for GPRA.
+2 ;---> Called by Protocol BI SITE GPRA COMS.
+3 ;
+4 IF $$BISITE^BISITE2
QUIT
+5 NEW BIITEM
SET BIITEM="Community"
+6 NEW BITITEM
SET BITITEM="GPRA Community"
+7 NEW BICOL
SET BICOL=" # Community State"
+8 NEW BIID
SET BIID="3;I $G(X) S:$D(^DIC(5,X,0)) X=$P(^(0),U);32"
+9 NEW BIGPRA,BIGPRAD,BIPOP
+10 ;
+11 ;---> Use previous GPRA List for this site as default.
+12 DO GETGPRA(.BIGPRAD,DUZ(2))
+13 DO SEL^BISELECT(9999999.05,"BIGPRA",BIITEM,,,,BIID,BICOL,.BIPOP,1,,.BIGPRAD,BITITEM)
+14 ;
+15 ;---> Now replace the previous list for this site with the newly selected list.
+16 Begin DoDot:1
+17 IF $GET(BIPOP)
QUIT
+18 ;---> If user tried to select ALL Communities for GPRA, don't change.
+19 IF $DATA(BIGPRA("ALL"))
Begin DoDot:2
+20 WRITE !!," * GPRA Communities *"
+21 WRITE !!!," You may not select ""ALL"" for your set of GPRA Communities."
+22 DO DIRZ^BIUTL3()
End DoDot:2
QUIT
+23 ;
+24 NEW BIK
SET BIK="^BISITE("_DUZ(2)_",2)"
KILL @BIK
+25 SET ^BISITE(DUZ(2),2,0)="^9002084.04PA"
+26 NEW N
SET N=0
+27 FOR
SET N=$ORDER(BIGPRA(N))
IF 'N
QUIT
Begin DoDot:2
+28 SET ^BISITE(DUZ(2),2,N,0)=N
SET ^BISITE(DUZ(2),2,"B",N,N)=""
+29 NEW X
SET X=$PIECE($GET(^BISITE(DUZ(2),2,0)),U,4)+1
+30 SET ^BISITE(DUZ(2),2,0)="^9002084.04PA^"_N_U_X
End DoDot:2
End DoDot:1
+31 ;
+32 DO RESET^BISITE
+33 QUIT
+34 ;
+35 ;
+36 ;----------
GETGPRA(BIGPRA,BIDUZ2,BIERR) ;PEP - Return GPRA Communities Array.
+1 ;---> Retrieve GPRA Communities Array of IEN's for this DUZ(2).
+2 ;---> Parameters:
+3 ; 1 - BIGPRA (ret) Array of GPRA IEN's in the COMMUNITY file - ^AUTTCOM(.
+4 ; 2 - BIDUZ2 (req) Site IEN or DUZ(2).
+5 ; 3 - BIERR (ret) Error text, if any.
+6 ;
+7 IF '$GET(BIDUZ2)
SET BIDUZ2=$GET(DUZ(2))
+8 IF '$GET(BIDUZ2)
DO ERRCD^BIUTL2(109,.BIERR)
QUIT
+9 ;********** PATCH 12, v8.5, MAY 01,2016, IHS/CMI/MWR
+10 ;---> Use BIZUZ2 as passed rather than DUZ(2).
+11 ;I '$O(^BISITE(DUZ(2),2,0)) D ERRCD^BIUTL2(110,.BIERR) Q
+12 IF '$ORDER(^BISITE(BIDUZ2,2,0))
DO ERRCD^BIUTL2(110,.BIERR)
QUIT
+13 NEW N
SET N=0
+14 ;F S N=$O(^BISITE(DUZ(2),2,N)) Q:'N S BIGPRA(N)=""
+15 FOR
SET N=$ORDER(^BISITE(BIDUZ2,2,N))
IF 'N
QUIT
SET BIGPRA(N)=""
+16 QUIT
+17 ;
+18 ;
+19 ;----------
INPTCHK ;EP
+1 ;---> Edit the parameter that determines whether Inpatient Status
+2 ;---> is checked (and changed, if necessary) when storing Visits.
+3 ;---> Called by Protocol BI SITE INPATIENT CHECK ENABLE.
+4 ;
+5 IF $$BISITE^BISITE2
QUIT
+6 DO FULL^VALM1
DO TITLE^BIUTL5("ENABLE/DISABLE INPATIENT VISIT CHECK")
DO TEXT5
+7 NEW BIDFLT,DIR,DIRUT,Y
+8 SET DIR(0)="SOA^E:Enable;D:Disable"
+9 SET DIR("A")=" Please select either Enable or Disable: "
+10 SET DIR("B")=$SELECT($$INPTCHK^BIUTL2(BISITE):"Enable",1:"Disable")
+11 DO ^DIR
+12 IF '$DATA(DIRUT)
Begin DoDot:1
+13 NEW BIFLD,BIERR
SET BIFLD(.23)=Y
+14 DO FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1)
+15 IF BIERR]""
WRITE !!?3,BIERR
DO DIRZ^BIUTL3()
End DoDot:1
+16 DO RESET^BISITE
+17 QUIT
+18 ;
+19 ;
+20 ;********** PATCH 13, v8.5, AUG 01,2016, IHS/CMI/MWR
+21 ;---> Flu Season Date Range.
+22 ;----------
FLUDATS ;EP
+1 ;---> Edit the parameters that determines the start and end of the Flu
+2 ;---> forecasting season.
+3 ;
+4 IF $$BISITE^BISITE2
QUIT
+5 DO FULL^VALM1
DO TITLE^BIUTL5("FLU SEASON START & END DATES")
DO TEXT5
+6 ;
+7 NEW BIDATES,BISTART,BIEND
+8 SET BIDATES=$$FLUDATS^BIUTL8(BISITE)
+9 NEW BIPOP,DIRUT
+10 ;---> Edit Start Date.
+11 DO FLUDATS1("START",BIDATES,.BISTART,.DIRUT)
+12 ;
+13 ;---> If user ^'d out, quit.
+14 IF $GET(DIRUT)
Begin DoDot:1
+15 WRITE !!?10,"No changes made."
DO DIRZ^BIUTL3()
DO RESET^BISITE
End DoDot:1
QUIT
+16 ;
+17 ;---> Edit End Date.
+18 DO FLUDATS1("END",BIDATES,.BIEND,.DIRUT)
+19 ;
+20 ;---> If user ^'d out, quit.
+21 IF $GET(DIRUT)
Begin DoDot:1
+22 WRITE !!?10,"No changes made."
DO DIRZ^BIUTL3()
DO RESET^BISITE
End DoDot:1
QUIT
+23 ;
+24 ;---> Save new (or unchanged) values for this site.
+25 NEW BIFLD,BIERR
SET BIFLD(.31)=BISTART
SET BIFLD(.32)=BIEND
+26 DO FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1)
+27 IF BIERR]""
WRITE !!?3,BIERR
DO DIRZ^BIUTL3()
DO RESET^BISITE
QUIT
+28 ;
+29 WRITE !!?5,"Flu Season dates are now: ",BISTART," to ",BIEND
+30 DO DIRZ^BIUTL3()
+31 DO RESET^BISITE
+32 QUIT
+33 ;
+34 ;
+35 ;----------
FLUDATS1(BIMODE,BIDATES,BIRESULT,DIRUT) ;EP
+1 ;---> Edit Start/End date.
+2 ; 1 - BIMODE (req) Equals START or END.
+3 ; 2 - BIDATES (req) Default Start & End Dates from Site Parmeter.
+4 ; 3 - BIRESULT (ret) Selected date in the form mm/dd.
+5 ; 4 - DIRUT (RET) =1 if user ^'d out.
+6 ;
+7 FOR
Begin DoDot:1
+8 NEW DIR,Y
SET BIPOP=0
+9 SET DIR("?")=" Enter the "_BIMODE_" Date of the Flu Season as mm/dd"
+10 SET DIR(0)="FA^3:5"
SET DIR("A")=" Enter "_BIMODE_" Date: "
+11 NEW BIDEFLT
SET BIDFLT=$SELECT(BIMODE="START":$PIECE(BIDATES,"%"),1:$PIECE(BIDATES,"%",2))
+12 SET DIR("B")=BIDFLT
+13 DO ^DIR
+14 IF $DATA(DIRUT)
SET BIPOP=1
QUIT
+15 ;
+16 ;---> Add leading zeros if necessary.
+17 IF $LENGTH($PIECE(Y,"/"))=1
IF $PIECE(Y,"/")>0
SET Y="0"_Y
+18 IF $LENGTH($PIECE(Y,"/",2))=1
IF $PIECE(Y,"/",2)>0
SET Y=$PIECE(Y,"/")_"/"_"0"_$PIECE(Y,"/",2)
+19 ;
+20 ;---> Check pattern match.
+21 IF Y'?2N1"/"2N
Begin DoDot:2
+22 WRITE !!?10,"Using numbers, please enter the month, then a slash, then the day.",!
End DoDot:2
SET BIPOP=0
QUIT
+23 ;
+24 ;---> Check valid month.
+25 IF (+$PIECE(Y,"/")<1)!(+$PIECE(Y,"/")>12)
Begin DoDot:2
+26 WRITE !!?10,$PIECE(Y,"/")," is not a valid MONTH."
+27 WRITE !?10,"Using numbers, please enter the month, then a slash, then the day.",!
End DoDot:2
SET BIPOP=0
QUIT
+28 ;
+29 ;---> Check valid day.
+30 IF (+$PIECE(Y,"/",2)<1)!(+$PIECE(Y,"/",2)>31)
Begin DoDot:2
+31 WRITE !!?10,$PIECE(Y,"/",2)," is not a valid DAY."
+32 WRITE !?10,"Using numbers, please enter the month, then a slash, then the day.",!
End DoDot:2
SET BIPOP=0
QUIT
+33 ;
+34 ;---> Check for legit day, given the month.
+35 IF +$PIECE(Y,"/")=2
IF +$PIECE(Y,"/",2)>29
Begin DoDot:2
+36 WRITE !!?10,Y," is not a valid date",!
End DoDot:2
SET BIPOP=0
QUIT
+37 NEW Z
SET Z=+$PIECE(Y,"/")
IF (Z=4)!(Z=6)!(Z=9)!(Z=11)
IF +$PIECE(Y,"/",2)>30
Begin DoDot:2
+38 WRITE !!?10,Y," is not a valid date",!
End DoDot:2
SET BIPOP=0
QUIT
+39 ;
+40 ;---> If START is earlier than 07/01 or the END is later than 6/30, reject.
+41 IF BIMODE="START"
IF +$PIECE(Y,"/")<7
Begin DoDot:2
+42 WRITE !!?10,"START Date cannot be before 07/01.",!
End DoDot:2
SET BIPOP=0
QUIT
+43 IF BIMODE="END"
IF +$PIECE(Y,"/")>6
Begin DoDot:2
+44 WRITE !?5,"END Date cannot be after 06/30.",!
End DoDot:2
SET BIPOP=0
QUIT
+45 ;
+46 ;---> Set new Date.
+47 SET BIRESULT=Y
SET BIPOP=1
End DoDot:1
IF BIPOP
QUIT
+48 QUIT
+49 ;
+50 ;
+51 ;----------
TEXT5 ;EP
+1 ;;Please select the Start and End Dates for the Influenza Season.
+2 ;;
+3 ;;Enter the dates in the numeric form: mm/dd
+4 ;;For example, August 15 would be entered as 08/15.
+5 ;; April 1st would be entered as 04/01.
+6 ;;
+7 DO PRINTX("TEXT5")
+8 QUIT
+9 ;**********
+10 ;
+11 ;
+12 ;----------
TEXT1 ;EP
+1 ;;When an Immunization Visit or Skin Test Visit is stored, the default
+2 ;;Category of Visit is "Ambulatory" (Outpatient).
+3 ;;However, if the RPMS PIMS (Patient Information Management System) or
+4 ;;various Billing applications are in use, the patient may have the
+5 ;;Status of "Inpatient" at the time of the visit.
+6 ;;
+7 ;;In order to avoid conflicts that might arise from Inpatient and
+8 ;;Ambulatory Visits being listed for the same day, this software
+9 ;;can check the Inpatient Status of the patient at the time of the
+10 ;;immunization or skin test. If the patient is listed as an Inpatient
+11 ;;at the time of the immunization, the software can automatically
+12 ;;change the Category from Ambulatory to Inpatient for the immunization.
+13 ;;
+14 ;;This feature is turned on by setting "Inpatient Visit Check" to ENABLE.
+15 ;;If the "Inpatient Visit Check" feature is causing problems, however,
+16 ;;(such as conflicts with third-party Billing software), then set the
+17 ;;parameter to DISABLE and no Inpatient check will occur.
+18 ;;
+19 DO PRINTX("TEXT1")
+20 QUIT
+21 ;
+22 ;
+23 ;
+24 ;;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
+25 ;---> Update options and Help TEXT2 to include Hep B and Hep A for CLD/HepC.
+26 ;----------
RISKP ;EP
+1 ;---> Edit the parameter that determines whether the Risk Status
+2 ;---> for patients with regard to Flu and Pneumo should be checked
+3 ;---> (in the Visit files) when forecasting those vaccines.
+4 ;---> Called by Protocol BI SITE INPATIENT CHECK ENABLE.
+5 ;
+6 IF $$BISITE^BISITE2
QUIT
+7 DO FULL^VALM1
DO TITLE^BIUTL5("ENABLE/DISABLE RISK FACTOR CHECKS")
DO TEXT2
+8 NEW BIERR,BIDFLT,BIDFLT1,BISEL,DIR,DIRUT,X,Y
+9 SET BIDFLT=$$RISKP^BIUTL2(BISITE)
SET BISEL=""
+10 SET X=$EXTRACT(BIDFLT,1)
+11 IF $EXTRACT(BIDFLT,2)&($EXTRACT(BIDFLT,2)'=9)
SET X=X_","_$EXTRACT(BIDFLT,2)
+12 IF $EXTRACT(BIDFLT,3)&($EXTRACT(BIDFLT,3)'=9)
SET X=X_","_$EXTRACT(BIDFLT,3)
+13 SET DIR("B")=X
+14 SET DIR(0)="FOA^0:5"
SET DIR("A")=" Select one or more of the above, separated by commas: "
+15 ;
+16 SET DIR("?")=" Enter 1, 2, or 3, or any combination of them, separated by commas."
+17 DO ^DIR
+18 IF $DATA(DIRUT)
DO RESET^BISITE
QUIT
+19 ;
+20 ;---> Save user selection.
+21 IF Y[1
SET BISEL=1
+22 IF Y[2
SET BISEL=BISEL_2
+23 IF Y[3
SET BISEL=BISEL_3
+24 IF 'BISEL
SET BISEL=0
+25 ;
+26 ;---> If selection includes Pneumo, then ask about Smoking Factors.
+27 IF (BISEL[1)
Begin DoDot:1
+28 DO FULL^VALM1
DO TITLE^BIUTL5("INCLUDE SMOKING AS A PNEUMO RISK FACTOR")
DO TEXT21
+29 WRITE !!," Do you wish to include a history of SMOKING in the criteria for"
+30 WRITE !," the High Risk Pneumo group?",!
+31 SET DIR("?",1)=" Enter YES to include SMOKING as a Pneumo High Risk Factor, "
+32 SET DIR("?")=" enter NO to disregard it as a High Risk Factor."
+33 SET DIR(0)="Y"
SET DIR("A")=" Enter Yes or No"
+34 SET DIR("B")=$SELECT(BIDFLT[9:"YES",1:"NO")
+35 DO ^DIR
+36 IF Y
SET BISEL=BISEL_9
End DoDot:1
+37 ;
+38 NEW BIFLD,BIERR
SET BIFLD(.19)=BISEL
+39 DO FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1)
+40 IF BIERR]""
WRITE !!?3,BIERR
DO DIRZ^BIUTL3()
+41 ;
+42 DO RESET^BISITE
+43 QUIT
+44 ;
+45 ;
+46 ;----------
TEXT2 ;EP
+1 ;;When forecasting immunizations for a patient, this program is able
+2 ;;to look at the patient's medical history of visits and attempt to
+3 ;;determine if the patient has an increased risk for pneumococcal
+4 ;;disease, hepatitis B due to Diabetes, or hepatitis A and B due to
+5 ;;chronic liver disease (CLD) or hepatitis C. If the patient fits the
+6 ;;High Risk criteria, the program will forecast the patient as due for
+7 ;;those immunizations.
+8 ;;
+9 ;;This parameter allows you to select which, if any, High Risk forecasting
+10 ;;is enabled on your system. The choices are as follows:
+11 ;;
+12 ;; 0 - None
+13 ;; 1 - Pneumo for High Risk history
+14 ;; 2 - Hep B for Diabetes Mellitus
+15 ;; 3 - Hep A and Hep B for CLD/Hep C
+16 ;;
+17 DO PRINTX("TEXT2")
+18 QUIT
+19 ;**********
+20 ;
+21 ;
+22 ;----------
TEXT21 ;EP
+1 ;;You have the option to include smoking in the High Risk factors for
+2 ;;Pneumococcal disease. Specifically, the Health Factors looked for will
+3 ;;be either "Current Smoker" or "Current Smoker and Smokeless" within
+4 ;;the last two years.
+5 ;;
+6 DO PRINTX("TEXT21")
+7 QUIT
+8 ;
+9 ;
+10 ;----------
IMPCPT ;EP
+1 ;---> Edit the parameter that determines whether the CPT-coded Visits
+2 ;---> should be imported into the V Immunization File if they have
+3 ;---> not already been entered.
+4 ;---> Called by Protocol BI SITE CPT VISITS IMPORT.
+5 ;
+6 IF $$BISITE^BISITE2
QUIT
+7 DO FULL^VALM1
DO TITLE^BIUTL5("ENABLE/DISABLE IMPORT OF CPT-CODED VISITS")
DO TEXT3
+8 NEW BIDFLT,DIR,DIRUT,Y
+9 SET DIR(0)="SOA^E:Enable;D:Disable"
+10 SET DIR("A")=" Please select either Enable or Disable: "
+11 SET DIR("B")=$SELECT($$IMPCPT^BIUTL2(BISITE):"Enable",1:"Disable")
+12 DO ^DIR
+13 IF '$DATA(DIRUT)
Begin DoDot:1
+14 NEW BIFLD,BIERR
SET BIFLD(.2)=$GET(Y)
+15 DO FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1)
+16 IF BIERR]""
WRITE !!?3,BIERR
DO DIRZ^BIUTL3()
End DoDot:1
+17 DO RESET^BISITE
+18 QUIT
+19 ;
+20 ;
+21 ;----------
TEXT3 ;EP
+1 ;;In RPMS it is possible for some immunizations to be entered by
+2 ;;CPT Code into the CPT Visit File, rather than into the true
+3 ;;Immunization Visit File. These "CPT-coded immunizations"
+4 ;;do NOT appear on the patient's Immunization Profile, nor are
+5 ;;they always included in the Immunization Package Reports.
+6 ;;
+7 ;;When the "Import CPT-coded Visits" site parameter is enabled,
+8 ;;those immunizations that are entered only as CPT Visits will be
+9 ;;checked and automatically entered into the proper Immunization
+10 ;;Visits File if they do not already exist there.
+11 ;;
+12 ;;If this parameter is disabled, the program will make no attempt
+13 ;;to bring CPT-coded Visits into the Immunization files.
+14 ;;
+15 DO PRINTX("TEXT3")
+16 QUIT
+17 ;
+18 ;
+19 ;----------
VISMNU ;EP
+1 ;---> Edit the parameter that determines whether the Risk Status
+2 ;---> for patients with regard to Flu and Pneumo should be checked
+3 ;---> (in the Visit files) when forecasting those vaccines.
+4 ;---> Called by Protocol BI SITE INPATIENT CHECK ENABLE.
+5 ;
+6 IF $$BISITE^BISITE2
QUIT
+7 DO FULL^VALM1
DO TITLE^BIUTL5("ENABLE/DISABLE VISIT SELECTION MENU")
DO TEXT4
+8 NEW BIDFLT,DIR,DIRUT,Y
+9 SET DIR(0)="SOA^E:Enable;D:Disable"
+10 SET DIR("A")=" Please select either Enable or Disable: "
+11 SET DIR("B")=$SELECT($$VISMNU^BIUTL2(BISITE):"Enable",1:"Disable")
+12 DO ^DIR
+13 IF '$DATA(DIRUT)
Begin DoDot:1
+14 NEW BIFLD,BIERR
SET BIFLD(.28)=$GET(Y)
+15 DO FDIE^BIFMAN(9002084.02,BISITE,.BIFLD,.BIERR,1)
+16 IF BIERR]""
WRITE !!?3,BIERR
DO DIRZ^BIUTL3()
End DoDot:1
+17 DO RESET^BISITE
+18 QUIT
+19 ;
+20 ;
+21 ;----------
TEXT4 ;EP
+1 ;;When adding or editing immunizations, this program will either
+2 ;;create a NEW Visit or link the immunization to an EXISTING Visit.
+3 ;;This process can be occur automatically, or it can be controlled
+4 ;;by the user at the time the immunization is being entered.
+5 ;;
+6 ;;If the Visit Selection Menu is DISABLED, the program will look for
+7 ;;similar Visits for the patient on that day and attempt to link with
+8 ;;one if enough information matches. If no such Visits exist, a new
+9 ;;Visit will be created automatically. (This can sometimes lead to
+10 ;;Visits that are incorrectly linked and must be corrected manually.)
+11 ;;
+12 ;;If the Visit Selection Menu is ENABLED, the program will look for
+13 ;;similar Visits--and if any exist--a Visit Selection Menu will pop up.
+14 ;;The Visit Selection Menu will allow the user to either create a new
+15 ;;Visit or select from existing Visits for that day. (If there are no
+16 ;;existing Visits, a new Visit will be created automatically.)
+17 ;;
+18 DO PRINTX("TEXT4")
+19 QUIT
+20 ;
+21 ;
+22 ;----------
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
