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

BIOUTPT4.m

Go to the documentation of this file. 
  1. BIOUTPT4 ;IHS/CMI/MWR - PROMPTS FOR REPORTS.; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  PROMPTS FOR REPORT PARAMETERS.
  1.  ;
  1.  ;
  1.  ;----------
  1. PGROUP1(BIPG,BIRTN) ;EP
  1.  ;---> Select Patient Group.
  1.  ;---> Called by Protocol BI OUTPUT PATIENT GROUP.
  1.  ;---> Parameters:
  1.  ;     1 - BIPG  (ret) Patient Group numbers 1-8, 1-7 may be combined.
  1.  ;                     Patient Group (^-pc 1): 1=DUE, 2=PAST DUE, 3=ACTIVE,
  1.  ;                     4=INACTIVE, 5=AUTOMATICALLY ACTIVATED, 6=REFUSALS
  1.  ;                     7=FEMALES ONLY, 8=SEARCH TEMPLATE.
  1.  ;                     If ^-pc1=2, then pc2=Minimum number of months past due.
  1.  ;                     If ^-pc1=4, then pc4=Date Range for date made Inactive:
  1.  ;                                             BeginDate_":"_EndDate
  1.  ;                     If ^-pc1=5, then pc5=Date Range for Auto Activated:
  1.  ;                                             BeginDate_":"_EndDate
  1.  ;                     If ^-pc1=6, then pc6=Date Range for Auto Activated:
  1.  ;                                             BeginDate_":"_EndDate_"|"_
  1.  ;                                             Vaccine IEN(1)_"|"_Vaccine IEN(2), etc.
  1.  ;                     If ^-pc1=8, then pc8=IEN of Search Template of patients.
  1.  ;
  1.  ;     2 - BIRTN (req) Calling routine for reset.
  1.  ;
  1.  ;
  1. PGRP11 ;---> Go here if 8 selected with other attributes.
  1.  ;
  1.  I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
  1.  S:'$G(BIPG) BIPG=3
  1.  D FULL^VALM1
  1.  D TITLE^BIUTL5("PATIENT GROUP"),TEXT1 W !
  1.  N DIR,Y S DIR("A")="   Select Patient Group: "
  1.  S DIR(0)="LAO^1:8"
  1.  S DIR("?")="^D HELP1^BIOUTPT4"
  1.  S DIR("B")=$P(BIPG,U)
  1.  D ^DIR
  1.  I (Y=-1)!("@^"[$E(Y)) S:'$G(BIPG) BIPG=3 D @("RESET^"_BIRTN) Q
  1.  D
  1.  .;---> If both 1 and 2 (DUE and PAST DUE), remove 2.
  1.  .I Y[1&(Y[2) S Y=$P(Y,2)_$P(Y,2,2)
  1.  .;---> Remove extraneous commas.
  1.  .I Y[",," S Y=$P(Y,",,")_","_$P(Y,",,",2)
  1.  .I '$E(Y) S Y=$E(Y,2,99)
  1.  .I '$E(Y,$L(Y)) S Y=$E(Y,1,$L(Y)-1)
  1.  .S $P(BIPG,U)=Y
  1.  ;
  1.  ;---> If Search Template was used in combo with others, start over.
  1.  I $P(BIPG,U)'=8&($P(BIPG,U)[8) D  G PGRP11
  1.  .W !!?5,"8 - SEARCH TEMPLATE is a pre-defined group of Patients and"
  1.  .W !?9,"may not be used in combination with other Patient Groups."
  1.  .K DIR("B") D DIRZ^BIUTL3(.BIPOP) S BIPG=1
  1.  ;
  1.  ;
  1.  ;---> If 2-PAST DUE, get months Past Due.
  1.  D:$P(BIPG,U)[2
  1.  .N X D PASTNU(.X)
  1.  .I '$G(X) S BIPG=1 Q
  1.  .S BIPG=BIPG_U_X
  1.  .S $P(BIPG,U,2)=X
  1.  .;
  1.  .;---> If Past Due only, make explicit this will be Active only.
  1.  .;I $P(BIPG,U)=2 S $P(BIPG,U)="2,3"
  1.  ;
  1.  ;
  1.  ;---> If 4-INACTIVE, get Date Range.
  1.  N BIPOP
  1.  D:$P(BIPG,U)[4
  1.  .N BIBEGDT,BIENDDT,BIBEGDF,BIENDDF,X,Y
  1.  .S X=$P(BIPG,U,4) S BIBEGDF=$P(X,":"),BIENDDF=$P(X,":",2)
  1.  .S:'BIBEGDF BIBEGDF=2000101 S:'BIENDDF BIENDDF=$G(DT)
  1.  .D TITLE^BIUTL5("SELECT INACTIVE DATE RANGE")
  1.  .D TEXT3 W !
  1.  .N DIR S DIR(0)="YA",DIR("A")="     Enter Yes or No: ",DIR("B")="YES"
  1.  .S DIR("?",1)="       Enter YES to limit the group to an Inactive date range."
  1.  .S DIR("?")="       Enter No to include ALL Inactive Patients."
  1.  .D ^DIR W !
  1.  .I 'Y S $P(BIPG,U,4)="2000101:"_$G(DT) Q
  1.  .;---> Specify a date range.
  1.  .D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,BIBEGDF,BIENDDF)
  1.  .Q:$G(BIPOP)
  1.  .S:'BIBEGDT BIBEGDT=2000101 S:'BIENDDT BIENDDT=$G(DT)
  1.  .S $P(BIPG,U,4)=BIBEGDT_":"_BIENDDT
  1.  G:$G(BIPOP) PGRP11
  1.  ;
  1.  ;
  1.  ;---> If 5-Automatically Activated, get Date Range.
  1.  N BIPOP
  1.  D:$P(BIPG,U)[5
  1.  .N BIBEGDT,BIENDDT,BIBEGDF,BIENDDF,X,Y,Z
  1.  .S X=$P(BIPG,U,5) S BIBEGDF=$P(X,":"),BIENDDF=$P(X,":",2)
  1.  .S:'BIBEGDF BIBEGDF=2000101 S:'BIENDDF BIENDDF=$G(DT)
  1.  .D TITLE^BIUTL5("SELECT AUTO-ACTIVATED DATE RANGE")
  1.  .D TEXT4 W !
  1.  .N DIR S DIR(0)="YA",DIR("A")="     Enter Yes or No: ",DIR("B")="YES"
  1.  .S Z="       Enter YES to limit the group to Actvated within date range."
  1.  .S DIR("?",1)=Z
  1.  .S DIR("?")="       Enter No to include ALL Automatically Activated Patients."
  1.  .D ^DIR W !
  1.  .I 'Y S $P(BIPG,U,5)="2000101:"_$G(DT) Q
  1.  .;---> Specify a date range.
  1.  .D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,BIBEGDF,BIENDDF)
  1.  .Q:$G(BIPOP)
  1.  .S:'BIBEGDT BIBEGDT=2000101 S:'BIENDDT BIENDDT=$G(DT)
  1.  .S $P(BIPG,U,5)=BIBEGDT_":"_BIENDDT
  1.  G:$G(BIPOP) PGRP11
  1.  ;
  1.  ;*********************************
  1.  ;
  1.  ;                     If ^-pc1=6, then pc6=Date Range for Auto Activated:
  1.  ;                                             BeginDate_":"_EndDate_"|"_
  1.  ;                                             Vaccine IEN(1)_"|"_Vaccine IEN(2), etc.
  1.  ;
  1.  ;---> If 6-Refusals, get particular Vaccines and Date Range.
  1.  ;N BIPOP
  1.  ;D:$P(BIPG,U)[6
  1.  ;.N BIBEGDT,BIENDDT,BIBEGDF,BIENDDF,X,Y,Z
  1.  ;.S X=$P(BIPG,U,5) S BIBEGDF=$P(X,":"),BIENDDF=$P(X,":",2)
  1.  ;.S:'BIBEGDF BIBEGDF=2000101 S:'BIENDDF BIENDDF=$G(DT)
  1.  ;.D TITLE^BIUTL5("SELECT REFUSALS DATE RANGE")
  1.  ;.D TEXT5 W !
  1.  ;.N DIR S DIR(0)="YA",DIR("A")="     Enter Yes or No: ",DIR("B")="YES"
  1.  ;.S Z="       Enter YES to limit the group to Actvated within date range."
  1.  ;.S DIR("?",1)=Z
  1.  ;.S DIR("?")="       Enter No to include ALL Automatically Activated Patients."
  1.  ;.D ^DIR W !
  1.  ;.I 'Y S $P(BIPG,U,5)="2000101:"_$G(DT) Q
  1.  ;.;---> Specify a date range.
  1.  ;.D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,BIBEGDF,BIENDDF)
  1.  ;.Q:$G(BIPOP)
  1.  ;.S:'BIBEGDT BIBEGDT=2000101 S:'BIENDDT BIENDDT=$G(DT)
  1.  ;.S $P(BIPG,U,5)=BIBEGDT_":"_BIENDDT
  1.  ;G:$G(BIPOP) PGRP11
  1.  ;
  1.  ;*********************************
  1.  ;
  1.  ;---> If 8-SEARCH TEMPLATE, select Search Template.
  1.  N BITMPL
  1.  D:$P(BIPG,U)=8
  1.  .D SEARCH(.BITMPL)
  1.  .;---> Set BIPG=8^^^^^^^IEN of Template.
  1.  .S $P(BIPG,U,8)=BITMPL
  1.  ;---> If user failed to choose a Search Template, change Patient Group
  1.  ;--->back to default (Active).
  1.  I $P(BIPG,U)=8&($G(BITMPL)<1) S $P(BIPG,U)=3 G PGRP11
  1.  ;
  1.  D:($P(BIPG,U)'=8)
  1.  .D TITLE^BIUTL5("INDIANS/AK NATIVES ONLY or ALL PATIENTS")
  1.  .D TEXT7
  1.  .S B=$S($D(BIBEN("ALL")):"Yes",1:"No") K BIBEN
  1.  .D DIR^BIFMAN("YAO",.Y,,"     Include non-Native Beneficiaries? (Yes/No): ",B)
  1.  .I 'Y S BIBEN(1)="" Q
  1.  .S BIBEN("ALL")=""
  1.  ;
  1.  D @("RESET^"_BIRTN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HELP1 ;EP
  1.  ;---> Help for Select Order prompt.
  1.  N BITEXT D TEXT11^BIOUTPT5(.BITEXT)
  1.  D START^BIHELP("PATIENT GROUP - HELP",.BITEXT)
  1.  D FULL^VALM1,TITLE^BIUTL5("PATIENT GROUP"),TEXT1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT1 ;EP
  1.  ;;Please select the Patient Group for this list or letter.
  1.  ;;You may include any combination of attributes 1-6 by entering the
  1.  ;;numbers separated by commas.  For example: 1,3,4 would produce a
  1.  ;;list of both ACTIVE and INACTIVE Patients DUE for immunizations.
  1.  ;;
  1.  ;;DUE and PAST DUE, if selected alone, will include only ACTIVE
  1.  ;;patients, unless INACTIVE is also selected.
  1.  ;;
  1.  ;;   1 - DUE......................(Patients Due for immunizations)
  1.  ;;   2 - PAST DUE.................(Only Patients who are PAST Due)
  1.  ;;   3 - ACTIVE...................(List of Active Patients)
  1.  ;;   4 - INACTIVE.................(Inactive Patients, by date if desired)
  1.  ;;   5 - AUTOMATICALLY ACTIVATED..(By date if desired)
  1.  ;;   6 - REFUSALS.................(Patients who have refused any vaccines)
  1.  ;;   7 - FEMALES ONLY.............(Only female patients included)
  1.  ;;   8 - SEARCH TEMPLATE..........(Pre-selected group of Patients)
  1.  ;;   Enter "?" for further explanation.
  1.  D PRINTX("TEXT1")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PASTNU(BIPG1) ;EP
  1.  ;---> Select minimum number of months Past Due.
  1.  ;---> Parameters:
  1.  ;     1 - BIPG1 (ret) BIPG1=Number of months PAST DUE or greater.
  1.  ;
  1.  ;---> Select Order of sort.
  1.  S BIPG1=0
  1.  D FULL^VALM1
  1.  D TITLE^BIUTL5("NUMBER OF MONTHS PAST DUE")
  1.  D TEXT2 N DIR
  1.  N DIR D HELP2
  1.  S DIR("A")="   Number of Months Past Due: "
  1.  S DIR(0)="NA^1:999:0"
  1.  D ^DIR
  1.  S BIPG1=+Y S:BIPG1<1 BIPG1=0
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT2 ;EP
  1.  ;;You have chosen to limit this listing to patients who are
  1.  ;;PAST DUE for one or more immunizations.  You must now specify
  1.  ;;the MINIMUM number of months a patient must be PAST DUE to be
  1.  ;;included in this listing.
  1.  ;;
  1.  ;;NOTE: This will be the number of months that the patient was
  1.  ;;      PAST DUE before the Forecast/Clinic Date you select
  1.  ;;      (not necessarily the number of months before today!).
  1.  ;;
  1.  D PRINTX("TEXT2")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT3 ;EP
  1.  ;;You have chosen to include Patients who are Inactive.
  1.  ;;
  1.  ;;You may include ALL Patients who are Inactive, or you may
  1.  ;;limit the group of Inactive Patients to those who were made
  1.  ;;Inactive within a specified date range.
  1.  ;;
  1.  ;;Would you like to limit the list of Inactive Patients to a specific
  1.  ;;date range?  In other words, include only patients who were made
  1.  ;;Inactive after a particular date and before a later date?
  1.  ;;
  1.  D PRINTX("TEXT3")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT4 ;EP
  1.  ;;You have chosen to limit this list to Patients who were
  1.  ;;Automatically Activated.
  1.  ;;
  1.  ;;You may include ALL Patients who were Automatically Activated,
  1.  ;;or you may limit the group to Patients who were Automatically
  1.  ;;Activated within a specified date range.
  1.  ;;
  1.  ;;Would you like to limit the list of Patients who were Automatically
  1.  ;;Activated within a specific date range?  In other words, include only
  1.  ;;patients who were Activated after a particular date and before
  1.  ;;a later date?
  1.  ;;
  1.  D PRINTX("TEXT4")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT5 ;EP
  1.  ;;You have chosen to limit this list to patients who have Refusals
  1.  ;;on record.
  1.  ;;
  1.  ;;You may include patients who have Refusals for ANY vaccine, or
  1.  ;;you may limit the list to refusals for one or more specific vaccines.
  1.  ;;
  1.  ;;Would you like to limit the list to Refusals of one or more specific
  1.  ;;vaccines?
  1.  ;;
  1.  D PRINTX("TEXT5")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT6 ;EP
  1.  ;;You have chosen to limit this list to patients who have Refusals
  1.  ;;on record.
  1.  ;;
  1.  ;;Would you like to limit the list to Refusals that were recorded
  1.  ;;within a specific date range?
  1.  ;;
  1.  D PRINTX("TEXT6")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT7 ;EP
  1.  ;;Ordinarilly Lists & Letters looks only at American Indians and Alaska
  1.  ;;Natives, also known by the Beneficiary Type Code 01.
  1.  ;;
  1.  ;;Would you like to expand the list to include patients of all Beneficiary
  1.  ;;Types (includes Dependents of Comm Officers, Retired Military, etc.)?
  1.  ;;
  1.  D PRINTX("TEXT7")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HELP2 ;EP
  1.  ;;Enter a number which will be the minimum number of months
  1.  ;;PAST DUE for patients to be included in the listing.
  1.  ;;
  1.  ;;For example, if you enter "3", then any patient with at least one
  1.  ;;immunization 3 months or more past due would be included.  A patient
  1.  ;;with an immunization only 2 months past due would not be included.
  1.  ;;
  1.  ;;NOTE: The months PAST DUE will be calculated from the Forecast/
  1.  ;;      Clinic Date you select (not necessarily from today).
  1.  D HELPTX("HELP2")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1.  ;---> Select Search Template of patients.
  1.  ;---> Parameters:
  1.  ;     1 - BITMPL (ret) IEN of Search Template in File #.401, or
  1.  ;                      BITMPL=-1 if lookup failed.
  1.  ;
  1. SEARCH1 ;
  1.  D TITLE^BIUTL5("SEARCH TEMPLATE SELECTION")
  1.  N BIA,BIS S BIPOP=0,BITMPL=""
  1.  S BIA="     Select Patient SEARCH TEMPLATE name: "
  1.  S BIS="I $P(^"_"(0),U,4)=2!($P(^(0),U,4)=9000001)"
  1.  D DIC^BIFMAN(.401,"QEMA",.Y,BIA,,BIS)
  1.  S BITMPL=+Y
  1.  Q:BITMPL<1
  1.  ;
  1.  ;---> Display Template info for confirmation.
  1.  D TITLE^BIUTL5("SEARCH TEMPLATE SELECTION")
  1.  W !!?5,"You have selected the following Patient Search Template: "
  1.  W !!?9,"Name...: ",$P(^DIBT(BITMPL,0),U)
  1.  W !?9,"Created: ",$$TXDT1^BIUTL5($P(^DIBT(BITMPL,0),U,2))
  1.  W " by ",$$PERSON^BIUTL1($P(^DIBT(BITMPL,0),U,5))
  1.  W !?9,"Total..: "
  1.  D
  1.  .N M,N S M=0,N=0
  1.  .F  S N=$O(^DIBT(BITMPL,1,N)) Q:'N  S M=M+1
  1.  .W M," Patient",$S(M>1:"s",1:"")
  1.  W !!?5,"Description: "
  1.  W !?5,"------------ "
  1.  D
  1.  .I '$O(^DIBT(BITMPL,"%D",0)) W !?5,"None." Q
  1.  .N I,N S N=0
  1.  .F I=1:1:7 S N=$O(^DIBT(BITMPL,"%D",N)) Q:'N  D
  1.  ..W !?5,$G(^DIBT(BITMPL,"%D",N,0))
  1.  .D:$O(^DIBT(BITMPL,"%D",N))
  1.  ..W !?5,"(More...see template for full description.)"
  1.  ;
  1.  W !
  1.  N B,BIPOP S BIPOP=0
  1.  S B="     Use this Template for your List? (Yes/No): "
  1.  S B(1)="     Enter Yes to select this Template."
  1.  S B(2)="     Enter No to select another Template."
  1.  D DIR^BIFMAN("YA",.Y,,B,"Yes",B(2),B(1))
  1.  ;
  1.  ;---> Failed to confirm.
  1.  I Y<1 D  G SEARCH1
  1.  .W !?5,"Okay, let's begin again..." D DIRZ^BIUTL3()
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. LOADTX(BILINL,BITAB,BITEXT) ;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'[";;"  S BITEXT(I)=T_$P(X,";;",2)
  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. 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