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

BIOUTPT.m

Go to the documentation of this file. 
  1. BIOUTPT ;IHS/CMI/MWR - HEADERS & PROMPTS FOR REPORTS.; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  COMMON HEADERS FOR REPORTS AND PROMPTS FOR REPORT PARAMETERS.
  1.  ;
  1.  ;
  1.  ;----------
  1. FDATE(BIFDT,BIRTN) ;EP
  1.  ;---> Ask Forecast Date.  Called by Protocol BI OUTPUT FORECAST DATE.
  1.  ;---> Parameters:
  1.  ;     1 - BIFDT (ret) Forecast Date, Fileman format.
  1.  ;               (opt) Default Date.
  1.  ;     2 - BIRTN (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1. FDATE1 ;EP
  1.  S:$G(BIFDT)="" BIFDT=DT
  1.  N BIDFLT,DIR S BIDFLT=$$TXDT^BIUTL5(BIFDT)
  1.  S DIR(0)="DA^::FEX"
  1.  S DIR("A")="     Please enter a Forecast Date: ",DIR("B")=BIDFLT
  1.  D FULL^VALM1
  1.  D TITLE^BIUTL5("SELECT FORECAST DATE")
  1.  D TEXT1
  1.  D ^DIR W !
  1.  I $D(DIRUT) D @("RESET^"_BIRTN) Q
  1.  S BIFDT=$P(Y,".")
  1.  I BIFDT<DT D  G FDATE1
  1.  .W !?5,"The date may not be in the past.  "
  1.  .W "It must be today or in the future."
  1.  .K BIFDT D DIRZ^BIUTL3()
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT1 ;EP
  1.  ;;The "Forecast Date" (or "Clinic Date") is the date that will
  1.  ;;be used for calculating which immunizations patients are due for.
  1.  ;;
  1.  ;;For example, if you choose today, the letter or report will
  1.  ;;list the immunizations that patients are due for today.
  1.  ;;If you choose a future date (the date of a clinic), the letter
  1.  ;;or report will list immunizations due on that future date.
  1.  ;;
  1.  ;;NOTE: If you select a Forecast date in the future, some patients
  1.  ;;      may appear as PAST DUE for that date in the future, even
  1.  ;;      though they are not PAST DUE today.
  1.  ;;
  1.  ;;
  1.  D PRINTX("TEXT1")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. QDATE(BIQDT,BIRTN) ;EP
  1.  ;---> Ask Quarter Ending Date.
  1.  ;---> Called by Protocol BI OUTPUT QUARTER DATE.
  1.  ;---> Parameters:
  1.  ;     1 - BIQDT (ret) Quarter Ending Date, Fileman format.
  1.  ;               (opt) Default Date.
  1.  ;     2 - BIRTN (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  N DIR
  1.  S:$G(BIQDT) DIR("B")=$$TXDT^BIUTL5(BIQDT)
  1.  S DIR(0)="DA^::PE"
  1.  S DIR("A")="   Please enter a Quarter Ending Date: "
  1.  D FULL^VALM1
  1.  D TITLE^BIUTL5("SELECT QUARTER ENDING DATE")
  1.  D TEXT2 W !
  1.  D ^DIR W !
  1.  I $D(DIRUT) D @("RESET^"_BIRTN) Q
  1.  S BIQDT=$P(Y,".")
  1.  I $E(BIQDT,6,7)="00" D
  1.  .N X S X=$E(BIQDT,4,5) D
  1.  ..I +X=2 S X=28 Q
  1.  ..I +X=1 S X=31 Q
  1.  ..I 94611[+X S X=30 Q
  1.  ..S X=31
  1.  .S BIQDT=BIQDT+X
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT2 ;EP
  1.  ;;The "Quarter Ending Date" should be the last day of the quarter
  1.  ;;being reported on.  Typically, this date is either March 31,
  1.  ;;June 30, September 30, or December 31.  However, you may enter
  1.  ;;any date you choose and the report will generate immunization
  1.  ;;statistics based on the date entered.  NOTE: The patient ages
  1.  ;;(3 months, 5 months, 91 years, etc.) will be calculated as of
  1.  ;;the Quarter Ending Date you enter here.
  1.  ;;
  1.  ;;For convenience's sake, if you enter only month/year, such as 9/98,
  1.  ;;the program will automatically assign the report to the last day
  1.  ;;of that month, such as 9/30/1998.
  1.  ;;
  1.  D PRINTX("TEXT2")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DTRANGE(BIBEGDT,BIENDDT,BIPOP,BIRTN,BIBEGDF,BIENDDF) ;EP
  1.  ;---> Ask date range.
  1.  ;---> Called by Protocol BI OUTPUT DATE RANGE.
  1.  ;---> Parameters:
  1.  ;     1 - BIBEGDT (ret) Begin Date, Fileman format.
  1.  ;     2 - BIENDDT (ret) End Date, Fileman format.
  1.  ;     3 - BIPOP   (ret) BIPOP=1 If quit, fail, DTOUT, DUOUT.
  1.  ;     4 - BIRTN   (req) Calling routine for reset.
  1.  ;     5 - BIBEGDF (opt) Begin Date default, Fileman format.
  1.  ;     6 - BIENDDF (opt) End Date default, Fileman format.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  D TITLE^BIUTL5("SELECT DATE RANGE")
  1.  D TEXT3 W !
  1.  D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,$G(BIBEGDT),$G(BIENDDT))
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT3 ;EP
  1.  ;;Please enter the beginning and ending dates for the period you
  1.  ;;wish this report to cover.  (NOTE: The ending date must be after
  1.  ;;the beginning date.)
  1.  ;;
  1.  D PRINTX("TEXT3")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. AGE(BIAG,BIRTN) ;EP
  1.  ;---> Select age range.  Called by Protocol BI OUTPUT AGE.
  1.  ;---> If not limited to an age range, BIAG="".
  1.  ;---> Parameters:
  1.  ;     1 - BIAG  (ret) Age Range in months.
  1.  ;     2 - BIRTN (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  D AGERNG^BIAGE(.BIAG,.BIPOP,"1-72",0)
  1.  I $G(BIPOP) S BIAG="" D @("RESET^"_BIRTN) Q
  1.  S:BIAG="" BIAG="ALL"
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TAR(BITAR,BIRTN) ;EP
  1.  ;---> Select Two-Yr-Old Age Range for same Report.
  1.  ;---> Called by Protocol BI OUTPUT TWO-YR-OLD REPORT AGE RANGE.
  1.  ;---> Parameters:
  1.  ;     1 - BITAR (ret) Two-Yr-Old Age Range in months;
  1.  ;                     either "19-35" or "24-35".
  1.  ;     2 - BIRTN (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  D FULL^VALM1
  1.  D TITLE^BIUTL5("TWO-YR-OLD AGE RANGE")
  1.  D TEXT6
  1.  N A,X,Y S A="     Choose either 1 or 2"
  1.  S X="SO^1:19-35 months;2:24-35 months"
  1.  D DIR^BIFMAN(X,.Y,.BIPOP,A,$G(BITAR))
  1.  S BITAR=$S(Y=2:"24-35",1:"19-35")
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT6 ;EP
  1.  ;;This parameter allows you to select the Age Range of Patients for
  1.  ;;the Two-Yr-Old Report.
  1.  ;;
  1.  ;;Selecting "19-35 months" will include in the report all children who
  1.  ;;were between those ages on the date entered in the "Quarter Ending Date"
  1.  ;;parameter.
  1.  ;;
  1.  ;;Selecting "24-35 months" will only include children who were between
  1.  ;;those ages on the date entered in the "Quarter Ending Date" parameter.
  1.  ;;
  1.  D PRINTX("TEXT6")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. CC(BICC,BIRTN,BIPOP) ;EP
  1.  ;---> Select Current Community(s).
  1.  ;---> Called by Protocol BI OUTPUT COMMUNITY.
  1.  ;---> Parameters:
  1.  ;     1 - BICC  (ret) Local array of Current Community IENs.
  1.  ;     2 - BIRTN (req) Calling routine for reset.
  1.  ;     3 - BIPOP (opt) BIQUIT=1 if user quit, ^-arrowed.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  S BIPOP=0
  1.  D TITLE^BIUTL5("SELECTION OF COMMUNITIES")
  1.  D TEXT8
  1.  ;
  1.  N DIR S DIR("A")="     Select G, L, or P: ",DIR("B")="Load"
  1.  S DIR(0)="SAM^G:GPRA;L:LOAD;P:PREVIOUS"
  1.  D ^DIR K DIR
  1.  I Y=-1!($D(DIRUT)) D @("RESET^"_BIRTN) S BIPOP=1 Q
  1.  ;
  1.  K BICC
  1.  ;---> Load GPRA Set of Communities.
  1.  I "GL"[Y D GETGPRA^BISITE4(.BICC,$G(DUZ(2)))
  1.  ;
  1.  D:Y'="G"
  1.  .;---> Select cases for one or more CURRENT COMMUNITY (OR ALL).
  1.  .N BIID S BIID="3;I $G(X) S:$D(^DIC(5,X,0)) X=$P(^(0),U);25"
  1.  .N BICOL S BICOL="    #  Community           State"
  1.  .D SEL^BISELECT(9999999.05,"BICC","Community",,,,BIID,BICOL,.BIPOP)
  1.  ;
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT8 ;EP
  1.  ;;You have the opportunity here to use the GPRA set of Communities.
  1.  ;;
  1.  ;;* Enter "G" to automatically use the GPRA set and proceed.
  1.  ;;* Enter "L" to LOAD the GPRA set and then edit your list before proceeding.
  1.  ;;* Enter "P" to load the PREVIOUS set of Communities you used.
  1.  ;;
  1.  D PRINTX("TEXT8")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HCF(BIHCF,BIRTN) ;EP
  1.  ;---> Select Health Care Facility(s).
  1.  ;---> Called by Protocol BI OUTPUT FACILITY.
  1.  ;---> Parameters:
  1.  ;     1 - BIHCF (ret) Local array of Health Care Facility IENs.
  1.  ;     2 - BIRTN (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  ;---> Default Facilty=DUZ(0); but if user decides to select more than
  1.  ;---> DUZ(0) site, goes to ^BISELECT and get user's previous list
  1.  ;---> (by killing the single BIHCF(DUZ(0))).
  1.  N M,N S (M,N)=0
  1.  F  S N=$O(BIHCF(N)) Q:'N  S M=M+1
  1.  K:M=1 BIHCF
  1.  ;
  1.  ;---> Code to display Area as an identifier.
  1.  N BIID
  1.  S BIID="1;I $G(BIIEN) S X=$P($G(^AUTTLOC(BIIEN,0)),U,4)"
  1.  S BIID=BIID_" I X S:$D(^AUTTAREA(X,0)) X=""  ""_$P(^(0),U);28"
  1.  N BICOL S BICOL="    #  Health Care Facility     IHS Area"
  1.  D SEL^BISELECT(4,"BIHCF","Health Care Facility",,,,BIID,BICOL,.BIPOP)
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. CMGR(BICM,BIRTN) ;EP
  1.  ;---> Select Case Managers.
  1.  ;---> Called by Protocol BI OUTPUT CASE MANAGER.
  1.  ;---> Parameters:
  1.  ;     1 - BICM   (ret) Local array of Current Community IENs.
  1.  ;     2 - BIRTN  (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  ;---> Select cases for one or more CASE MANAGERS (OR ALL).
  1.  N BISCRN S BISCRN="I $D(^BIMGR(Y,0))"
  1.  D SEL^BISELECT(9002084.01,"BICM","Case Manager",BISCRN,,,,,.BIPOP)
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DPRV(BIDPRV,BIRTN) ;EP
  1.  ;---> Select Designated Provider.
  1.  ;---> Called by Protocol BI OUTPUT DESIGNATED PROVIDER.
  1.  ;---> Parameters:
  1.  ;     1 - BIDPRV (ret) Designated Provider IENs.
  1.  ;     2 - BIRTN  (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  ;---> Select cases for one or more DESIGNATED PROVIDERS (OR ALL).
  1.  N BISCRN S BISCRN="I $D(^XUSEC(""PROVIDER"",Y))"
  1.  D SEL^BISELECT(200,"BIDPRV","Designated Provider",BISCRN,,,,,.BIPOP)
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. BEN(BIBEN,BIRTN) ;EP
  1.  ;---> Select Types of Beneficiaries.
  1.  ;---> Called by Protocol BI OUTPUT CASE MANAGER.
  1.  ;---> Parameters:
  1.  ;     1 - BIBEN  (ret) Local array of Beneficiary Types.
  1.  ;     2 - BIRTN  (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  ;---> Select cases for one or more BENEFICIARY TYPES (OR ALL).
  1.  N BINAM S BINAM="Beneficiary Type"
  1.  N BIID S BIID="2;;34"
  1.  N BICOL S BICOL="    #  Beneficiary Type             Code"
  1.  D SEL^BISELECT(9999999.25,"BIBEN",BINAM,,,,BIID,BICOL,.BIPOP)
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. VTYPE(BIVT,BIRTN) ;EP
  1.  ;---> Select Visit Types.
  1.  ;---> Called by Protocol BI OUTPUT CASE MANAGER.
  1.  ;---> Parameters:
  1.  ;     1 - BIBEN  (ret) Local array of VISIT Types.
  1.  ;     2 - BIRTN  (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  ;---> Select cases for one or more VISIT TYPES (OR ALL).
  1.  N BINAM S BINAM="Visit Type"
  1.  N BICOL S BICOL="    #  Visit Type                     Code"
  1.  D SEL^BISELECT(9000010,"BIVT",BINAM,,,,,BICOL,.BIPOP,,".03")
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. INCLHPV(BIHPV,BIRTN) ;EP
  1.  ;---> Answer Yes/No to include Hepatitis A in Quarterly Report.
  1.  ;---> Called by Protocol BI OUTPUT INCLUDE HPV.
  1.  ;---> Parameters:
  1.  ;     1 - BIHPV  (ret) 1=YES, 0=NO.
  1.  ;     2 - BIRTN  (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  D FULL^VALM1
  1.  D TITLE^BIUTL5("INCLUDE VARICELLA & PNEUMO IN REPORT")
  1.  D TEXT4 W ! N Y
  1.  D DIR^BIFMAN("YAO",.Y,,"   Include Varicella & Pneumo? (YES/NO): ","YES")
  1.  S:Y=0 BIHPV=0 S:Y=1 BIHPV=1
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT4 ;EP
  1.  ;;This option allows you to include Varicella and Pneumo
  1.  ;;in the statistics of the "Appropriate for Age" row at the
  1.  ;;top of the report.
  1.  ;;
  1.  ;;If you answer "YES,"  Varicella & Pneumo will appear in the
  1.  ;;Minimum needs header row at the top of the report and will
  1.  ;;count when computing whether patients are Appropriate for Age.
  1.  ;;
  1.  ;;Answer "NO" in order to exclude Varicella & Pneumo from the
  1.  ;;Minimum Needs when computing Appropriate for Age statistics.
  1.  ;;
  1.  ;;In both cases, the statistics for Varicella & Pneumo will be
  1.  ;;displayed individually in additional rows at the bottom of the
  1.  ;;report.
  1.  ;;
  1.  D PRINTX("TEXT4")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. INCLCPT(BICPT,BIRTN) ;EP
  1.  ;---> Answer Yes/No to include CPT Coded Visits in report.
  1.  ;---> Called by Protocol BI OUTPUT INCLUDE CPT.
  1.  ;---> Parameters:
  1.  ;     1 - BICPT  (ret) 1=YES, 0=NO.
  1.  ;     2 - BIRTN  (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  D FULL^VALM1
  1.  D TITLE^BIUTL5("INCLUDE CPT CODED VISITS IN REPORT")
  1.  D TEXT5 W ! N Y
  1.  D DIR^BIFMAN("YAO",.Y,,"   Include CPT Coded Visits in report? (YES/NO): ")
  1.  S:Y=0 BICPT=0 S:Y=1 BICPT=1
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT5 ;EP
  1.  ;;This option allows you to include CPT Coded Visits in the report.
  1.  ;;
  1.  ;;Explanation: Most immunizations will be recorded as Immunization
  1.  ;;Visits and will be included in this report.  However, it is possible
  1.  ;;that some immunizations were recorded only by CPT Code for the
  1.  ;;patient's visit and not actually recorded in the Immunization Files;
  1.  ;;in other words, not entered via the Immunization Package.
  1.  ;;
  1.  ;;Answer "YES" to this question if you wish to have the report search
  1.  ;;for any immunizations that were only entered as CPT Codes, and to
  1.  ;;include those immunizations in the statistical results of this report.
  1.  ;;NOTE: Including CPT Coded visits may cause some patients to appear on
  1.  ;;the report's patient roster who do not have immunizations recorded in
  1.  ;;the Immunization Package.
  1.  ;;
  1.  ;;Answer "NO" to ignore any immunizations that might have been recorded
  1.  ;;only by CPT Coding.
  1.  D PRINTX("TEXT5")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DISP24M(BIAGRPS,BIRTN) ;EP
  1.  ;---> Answer Yes/No to display the 24-month column in the Two-Yr-Old Report.
  1.  ;---> Called by Protocol BI OUTPUT DISPLAY 24-MO COLUMN.
  1.  ;---> Parameters:
  1.  ;     1 - BIAGRPS (ret) 1=Display 24-Month Column, 0=Do not.
  1.  ;     2 - BIRTN   (req) Calling routine for reset.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  ;
  1.  D FULL^VALM1
  1.  D TITLE^BIUTL5("DISPLAY 24-MONTH COLUMN")
  1.  D TEXT7 W ! N Y
  1.  D DIR^BIFMAN("YAO",.Y,,"     Display 24-Month column on report? (YES/NO): ")
  1.  S:Y=0 BIAGRPS="3,5,7,16,19,36" S:Y=1 BIAGRPS="3,5,7,16,19,24,36"
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT7 ;EP
  1.  ;;This option allows you to specifiy whether the 24-Month Column
  1.  ;;should appear in the Two-Yr-Old Report.  The final totals in the
  1.  ;;report will not be affected by this choice.
  1.  ;;
  1.  D PRINTX("TEXT7")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HELPTX(BILINL,BITAB) ;EP
  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'[";;"  S DIR("?",I)=T_$P(X,";;",2)
  1.  S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
  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