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

BISITE4.m

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