Routine: BIAGE

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=""

 .;---> 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")

 .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)=""

 ;----------

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")

 ;----------

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")

 ;----------

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.

 .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)

 ;----------

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)

 .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

 ;----------

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)

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

BIAGE.m