BIOUTPT4 ;IHS/CMI/MWR - PROMPTS FOR REPORTS.; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; PROMPTS FOR REPORT PARAMETERS.
;
;
;----------
PGROUP1(BIPG,BIRTN) ;EP
;---> Select Patient Group.
;---> Called by Protocol BI OUTPUT PATIENT GROUP.
;---> Parameters:
; 1 - BIPG (ret) Patient Group numbers 1-8, 1-7 may be combined.
; Patient Group (^-pc 1): 1=DUE, 2=PAST DUE, 3=ACTIVE,
; 4=INACTIVE, 5=AUTOMATICALLY ACTIVATED, 6=REFUSALS
; 7=FEMALES ONLY, 8=SEARCH TEMPLATE.
; If ^-pc1=2, then pc2=Minimum number of months past due.
; If ^-pc1=4, then pc4=Date Range for date made Inactive:
; BeginDate_":"_EndDate
; If ^-pc1=5, then pc5=Date Range for Auto Activated:
; BeginDate_":"_EndDate
; If ^-pc1=6, then pc6=Date Range for Auto Activated:
; BeginDate_":"_EndDate_"|"_
; Vaccine IEN(1)_"|"_Vaccine IEN(2), etc.
; If ^-pc1=8, then pc8=IEN of Search Template of patients.
;
; 2 - BIRTN (req) Calling routine for reset.
;
;
PGRP11 ;---> Go here if 8 selected with other attributes.
;
I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q
S:'$G(BIPG) BIPG=3
D FULL^VALM1
D TITLE^BIUTL5("PATIENT GROUP"),TEXT1 W !
N DIR,Y S DIR("A")=" Select Patient Group: "
S DIR(0)="LAO^1:8"
S DIR("?")="^D HELP1^BIOUTPT4"
S DIR("B")=$P(BIPG,U)
D ^DIR
I (Y=-1)!("@^"[$E(Y)) S:'$G(BIPG) BIPG=3 D @("RESET^"_BIRTN) Q
D
.;---> If both 1 and 2 (DUE and PAST DUE), remove 2.
.I Y[1&(Y[2) S Y=$P(Y,2)_$P(Y,2,2)
.;---> Remove extraneous commas.
.I Y[",," S Y=$P(Y,",,")_","_$P(Y,",,",2)
.I '$E(Y) S Y=$E(Y,2,99)
.I '$E(Y,$L(Y)) S Y=$E(Y,1,$L(Y)-1)
.S $P(BIPG,U)=Y
;
;---> If Search Template was used in combo with others, start over.
I $P(BIPG,U)'=8&($P(BIPG,U)[8) D G PGRP11
.W !!?5,"8 - SEARCH TEMPLATE is a pre-defined group of Patients and"
.W !?9,"may not be used in combination with other Patient Groups."
.K DIR("B") D DIRZ^BIUTL3(.BIPOP) S BIPG=1
;
;
;---> If 2-PAST DUE, get months Past Due.
D:$P(BIPG,U)[2
.N X D PASTNU(.X)
.I '$G(X) S BIPG=1 Q
.S BIPG=BIPG_U_X
.S $P(BIPG,U,2)=X
.;
.;---> If Past Due only, make explicit this will be Active only.
.;I $P(BIPG,U)=2 S $P(BIPG,U)="2,3"
;
;
;---> If 4-INACTIVE, get Date Range.
N BIPOP
D:$P(BIPG,U)[4
.N BIBEGDT,BIENDDT,BIBEGDF,BIENDDF,X,Y
.S X=$P(BIPG,U,4) S BIBEGDF=$P(X,":"),BIENDDF=$P(X,":",2)
.S:'BIBEGDF BIBEGDF=2000101 S:'BIENDDF BIENDDF=$G(DT)
.D TITLE^BIUTL5("SELECT INACTIVE DATE RANGE")
.D TEXT3 W !
.N DIR S DIR(0)="YA",DIR("A")=" Enter Yes or No: ",DIR("B")="YES"
.S DIR("?",1)=" Enter YES to limit the group to an Inactive date range."
.S DIR("?")=" Enter No to include ALL Inactive Patients."
.D ^DIR W !
.I 'Y S $P(BIPG,U,4)="2000101:"_$G(DT) Q
.;---> Specify a date range.
.D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,BIBEGDF,BIENDDF)
.Q:$G(BIPOP)
.S:'BIBEGDT BIBEGDT=2000101 S:'BIENDDT BIENDDT=$G(DT)
.S $P(BIPG,U,4)=BIBEGDT_":"_BIENDDT
G:$G(BIPOP) PGRP11
;
;
;---> If 5-Automatically Activated, get Date Range.
N BIPOP
D:$P(BIPG,U)[5
.N BIBEGDT,BIENDDT,BIBEGDF,BIENDDF,X,Y,Z
.S X=$P(BIPG,U,5) S BIBEGDF=$P(X,":"),BIENDDF=$P(X,":",2)
.S:'BIBEGDF BIBEGDF=2000101 S:'BIENDDF BIENDDF=$G(DT)
.D TITLE^BIUTL5("SELECT AUTO-ACTIVATED DATE RANGE")
.D TEXT4 W !
.N DIR S DIR(0)="YA",DIR("A")=" Enter Yes or No: ",DIR("B")="YES"
.S Z=" Enter YES to limit the group to Actvated within date range."
.S DIR("?",1)=Z
.S DIR("?")=" Enter No to include ALL Automatically Activated Patients."
.D ^DIR W !
.I 'Y S $P(BIPG,U,5)="2000101:"_$G(DT) Q
.;---> Specify a date range.
.D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,BIBEGDF,BIENDDF)
.Q:$G(BIPOP)
.S:'BIBEGDT BIBEGDT=2000101 S:'BIENDDT BIENDDT=$G(DT)
.S $P(BIPG,U,5)=BIBEGDT_":"_BIENDDT
G:$G(BIPOP) PGRP11
;
;*********************************
;
; If ^-pc1=6, then pc6=Date Range for Auto Activated:
; BeginDate_":"_EndDate_"|"_
; Vaccine IEN(1)_"|"_Vaccine IEN(2), etc.
;
;---> If 6-Refusals, get particular Vaccines and Date Range.
;N BIPOP
;D:$P(BIPG,U)[6
;.N BIBEGDT,BIENDDT,BIBEGDF,BIENDDF,X,Y,Z
;.S X=$P(BIPG,U,5) S BIBEGDF=$P(X,":"),BIENDDF=$P(X,":",2)
;.S:'BIBEGDF BIBEGDF=2000101 S:'BIENDDF BIENDDF=$G(DT)
;.D TITLE^BIUTL5("SELECT REFUSALS DATE RANGE")
;.D TEXT5 W !
;.N DIR S DIR(0)="YA",DIR("A")=" Enter Yes or No: ",DIR("B")="YES"
;.S Z=" Enter YES to limit the group to Actvated within date range."
;.S DIR("?",1)=Z
;.S DIR("?")=" Enter No to include ALL Automatically Activated Patients."
;.D ^DIR W !
;.I 'Y S $P(BIPG,U,5)="2000101:"_$G(DT) Q
;.;---> Specify a date range.
;.D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,BIBEGDF,BIENDDF)
;.Q:$G(BIPOP)
;.S:'BIBEGDT BIBEGDT=2000101 S:'BIENDDT BIENDDT=$G(DT)
;.S $P(BIPG,U,5)=BIBEGDT_":"_BIENDDT
;G:$G(BIPOP) PGRP11
;
;*********************************
;
;---> If 8-SEARCH TEMPLATE, select Search Template.
N BITMPL
D:$P(BIPG,U)=8
.D SEARCH(.BITMPL)
.;---> Set BIPG=8^^^^^^^IEN of Template.
.S $P(BIPG,U,8)=BITMPL
;---> If user failed to choose a Search Template, change Patient Group
;--->back to default (Active).
I $P(BIPG,U)=8&($G(BITMPL)<1) S $P(BIPG,U)=3 G PGRP11
;
D:($P(BIPG,U)'=8)
.D TITLE^BIUTL5("INDIANS/AK NATIVES ONLY or ALL PATIENTS")
.D TEXT7
.S B=$S($D(BIBEN("ALL")):"Yes",1:"No") K BIBEN
.D DIR^BIFMAN("YAO",.Y,," Include non-Native Beneficiaries? (Yes/No): ",B)
.I 'Y S BIBEN(1)="" Q
.S BIBEN("ALL")=""
;
D @("RESET^"_BIRTN)
Q
;
;
;----------
HELP1 ;EP
;---> Help for Select Order prompt.
N BITEXT D TEXT11^BIOUTPT5(.BITEXT)
D START^BIHELP("PATIENT GROUP - HELP",.BITEXT)
D FULL^VALM1,TITLE^BIUTL5("PATIENT GROUP"),TEXT1
Q
;
;
;----------
TEXT1 ;EP
;;Please select the Patient Group for this list or letter.
;;You may include any combination of attributes 1-6 by entering the
;;numbers separated by commas. For example: 1,3,4 would produce a
;;list of both ACTIVE and INACTIVE Patients DUE for immunizations.
;;
;;DUE and PAST DUE, if selected alone, will include only ACTIVE
;;patients, unless INACTIVE is also selected.
;;
;; 1 - DUE......................(Patients Due for immunizations)
;; 2 - PAST DUE.................(Only Patients who are PAST Due)
;; 3 - ACTIVE...................(List of Active Patients)
;; 4 - INACTIVE.................(Inactive Patients, by date if desired)
;; 5 - AUTOMATICALLY ACTIVATED..(By date if desired)
;; 6 - REFUSALS.................(Patients who have refused any vaccines)
;; 7 - FEMALES ONLY.............(Only female patients included)
;; 8 - SEARCH TEMPLATE..........(Pre-selected group of Patients)
;; Enter "?" for further explanation.
D PRINTX("TEXT1")
Q
;
;
;----------
PASTNU(BIPG1) ;EP
;---> Select minimum number of months Past Due.
;---> Parameters:
; 1 - BIPG1 (ret) BIPG1=Number of months PAST DUE or greater.
;
;---> Select Order of sort.
S BIPG1=0
D FULL^VALM1
D TITLE^BIUTL5("NUMBER OF MONTHS PAST DUE")
D TEXT2 N DIR
N DIR D HELP2
S DIR("A")=" Number of Months Past Due: "
S DIR(0)="NA^1:999:0"
D ^DIR
S BIPG1=+Y S:BIPG1<1 BIPG1=0
Q
;
;
;----------
TEXT2 ;EP
;;You have chosen to limit this listing to patients who are
;;PAST DUE for one or more immunizations. You must now specify
;;the MINIMUM number of months a patient must be PAST DUE to be
;;included in this listing.
;;
;;NOTE: This will be the number of months that the patient was
;; PAST DUE before the Forecast/Clinic Date you select
;; (not necessarily the number of months before today!).
;;
D PRINTX("TEXT2")
Q
;
;
;----------
TEXT3 ;EP
;;You have chosen to include Patients who are Inactive.
;;
;;You may include ALL Patients who are Inactive, or you may
;;limit the group of Inactive Patients to those who were made
;;Inactive within a specified date range.
;;
;;Would you like to limit the list of Inactive Patients to a specific
;;date range? In other words, include only patients who were made
;;Inactive after a particular date and before a later date?
;;
D PRINTX("TEXT3")
Q
;
;
;----------
TEXT4 ;EP
;;You have chosen to limit this list to Patients who were
;;Automatically Activated.
;;
;;You may include ALL Patients who were Automatically Activated,
;;or you may limit the group to Patients who were Automatically
;;Activated within a specified date range.
;;
;;Would you like to limit the list of Patients who were Automatically
;;Activated within a specific date range? In other words, include only
;;patients who were Activated after a particular date and before
;;a later date?
;;
D PRINTX("TEXT4")
Q
;
;
;----------
TEXT5 ;EP
;;You have chosen to limit this list to patients who have Refusals
;;on record.
;;
;;You may include patients who have Refusals for ANY vaccine, or
;;you may limit the list to refusals for one or more specific vaccines.
;;
;;Would you like to limit the list to Refusals of one or more specific
;;vaccines?
;;
D PRINTX("TEXT5")
Q
;
;
;----------
TEXT6 ;EP
;;You have chosen to limit this list to patients who have Refusals
;;on record.
;;
;;Would you like to limit the list to Refusals that were recorded
;;within a specific date range?
;;
D PRINTX("TEXT6")
Q
;
;
;----------
TEXT7 ;EP
;;Ordinarilly Lists & Letters looks only at American Indians and Alaska
;;Natives, also known by the Beneficiary Type Code 01.
;;
;;Would you like to expand the list to include patients of all Beneficiary
;;Types (includes Dependents of Comm Officers, Retired Military, etc.)?
;;
D PRINTX("TEXT7")
Q
;
;
;----------
HELP2 ;EP
;;Enter a number which will be the minimum number of months
;;PAST DUE for patients to be included in the listing.
;;
;;For example, if you enter "3", then any patient with at least one
;;immunization 3 months or more past due would be included. A patient
;;with an immunization only 2 months past due would not be included.
;;
;;NOTE: The months PAST DUE will be calculated from the Forecast/
;; Clinic Date you select (not necessarily from today).
D HELPTX("HELP2")
Q
;
;
;----------
SEARCH(BITMPL) ;EP
;---> Select Search Template of patients.
;---> Parameters:
; 1 - BITMPL (ret) IEN of Search Template in File #.401, or
; BITMPL=-1 if lookup failed.
;
SEARCH1 ;
D TITLE^BIUTL5("SEARCH TEMPLATE SELECTION")
N BIA,BIS S BIPOP=0,BITMPL=""
S BIA=" Select Patient SEARCH TEMPLATE name: "
S BIS="I $P(^"_"(0),U,4)=2!($P(^(0),U,4)=9000001)"
D DIC^BIFMAN(.401,"QEMA",.Y,BIA,,BIS)
S BITMPL=+Y
Q:BITMPL<1
;
;---> Display Template info for confirmation.
D TITLE^BIUTL5("SEARCH TEMPLATE SELECTION")
W !!?5,"You have selected the following Patient Search Template: "
W !!?9,"Name...: ",$P(^DIBT(BITMPL,0),U)
W !?9,"Created: ",$$TXDT1^BIUTL5($P(^DIBT(BITMPL,0),U,2))
W " by ",$$PERSON^BIUTL1($P(^DIBT(BITMPL,0),U,5))
W !?9,"Total..: "
D
.N M,N S M=0,N=0
.F S N=$O(^DIBT(BITMPL,1,N)) Q:'N S M=M+1
.W M," Patient",$S(M>1:"s",1:"")
W !!?5,"Description: "
W !?5,"------------ "
D
.I '$O(^DIBT(BITMPL,"%D",0)) W !?5,"None." Q
.N I,N S N=0
.F I=1:1:7 S N=$O(^DIBT(BITMPL,"%D",N)) Q:'N D
..W !?5,$G(^DIBT(BITMPL,"%D",N,0))
.D:$O(^DIBT(BITMPL,"%D",N))
..W !?5,"(More...see template for full description.)"
;
W !
N B,BIPOP S BIPOP=0
S B=" Use this Template for your List? (Yes/No): "
S B(1)=" Enter Yes to select this Template."
S B(2)=" Enter No to select another Template."
D DIR^BIFMAN("YA",.Y,,B,"Yes",B(2),B(1))
;
;---> Failed to confirm.
I Y<1 D G SEARCH1
.W !?5,"Okay, let's begin again..." D DIRZ^BIUTL3()
;
Q
;
;
;----------
LOADTX(BILINL,BITAB,BITEXT) ;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'[";;" S BITEXT(I)=T_$P(X,";;",2)
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
;
;
;----------
HELPTX(BILINL,BITAB) ;EP
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'[";;" S DIR("?",I)=T_$P(X,";;",2)
S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
Q
BIOUTPT4 ;IHS/CMI/MWR - PROMPTS FOR REPORTS.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; PROMPTS FOR REPORT PARAMETERS.
+4 ;
+5 ;
+6 ;----------
PGROUP1(BIPG,BIRTN) ;EP
+1 ;---> Select Patient Group.
+2 ;---> Called by Protocol BI OUTPUT PATIENT GROUP.
+3 ;---> Parameters:
+4 ; 1 - BIPG (ret) Patient Group numbers 1-8, 1-7 may be combined.
+5 ; Patient Group (^-pc 1): 1=DUE, 2=PAST DUE, 3=ACTIVE,
+6 ; 4=INACTIVE, 5=AUTOMATICALLY ACTIVATED, 6=REFUSALS
+7 ; 7=FEMALES ONLY, 8=SEARCH TEMPLATE.
+8 ; If ^-pc1=2, then pc2=Minimum number of months past due.
+9 ; If ^-pc1=4, then pc4=Date Range for date made Inactive:
+10 ; BeginDate_":"_EndDate
+11 ; If ^-pc1=5, then pc5=Date Range for Auto Activated:
+12 ; BeginDate_":"_EndDate
+13 ; If ^-pc1=6, then pc6=Date Range for Auto Activated:
+14 ; BeginDate_":"_EndDate_"|"_
+15 ; Vaccine IEN(1)_"|"_Vaccine IEN(2), etc.
+16 ; If ^-pc1=8, then pc8=IEN of Search Template of patients.
+17 ;
+18 ; 2 - BIRTN (req) Calling routine for reset.
+19 ;
+20 ;
PGRP11 ;---> Go here if 8 selected with other attributes.
+1 ;
+2 IF $GET(BIRTN)=""
DO ERRCD^BIUTL2(621,,1)
QUIT
+3 IF '$GET(BIPG)
SET BIPG=3
+4 DO FULL^VALM1
+5 DO TITLE^BIUTL5("PATIENT GROUP")
DO TEXT1
WRITE !
+6 NEW DIR,Y
SET DIR("A")=" Select Patient Group: "
+7 SET DIR(0)="LAO^1:8"
+8 SET DIR("?")="^D HELP1^BIOUTPT4"
+9 SET DIR("B")=$PIECE(BIPG,U)
+10 DO ^DIR
+11 IF (Y=-1)!("@^"[$EXTRACT(Y))
IF '$GET(BIPG)
SET BIPG=3
DO @("RESET^"_BIRTN)
QUIT
+12 Begin DoDot:1
+13 ;---> If both 1 and 2 (DUE and PAST DUE), remove 2.
+14 IF Y[1&(Y[2)
SET Y=$PIECE(Y,2)_$PIECE(Y,2,2)
+15 ;---> Remove extraneous commas.
+16 IF Y[",,"
SET Y=$PIECE(Y,",,")_","_$PIECE(Y,",,",2)
+17 IF '$EXTRACT(Y)
SET Y=$EXTRACT(Y,2,99)
+18 IF '$EXTRACT(Y,$LENGTH(Y))
SET Y=$EXTRACT(Y,1,$LENGTH(Y)-1)
+19 SET $PIECE(BIPG,U)=Y
End DoDot:1
+20 ;
+21 ;---> If Search Template was used in combo with others, start over.
+22 IF $PIECE(BIPG,U)'=8&($PIECE(BIPG,U)[8)
Begin DoDot:1
+23 WRITE !!?5,"8 - SEARCH TEMPLATE is a pre-defined group of Patients and"
+24 WRITE !?9,"may not be used in combination with other Patient Groups."
+25 KILL DIR("B")
DO DIRZ^BIUTL3(.BIPOP)
SET BIPG=1
End DoDot:1
GOTO PGRP11
+26 ;
+27 ;
+28 ;---> If 2-PAST DUE, get months Past Due.
+29 IF $PIECE(BIPG,U)[2
Begin DoDot:1
+30 NEW X
DO PASTNU(.X)
+31 IF '$GET(X)
SET BIPG=1
QUIT
+32 SET BIPG=BIPG_U_X
+33 SET $PIECE(BIPG,U,2)=X
+34 ;
+35 ;---> If Past Due only, make explicit this will be Active only.
+36 ;I $P(BIPG,U)=2 S $P(BIPG,U)="2,3"
End DoDot:1
+37 ;
+38 ;
+39 ;---> If 4-INACTIVE, get Date Range.
+40 NEW BIPOP
+41 IF $PIECE(BIPG,U)[4
Begin DoDot:1
+42 NEW BIBEGDT,BIENDDT,BIBEGDF,BIENDDF,X,Y
+43 SET X=$PIECE(BIPG,U,4)
SET BIBEGDF=$PIECE(X,":")
SET BIENDDF=$PIECE(X,":",2)
+44 IF 'BIBEGDF
SET BIBEGDF=2000101
IF 'BIENDDF
SET BIENDDF=$GET(DT)
+45 DO TITLE^BIUTL5("SELECT INACTIVE DATE RANGE")
+46 DO TEXT3
WRITE !
+47 NEW DIR
SET DIR(0)="YA"
SET DIR("A")=" Enter Yes or No: "
SET DIR("B")="YES"
+48 SET DIR("?",1)=" Enter YES to limit the group to an Inactive date range."
+49 SET DIR("?")=" Enter No to include ALL Inactive Patients."
+50 DO ^DIR
WRITE !
+51 IF 'Y
SET $PIECE(BIPG,U,4)="2000101:"_$GET(DT)
QUIT
+52 ;---> Specify a date range.
+53 DO ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,BIBEGDF,BIENDDF)
+54 IF $GET(BIPOP)
QUIT
+55 IF 'BIBEGDT
SET BIBEGDT=2000101
IF 'BIENDDT
SET BIENDDT=$GET(DT)
+56 SET $PIECE(BIPG,U,4)=BIBEGDT_":"_BIENDDT
End DoDot:1
+57 IF $GET(BIPOP)
GOTO PGRP11
+58 ;
+59 ;
+60 ;---> If 5-Automatically Activated, get Date Range.
+61 NEW BIPOP
+62 IF $PIECE(BIPG,U)[5
Begin DoDot:1
+63 NEW BIBEGDT,BIENDDT,BIBEGDF,BIENDDF,X,Y,Z
+64 SET X=$PIECE(BIPG,U,5)
SET BIBEGDF=$PIECE(X,":")
SET BIENDDF=$PIECE(X,":",2)
+65 IF 'BIBEGDF
SET BIBEGDF=2000101
IF 'BIENDDF
SET BIENDDF=$GET(DT)
+66 DO TITLE^BIUTL5("SELECT AUTO-ACTIVATED DATE RANGE")
+67 DO TEXT4
WRITE !
+68 NEW DIR
SET DIR(0)="YA"
SET DIR("A")=" Enter Yes or No: "
SET DIR("B")="YES"
+69 SET Z=" Enter YES to limit the group to Actvated within date range."
+70 SET DIR("?",1)=Z
+71 SET DIR("?")=" Enter No to include ALL Automatically Activated Patients."
+72 DO ^DIR
WRITE !
+73 IF 'Y
SET $PIECE(BIPG,U,5)="2000101:"_$GET(DT)
QUIT
+74 ;---> Specify a date range.
+75 DO ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,BIBEGDF,BIENDDF)
+76 IF $GET(BIPOP)
QUIT
+77 IF 'BIBEGDT
SET BIBEGDT=2000101
IF 'BIENDDT
SET BIENDDT=$GET(DT)
+78 SET $PIECE(BIPG,U,5)=BIBEGDT_":"_BIENDDT
End DoDot:1
+79 IF $GET(BIPOP)
GOTO PGRP11
+80 ;
+81 ;*********************************
+82 ;
+83 ; If ^-pc1=6, then pc6=Date Range for Auto Activated:
+84 ; BeginDate_":"_EndDate_"|"_
+85 ; Vaccine IEN(1)_"|"_Vaccine IEN(2), etc.
+86 ;
+87 ;---> If 6-Refusals, get particular Vaccines and Date Range.
+88 ;N BIPOP
+89 ;D:$P(BIPG,U)[6
+90 ;.N BIBEGDT,BIENDDT,BIBEGDF,BIENDDF,X,Y,Z
+91 ;.S X=$P(BIPG,U,5) S BIBEGDF=$P(X,":"),BIENDDF=$P(X,":",2)
+92 ;.S:'BIBEGDF BIBEGDF=2000101 S:'BIENDDF BIENDDF=$G(DT)
+93 ;.D TITLE^BIUTL5("SELECT REFUSALS DATE RANGE")
+94 ;.D TEXT5 W !
+95 ;.N DIR S DIR(0)="YA",DIR("A")=" Enter Yes or No: ",DIR("B")="YES"
+96 ;.S Z=" Enter YES to limit the group to Actvated within date range."
+97 ;.S DIR("?",1)=Z
+98 ;.S DIR("?")=" Enter No to include ALL Automatically Activated Patients."
+99 ;.D ^DIR W !
+100 ;.I 'Y S $P(BIPG,U,5)="2000101:"_$G(DT) Q
+101 ;.;---> Specify a date range.
+102 ;.D ASKDATES^BIUTL3(.BIBEGDT,.BIENDDT,.BIPOP,BIBEGDF,BIENDDF)
+103 ;.Q:$G(BIPOP)
+104 ;.S:'BIBEGDT BIBEGDT=2000101 S:'BIENDDT BIENDDT=$G(DT)
+105 ;.S $P(BIPG,U,5)=BIBEGDT_":"_BIENDDT
+106 ;G:$G(BIPOP) PGRP11
+107 ;
+108 ;*********************************
+109 ;
+110 ;---> If 8-SEARCH TEMPLATE, select Search Template.
+111 NEW BITMPL
+112 IF $PIECE(BIPG,U)=8
Begin DoDot:1
+113 DO SEARCH(.BITMPL)
+114 ;---> Set BIPG=8^^^^^^^IEN of Template.
+115 SET $PIECE(BIPG,U,8)=BITMPL
End DoDot:1
+116 ;---> If user failed to choose a Search Template, change Patient Group
+117 ;--->back to default (Active).
+118 IF $PIECE(BIPG,U)=8&($GET(BITMPL)<1)
SET $PIECE(BIPG,U)=3
GOTO PGRP11
+119 ;
+120 IF ($PIECE(BIPG,U)'=8)
Begin DoDot:1
+121 DO TITLE^BIUTL5("INDIANS/AK NATIVES ONLY or ALL PATIENTS")
+122 DO TEXT7
+123 SET B=$SELECT($DATA(BIBEN("ALL")):"Yes",1:"No")
KILL BIBEN
+124 DO DIR^BIFMAN("YAO",.Y,," Include non-Native Beneficiaries? (Yes/No): ",B)
+125 IF 'Y
SET BIBEN(1)=""
QUIT
+126 SET BIBEN("ALL")=""
End DoDot:1
+127 ;
+128 DO @("RESET^"_BIRTN)
+129 QUIT
+130 ;
+131 ;
+132 ;----------
HELP1 ;EP
+1 ;---> Help for Select Order prompt.
+2 NEW BITEXT
DO TEXT11^BIOUTPT5(.BITEXT)
+3 DO START^BIHELP("PATIENT GROUP - HELP",.BITEXT)
+4 DO FULL^VALM1
DO TITLE^BIUTL5("PATIENT GROUP")
DO TEXT1
+5 QUIT
+6 ;
+7 ;
+8 ;----------
TEXT1 ;EP
+1 ;;Please select the Patient Group for this list or letter.
+2 ;;You may include any combination of attributes 1-6 by entering the
+3 ;;numbers separated by commas. For example: 1,3,4 would produce a
+4 ;;list of both ACTIVE and INACTIVE Patients DUE for immunizations.
+5 ;;
+6 ;;DUE and PAST DUE, if selected alone, will include only ACTIVE
+7 ;;patients, unless INACTIVE is also selected.
+8 ;;
+9 ;; 1 - DUE......................(Patients Due for immunizations)
+10 ;; 2 - PAST DUE.................(Only Patients who are PAST Due)
+11 ;; 3 - ACTIVE...................(List of Active Patients)
+12 ;; 4 - INACTIVE.................(Inactive Patients, by date if desired)
+13 ;; 5 - AUTOMATICALLY ACTIVATED..(By date if desired)
+14 ;; 6 - REFUSALS.................(Patients who have refused any vaccines)
+15 ;; 7 - FEMALES ONLY.............(Only female patients included)
+16 ;; 8 - SEARCH TEMPLATE..........(Pre-selected group of Patients)
+17 ;; Enter "?" for further explanation.
+18 DO PRINTX("TEXT1")
+19 QUIT
+20 ;
+21 ;
+22 ;----------
PASTNU(BIPG1) ;EP
+1 ;---> Select minimum number of months Past Due.
+2 ;---> Parameters:
+3 ; 1 - BIPG1 (ret) BIPG1=Number of months PAST DUE or greater.
+4 ;
+5 ;---> Select Order of sort.
+6 SET BIPG1=0
+7 DO FULL^VALM1
+8 DO TITLE^BIUTL5("NUMBER OF MONTHS PAST DUE")
+9 DO TEXT2
NEW DIR
+10 NEW DIR
DO HELP2
+11 SET DIR("A")=" Number of Months Past Due: "
+12 SET DIR(0)="NA^1:999:0"
+13 DO ^DIR
+14 SET BIPG1=+Y
IF BIPG1<1
SET BIPG1=0
+15 QUIT
+16 ;
+17 ;
+18 ;----------
TEXT2 ;EP
+1 ;;You have chosen to limit this listing to patients who are
+2 ;;PAST DUE for one or more immunizations. You must now specify
+3 ;;the MINIMUM number of months a patient must be PAST DUE to be
+4 ;;included in this listing.
+5 ;;
+6 ;;NOTE: This will be the number of months that the patient was
+7 ;; PAST DUE before the Forecast/Clinic Date you select
+8 ;; (not necessarily the number of months before today!).
+9 ;;
+10 DO PRINTX("TEXT2")
+11 QUIT
+12 ;
+13 ;
+14 ;----------
TEXT3 ;EP
+1 ;;You have chosen to include Patients who are Inactive.
+2 ;;
+3 ;;You may include ALL Patients who are Inactive, or you may
+4 ;;limit the group of Inactive Patients to those who were made
+5 ;;Inactive within a specified date range.
+6 ;;
+7 ;;Would you like to limit the list of Inactive Patients to a specific
+8 ;;date range? In other words, include only patients who were made
+9 ;;Inactive after a particular date and before a later date?
+10 ;;
+11 DO PRINTX("TEXT3")
+12 QUIT
+13 ;
+14 ;
+15 ;----------
TEXT4 ;EP
+1 ;;You have chosen to limit this list to Patients who were
+2 ;;Automatically Activated.
+3 ;;
+4 ;;You may include ALL Patients who were Automatically Activated,
+5 ;;or you may limit the group to Patients who were Automatically
+6 ;;Activated within a specified date range.
+7 ;;
+8 ;;Would you like to limit the list of Patients who were Automatically
+9 ;;Activated within a specific date range? In other words, include only
+10 ;;patients who were Activated after a particular date and before
+11 ;;a later date?
+12 ;;
+13 DO PRINTX("TEXT4")
+14 QUIT
+15 ;
+16 ;
+17 ;----------
TEXT5 ;EP
+1 ;;You have chosen to limit this list to patients who have Refusals
+2 ;;on record.
+3 ;;
+4 ;;You may include patients who have Refusals for ANY vaccine, or
+5 ;;you may limit the list to refusals for one or more specific vaccines.
+6 ;;
+7 ;;Would you like to limit the list to Refusals of one or more specific
+8 ;;vaccines?
+9 ;;
+10 DO PRINTX("TEXT5")
+11 QUIT
+12 ;
+13 ;
+14 ;----------
TEXT6 ;EP
+1 ;;You have chosen to limit this list to patients who have Refusals
+2 ;;on record.
+3 ;;
+4 ;;Would you like to limit the list to Refusals that were recorded
+5 ;;within a specific date range?
+6 ;;
+7 DO PRINTX("TEXT6")
+8 QUIT
+9 ;
+10 ;
+11 ;----------
TEXT7 ;EP
+1 ;;Ordinarilly Lists & Letters looks only at American Indians and Alaska
+2 ;;Natives, also known by the Beneficiary Type Code 01.
+3 ;;
+4 ;;Would you like to expand the list to include patients of all Beneficiary
+5 ;;Types (includes Dependents of Comm Officers, Retired Military, etc.)?
+6 ;;
+7 DO PRINTX("TEXT7")
+8 QUIT
+9 ;
+10 ;
+11 ;----------
HELP2 ;EP
+1 ;;Enter a number which will be the minimum number of months
+2 ;;PAST DUE for patients to be included in the listing.
+3 ;;
+4 ;;For example, if you enter "3", then any patient with at least one
+5 ;;immunization 3 months or more past due would be included. A patient
+6 ;;with an immunization only 2 months past due would not be included.
+7 ;;
+8 ;;NOTE: The months PAST DUE will be calculated from the Forecast/
+9 ;; Clinic Date you select (not necessarily from today).
+10 DO HELPTX("HELP2")
+11 QUIT
+12 ;
+13 ;
+14 ;----------
SEARCH(BITMPL) ;EP
+1 ;---> Select Search Template of patients.
+2 ;---> Parameters:
+3 ; 1 - BITMPL (ret) IEN of Search Template in File #.401, or
+4 ; BITMPL=-1 if lookup failed.
+5 ;
SEARCH1 ;
+1 DO TITLE^BIUTL5("SEARCH TEMPLATE SELECTION")
+2 NEW BIA,BIS
SET BIPOP=0
SET BITMPL=""
+3 SET BIA=" Select Patient SEARCH TEMPLATE name: "
+4 SET BIS="I $P(^"_"(0),U,4)=2!($P(^(0),U,4)=9000001)"
+5 DO DIC^BIFMAN(.401,"QEMA",.Y,BIA,,BIS)
+6 SET BITMPL=+Y
+7 IF BITMPL<1
QUIT
+8 ;
+9 ;---> Display Template info for confirmation.
+10 DO TITLE^BIUTL5("SEARCH TEMPLATE SELECTION")
+11 WRITE !!?5,"You have selected the following Patient Search Template: "
+12 WRITE !!?9,"Name...: ",$PIECE(^DIBT(BITMPL,0),U)
+13 WRITE !?9,"Created: ",$$TXDT1^BIUTL5($PIECE(^DIBT(BITMPL,0),U,2))
+14 WRITE " by ",$$PERSON^BIUTL1($PIECE(^DIBT(BITMPL,0),U,5))
+15 WRITE !?9,"Total..: "
+16 Begin DoDot:1
+17 NEW M,N
SET M=0
SET N=0
+18 FOR
SET N=$ORDER(^DIBT(BITMPL,1,N))
IF 'N
QUIT
SET M=M+1
+19 WRITE M," Patient",$SELECT(M>1:"s",1:"")
End DoDot:1
+20 WRITE !!?5,"Description: "
+21 WRITE !?5,"------------ "
+22 Begin DoDot:1
+23 IF '$ORDER(^DIBT(BITMPL,"%D",0))
WRITE !?5,"None."
QUIT
+24 NEW I,N
SET N=0
+25 FOR I=1:1:7
SET N=$ORDER(^DIBT(BITMPL,"%D",N))
IF 'N
QUIT
Begin DoDot:2
+26 WRITE !?5,$GET(^DIBT(BITMPL,"%D",N,0))
End DoDot:2
+27 IF $ORDER(^DIBT(BITMPL,"%D",N))
Begin DoDot:2
+28 WRITE !?5,"(More...see template for full description.)"
End DoDot:2
End DoDot:1
+29 ;
+30 WRITE !
+31 NEW B,BIPOP
SET BIPOP=0
+32 SET B=" Use this Template for your List? (Yes/No): "
+33 SET B(1)=" Enter Yes to select this Template."
+34 SET B(2)=" Enter No to select another Template."
+35 DO DIR^BIFMAN("YA",.Y,,B,"Yes",B(2),B(1))
+36 ;
+37 ;---> Failed to confirm.
+38 IF Y<1
Begin DoDot:1
+39 WRITE !?5,"Okay, let's begin again..."
DO DIRZ^BIUTL3()
End DoDot:1
GOTO SEARCH1
+40 ;
+41 QUIT
+42 ;
+43 ;
+44 ;----------
LOADTX(BILINL,BITAB,BITEXT) ;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
SET BITEXT(I)=T_$PIECE(X,";;",2)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
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 ;----------
HELPTX(BILINL,BITAB) ;EP
+1 NEW I,T,X
SET T=""
IF '$DATA(BITAB)
SET BITAB=5
FOR I=1:1:BITAB
SET T=T_" "
+2 FOR I=1:1
SET X=$TEXT(@BILINL+I)
IF X'[";;"
QUIT
SET DIR("?",I)=T_$PIECE(X,";;",2)
+3 SET DIR("?")=DIR("?",I-1)
KILL DIR("?",I-1)
+4 QUIT
