BIAGE ;IHS/CMI/MWR - PROCESS AGE RANGES, PROMPTS ; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; UTILITY TO PROMPT AND PROCESS AGE RANGES.
;
;
;----------
AGERNG(BIAGRG,BIPOP,BIDFLT,BIDMODE) ;EP
;---> Ask age range.
;---> Parameters:
; 1 - BIAGRG (ret) Age Range^Mode (Mode is in Months or Years).
; Mode="" or 0, is Months (default).
; Mode=1, is Years.
; Or BIAGRG="ALL"
; Examples: "6-24"="6 to 24 Months"
; "50-64^1"="50 to 64 Years"
; "ALL"
; 2 - BIPOP (ret) =1 if quit
; 3 - BIDFLT (opt) Default Age Range
; 4 - BIDMODE (opt) Default Mode: 1=Years, 0/""=Months(default)
;
;
ASKRNG ;EP
N DIR,DIRUT,Y S BIPOP=0,BIAGRG=""
D
.;---> Set default=previous entry.
.I $D(^BIAGRG(DUZ,0)) D Q
..S DIR("B")=$P(^BIAGRG(DUZ,0),U,2)
..S BIMODE=+$P(^BIAGRG(DUZ,0),U,3)
.;
.;---> If no previous user default, then use passed default.
.S:$G(BIDFLT)]"" DIR("B")=BIDFLT
.S BIMODE=+$G(BIDMODE)
;
ASKRNG1 ;GO EP
;
D FULL^VALM1,TITLE^BIUTL5("SELECT AGE RANGE")
D
.I BIMODE D TEXT2 Q
.D TEXT1
;
S DIR(0)="FOA"
S DIR("?")=" Enter a number"
S DIR("A")=" Enter Age Range in "
S DIR("A")=DIR("A")_$S(BIMODE:"Years: ",1:"Months: ")
D ^DIR
I $D(DIRUT)!(Y="") S BIPOP=1 Q
;
I "ALLAllall"[Y S BIAGRG="ALL" Q
;
I "YyMm"[Y D G ASKRNG1
.S BIMODE=$S("Yy"[Y:1,1:0) K DIR
;
;---> If not a valid range, begin again.
I $$CHECK(.Y) D ERRCD^BIUTL2(660,,1) G ASKRNG
;
;---> If Age Range was given in Years, concat 1.
S:BIMODE Y=Y_U_1
S BIAGRG=Y
;
;---> Now store user's Age Range for future default.
Q:Y=""
Q:DUZ=0
;---> Clear any previous Date-Loc Line for this user.
K ^BIAGRG(DUZ),^BIAGRG("B",DUZ)
;---> Store this Age Range for this user.
S ^BIAGRG(DUZ,0)=DUZ_U_Y,^BIAGRG("B",DUZ,DUZ)=""
Q
;
;
;----------
TEXT1 ;EP
;;Enter the patient Age Range IN MONTHS in the form of: 6-24
;;Use a dash "-" to separate the limits of the range. You may also
;;enter a single age, such as 12, to select for only 12-month-old
;;patients.
;;
;;Enter "ALL" if you wish to simply include patients of ALL ages.
;;
;;Or, if you wish to select a range in YEARS, enter "Y" (no quotes).
;;
;;NOTE: The Age Range will include patients whose ages span from the
;;minimum age all the way up to ONE DAY LESS THAN a month after the
;;maximum age. For example, 6-24 will include patients 6 months of
;;age and older, up to 24 months and approximately 30 days.
;;
;;
D PRINTX("TEXT1")
Q
;
;
;----------
TEXT2 ;EP
;;Enter the patient Age Range IN YEARS in the form of: 65-99
;;Use a dash "-" to separate the limits of the range. You may also
;;enter a single age, such as 65, to select for only 65-year-old
;;patients.
;;
;;Enter "ALL" if you wish to simply include patients of ALL ages.
;;
;;Or, if you wish to select a range in MONTHS, enter "M" (no quotes).
;;
;;NOTE: The Age Range will include patients whose ages span from the
;;minimum age all the way up to ONE DAY LESS THAN a year after the
;;maximum age. For example, 65-99 will include patients 65 years of
;;age and older, up to 99 years and 364 days.
;;
;;
D PRINTX("TEXT2")
Q
;
;
;----------
CHECK(X) ;EP
;---> Check syntax of age range string.
;---> Also, convert to years if appropriate.
;---> Parameters:
; 1 - X (req) Age Range.
;
;---> If only one age selected, quit.
Q:X?1N.N 0
N V,Y,Z S V="-"
S Y=$P(X,V),Z=$P(X,V,2)
;---> Each end of the range should be a number.
I (Y'?1N.N)!(Z'?1N.N) K X Q 1
;---> The lower number should be first.
I Z<Y K X Q 1
Q 0
;
;
;----------
AGEDATE(BIAGRG,BISVDT,BIBEGDT,BIENDDT,BIERR) ;EP
;---> Given an Age Range in months or years and a Survey Date,
;---> return the beginning and ending dates in Fileman format.
;---> Use to search patients by DOB.
;---> Parameters:
; 1 - BIAGRG (req) Age Range^Mth/Yr (e.g.,50-64^1)
; (See description at linelable AGERNG above.)
; 2 - BISVDT (req) Survey/Forecast Date (date from which to
; calculate age).
; 3 - BIBEGDT (ret) Beginning Date.
; 4 - BIENDDT (ret) Ending Date.
; 5 - BIERR (ret) Error.
;
;---> Set begin and end dates for search through PATIENT File.
I "ALL"[$G(BIAGRG) S BIBEGDT=0,BIENDDT=9999999 Q
I '$G(BISVDT) S BISVDT=$G(DT)
;I '$G(BISVDT) S BIBEGDT=0,BIENDDT=9999999 Q
;S:BISVDT>DT BISVDT=DT
;
;---> If X=one age only, set it in the form X-X and quit.
;---> If Age Range is passed in years, convert to months.
D
.N Y S Y=$P(BIAGRG,U)
.;---> If Y=one age only, set it in the form Y-Y.
.I Y?1N.N S Y=Y_"-"_Y
.I '$P(BIAGRG,U,2) S BIAGRG=Y Q
.S BIAGRG=(12*$P(Y,"-"))_"-"_(12*$P(Y,"-",2)+11)
;
N BIAGRG1,BIAGRG2
S BIAGRG1=+$P(BIAGRG,"-",1),BIAGRG2=+$P(BIAGRG,"-",2)
I (BIAGRG1'?1N.N)!(BIAGRG2'?1N.N) D ERRCD^BIUTL2(676,.BIERR) Q
;
;D PASTMTH(BISVDT,($P(BIAGRG,"-",2)+1),.BIBEGDT)
D PASTMTH(BISVDT,(BIAGRG2+1),.BIBEGDT)
;
;---> Now, set Beginning Day to be one day AFTER the patient would
;---> be too old and out of the selected Age Range.
;---> In other words, come forward one day to include only patients
;---> whose age is ONE DAY LESS THAN a month (or year) after the
;---> maximum limit of the selected Age Range.
;---> For example, Age Range=24-36 includes patients whose age
;---> is between [24months] and [37months-1day].
N X,X1,X2 S X1=BIBEGDT,X2=1 D C^%DTC S BIBEGDT=X
;
;D PASTMTH(BISVDT,$P(BIAGRG,"-",1),.BIENDDT)
D PASTMTH(BISVDT,BIAGRG1,.BIENDDT)
Q
;
;
;----------
PASTMTH(BIDTI,BIMTHS,BIDTO,BIYR) ;EP
;---> Return the date BIMTHS months/years prior the input date.
;---> Parameters:
; 1 - BIDTI (req) Date in.
; 2 - BIMTHS (req) Number of months in the past to calculate.
; 3 - BIDTO (ret) Date out (BIMTHS prior to BIDTI).
; 4 - BIYR (opt) If BIYR=1, input is in years; multiply BIMTHSx12.
;
Q:'$G(BIDTI)
I '$G(BIMTHS) S BIDTO=BIDTI Q
I $G(BIYR)=1 S BIMTHS=(BIMTHS*12)
N YYY,MM,DD
S YYY=$E(BIDTI,1,3),MM=+$E(BIDTI,4,5),DD=+$E(BIDTI,6,7)
D
.I MM>BIMTHS S MM=MM-BIMTHS Q
.N I,Q S Q=0
.F I=12:12 D Q:Q
..I BIMTHS-MM<I S MM=I-(BIMTHS-MM),YYY=YYY-(I/12),Q=1
;
S:MM<10 MM="0"_MM
S:DD<10 DD="0"_DD
S BIDTO=YYY_MM_DD
Q
;
;
;----------
MTHYR(BIAG,BIS) ;EP
;---> Return Age Range for display in either months or years
;---> as appropriate, formatted: "24-36 Months" or "65-99 Years".
;---> Parameters:
; 1 - BIAG (req) Age Range^Mth/Yr
; (See description at linelable AGERNG above.)
; 2 - BIS (opt) If BIS=1 return "Mths" instead of "Months" or
; "Yrs" instead of "Years".
;
Q:$G(BIAG)="" "NO RANGE"
N V,W,X,Y,Z S V="-"
;
;---> Z=""/0: Range is in Months; Z=1: Range is in Years.
S W=$P(BIAG,U),X=$P(W,V),Y=$P(W,V,2),Z=$P(BIAG,U,2)
S:'X X=0
S:W=0 W="<1"
Q:$G(Z) W_$S($G(BIS):" Yr",1:" Year")_$S((Y!(X>1)):"s",1:"")
Q W_$S($G(BIS):" Mth",1:" Month")_$S((Y!(X>1)):"s",1:"")
;
;
;----------
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
BIAGE ;IHS/CMI/MWR - PROCESS AGE RANGES, PROMPTS ; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; UTILITY TO PROMPT AND PROCESS AGE RANGES.
+4 ;
+5 ;
+6 ;----------
AGERNG(BIAGRG,BIPOP,BIDFLT,BIDMODE) ;EP
+1 ;---> Ask age range.
+2 ;---> Parameters:
+3 ; 1 - BIAGRG (ret) Age Range^Mode (Mode is in Months or Years).
+4 ; Mode="" or 0, is Months (default).
+5 ; Mode=1, is Years.
+6 ; Or BIAGRG="ALL"
+7 ; Examples: "6-24"="6 to 24 Months"
+8 ; "50-64^1"="50 to 64 Years"
+9 ; "ALL"
+10 ; 2 - BIPOP (ret) =1 if quit
+11 ; 3 - BIDFLT (opt) Default Age Range
+12 ; 4 - BIDMODE (opt) Default Mode: 1=Years, 0/""=Months(default)
+13 ;
+14 ;
ASKRNG ;EP
+1 NEW DIR,DIRUT,Y
SET BIPOP=0
SET BIAGRG=""
+2 Begin DoDot:1
+3 ;---> Set default=previous entry.
+4 IF $DATA(^BIAGRG(DUZ,0))
Begin DoDot:2
+5 SET DIR("B")=$PIECE(^BIAGRG(DUZ,0),U,2)
+6 SET BIMODE=+$PIECE(^BIAGRG(DUZ,0),U,3)
End DoDot:2
QUIT
+7 ;
+8 ;---> If no previous user default, then use passed default.
+9 IF $GET(BIDFLT)]""
SET DIR("B")=BIDFLT
+10 SET BIMODE=+$GET(BIDMODE)
End DoDot:1
+11 ;
ASKRNG1 ;GO EP
+1 ;
+2 DO FULL^VALM1
DO TITLE^BIUTL5("SELECT AGE RANGE")
+3 Begin DoDot:1
+4 IF BIMODE
DO TEXT2
QUIT
+5 DO TEXT1
End DoDot:1
+6 ;
+7 SET DIR(0)="FOA"
+8 SET DIR("?")=" Enter a number"
+9 SET DIR("A")=" Enter Age Range in "
+10 SET DIR("A")=DIR("A")_$SELECT(BIMODE:"Years: ",1:"Months: ")
+11 DO ^DIR
+12 IF $DATA(DIRUT)!(Y="")
SET BIPOP=1
QUIT
+13 ;
+14 IF "ALLAllall"[Y
SET BIAGRG="ALL"
QUIT
+15 ;
+16 IF "YyMm"[Y
Begin DoDot:1
+17 SET BIMODE=$SELECT("Yy"[Y:1,1:0)
KILL DIR
End DoDot:1
GOTO ASKRNG1
+18 ;
+19 ;---> If not a valid range, begin again.
+20 IF $$CHECK(.Y)
DO ERRCD^BIUTL2(660,,1)
GOTO ASKRNG
+21 ;
+22 ;---> If Age Range was given in Years, concat 1.
+23 IF BIMODE
SET Y=Y_U_1
+24 SET BIAGRG=Y
+25 ;
+26 ;---> Now store user's Age Range for future default.
+27 IF Y=""
QUIT
+28 IF DUZ=0
QUIT
+29 ;---> Clear any previous Date-Loc Line for this user.
+30 KILL ^BIAGRG(DUZ),^BIAGRG("B",DUZ)
+31 ;---> Store this Age Range for this user.
+32 SET ^BIAGRG(DUZ,0)=DUZ_U_Y
SET ^BIAGRG("B",DUZ,DUZ)=""
+33 QUIT
+34 ;
+35 ;
+36 ;----------
TEXT1 ;EP
+1 ;;Enter the patient Age Range IN MONTHS in the form of: 6-24
+2 ;;Use a dash "-" to separate the limits of the range. You may also
+3 ;;enter a single age, such as 12, to select for only 12-month-old
+4 ;;patients.
+5 ;;
+6 ;;Enter "ALL" if you wish to simply include patients of ALL ages.
+7 ;;
+8 ;;Or, if you wish to select a range in YEARS, enter "Y" (no quotes).
+9 ;;
+10 ;;NOTE: The Age Range will include patients whose ages span from the
+11 ;;minimum age all the way up to ONE DAY LESS THAN a month after the
+12 ;;maximum age. For example, 6-24 will include patients 6 months of
+13 ;;age and older, up to 24 months and approximately 30 days.
+14 ;;
+15 ;;
+16 DO PRINTX("TEXT1")
+17 QUIT
+18 ;
+19 ;
+20 ;----------
TEXT2 ;EP
+1 ;;Enter the patient Age Range IN YEARS in the form of: 65-99
+2 ;;Use a dash "-" to separate the limits of the range. You may also
+3 ;;enter a single age, such as 65, to select for only 65-year-old
+4 ;;patients.
+5 ;;
+6 ;;Enter "ALL" if you wish to simply include patients of ALL ages.
+7 ;;
+8 ;;Or, if you wish to select a range in MONTHS, enter "M" (no quotes).
+9 ;;
+10 ;;NOTE: The Age Range will include patients whose ages span from the
+11 ;;minimum age all the way up to ONE DAY LESS THAN a year after the
+12 ;;maximum age. For example, 65-99 will include patients 65 years of
+13 ;;age and older, up to 99 years and 364 days.
+14 ;;
+15 ;;
+16 DO PRINTX("TEXT2")
+17 QUIT
+18 ;
+19 ;
+20 ;----------
CHECK(X) ;EP
+1 ;---> Check syntax of age range string.
+2 ;---> Also, convert to years if appropriate.
+3 ;---> Parameters:
+4 ; 1 - X (req) Age Range.
+5 ;
+6 ;---> If only one age selected, quit.
+7 IF X?1N.N
QUIT 0
+8 NEW V,Y,Z
SET V="-"
+9 SET Y=$PIECE(X,V)
SET Z=$PIECE(X,V,2)
+10 ;---> Each end of the range should be a number.
+11 IF (Y'?1N.N)!(Z'?1N.N)
KILL X
QUIT 1
+12 ;---> The lower number should be first.
+13 IF Z<Y
KILL X
QUIT 1
+14 QUIT 0
+15 ;
+16 ;
+17 ;----------
AGEDATE(BIAGRG,BISVDT,BIBEGDT,BIENDDT,BIERR) ;EP
+1 ;---> Given an Age Range in months or years and a Survey Date,
+2 ;---> return the beginning and ending dates in Fileman format.
+3 ;---> Use to search patients by DOB.
+4 ;---> Parameters:
+5 ; 1 - BIAGRG (req) Age Range^Mth/Yr (e.g.,50-64^1)
+6 ; (See description at linelable AGERNG above.)
+7 ; 2 - BISVDT (req) Survey/Forecast Date (date from which to
+8 ; calculate age).
+9 ; 3 - BIBEGDT (ret) Beginning Date.
+10 ; 4 - BIENDDT (ret) Ending Date.
+11 ; 5 - BIERR (ret) Error.
+12 ;
+13 ;---> Set begin and end dates for search through PATIENT File.
+14 IF "ALL"[$GET(BIAGRG)
SET BIBEGDT=0
SET BIENDDT=9999999
QUIT
+15 IF '$GET(BISVDT)
SET BISVDT=$GET(DT)
+16 ;I '$G(BISVDT) S BIBEGDT=0,BIENDDT=9999999 Q
+17 ;S:BISVDT>DT BISVDT=DT
+18 ;
+19 ;---> If X=one age only, set it in the form X-X and quit.
+20 ;---> If Age Range is passed in years, convert to months.
+21 Begin DoDot:1
+22 NEW Y
SET Y=$PIECE(BIAGRG,U)
+23 ;---> If Y=one age only, set it in the form Y-Y.
+24 IF Y?1N.N
SET Y=Y_"-"_Y
+25 IF '$PIECE(BIAGRG,U,2)
SET BIAGRG=Y
QUIT
+26 SET BIAGRG=(12*$PIECE(Y,"-"))_"-"_(12*$PIECE(Y,"-",2)+11)
End DoDot:1
+27 ;
+28 NEW BIAGRG1,BIAGRG2
+29 SET BIAGRG1=+$PIECE(BIAGRG,"-",1)
SET BIAGRG2=+$PIECE(BIAGRG,"-",2)
+30 IF (BIAGRG1'?1N.N)!(BIAGRG2'?1N.N)
DO ERRCD^BIUTL2(676,.BIERR)
QUIT
+31 ;
+32 ;D PASTMTH(BISVDT,($P(BIAGRG,"-",2)+1),.BIBEGDT)
+33 DO PASTMTH(BISVDT,(BIAGRG2+1),.BIBEGDT)
+34 ;
+35 ;---> Now, set Beginning Day to be one day AFTER the patient would
+36 ;---> be too old and out of the selected Age Range.
+37 ;---> In other words, come forward one day to include only patients
+38 ;---> whose age is ONE DAY LESS THAN a month (or year) after the
+39 ;---> maximum limit of the selected Age Range.
+40 ;---> For example, Age Range=24-36 includes patients whose age
+41 ;---> is between [24months] and [37months-1day].
+42 NEW X,X1,X2
SET X1=BIBEGDT
SET X2=1
DO C^%DTC
SET BIBEGDT=X
+43 ;
+44 ;D PASTMTH(BISVDT,$P(BIAGRG,"-",1),.BIENDDT)
+45 DO PASTMTH(BISVDT,BIAGRG1,.BIENDDT)
+46 QUIT
+47 ;
+48 ;
+49 ;----------
PASTMTH(BIDTI,BIMTHS,BIDTO,BIYR) ;EP
+1 ;---> Return the date BIMTHS months/years prior the input date.
+2 ;---> Parameters:
+3 ; 1 - BIDTI (req) Date in.
+4 ; 2 - BIMTHS (req) Number of months in the past to calculate.
+5 ; 3 - BIDTO (ret) Date out (BIMTHS prior to BIDTI).
+6 ; 4 - BIYR (opt) If BIYR=1, input is in years; multiply BIMTHSx12.
+7 ;
+8 IF '$GET(BIDTI)
QUIT
+9 IF '$GET(BIMTHS)
SET BIDTO=BIDTI
QUIT
+10 IF $GET(BIYR)=1
SET BIMTHS=(BIMTHS*12)
+11 NEW YYY,MM,DD
+12 SET YYY=$EXTRACT(BIDTI,1,3)
SET MM=+$EXTRACT(BIDTI,4,5)
SET DD=+$EXTRACT(BIDTI,6,7)
+13 Begin DoDot:1
+14 IF MM>BIMTHS
SET MM=MM-BIMTHS
QUIT
+15 NEW I,Q
SET Q=0
+16 FOR I=12:12
Begin DoDot:2
+17 IF BIMTHS-MM<I
SET MM=I-(BIMTHS-MM)
SET YYY=YYY-(I/12)
SET Q=1
End DoDot:2
IF Q
QUIT
End DoDot:1
+18 ;
+19 IF MM<10
SET MM="0"_MM
+20 IF DD<10
SET DD="0"_DD
+21 SET BIDTO=YYY_MM_DD
+22 QUIT
+23 ;
+24 ;
+25 ;----------
MTHYR(BIAG,BIS) ;EP
+1 ;---> Return Age Range for display in either months or years
+2 ;---> as appropriate, formatted: "24-36 Months" or "65-99 Years".
+3 ;---> Parameters:
+4 ; 1 - BIAG (req) Age Range^Mth/Yr
+5 ; (See description at linelable AGERNG above.)
+6 ; 2 - BIS (opt) If BIS=1 return "Mths" instead of "Months" or
+7 ; "Yrs" instead of "Years".
+8 ;
+9 IF $GET(BIAG)=""
QUIT "NO RANGE"
+10 NEW V,W,X,Y,Z
SET V="-"
+11 ;
+12 ;---> Z=""/0: Range is in Months; Z=1: Range is in Years.
+13 SET W=$PIECE(BIAG,U)
SET X=$PIECE(W,V)
SET Y=$PIECE(W,V,2)
SET Z=$PIECE(BIAG,U,2)
+14 IF 'X
SET X=0
+15 IF W=0
SET W="<1"
+16 IF $GET(Z)
QUIT W_$SELECT($GET(BIS):" Yr",1:" Year")_$SELECT((Y!(X>1)):"s",1:"")
+17 QUIT W_$SELECT($GET(BIS):" Mth",1:" Month")_$SELECT((Y!(X>1)):"s",1:"")
+18 ;
+19 ;
+20 ;----------
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
