PXRMASL ;SLC/PKR - Computed findings for age and sex. ;10/30/2014
;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
;
;=========================
BDAYSL(MINBDAY,MAXBDAY,SEX,TODAY,PLIST) ;Build a list of patients based on an
;inclusive range of birthdates defined by a minimum and maximum
;birthday. Sex is an optional filter
N BDAY,DFN
K ^TMP($J,PLIST)
S TODAY=$$TODAY^PXRMDATE
S BDAY=$$FMADD^XLFDT(MINBDAY,-1,0,0,0)
;DBIA #10035
F S BDAY=$O(^DPT("ADOB",BDAY)) Q:(BDAY>MAXBDAY)!(BDAY="") D
. S DFN=""
. F S DFN=$O(^DPT("ADOB",BDAY,DFN)) Q:DFN="" D
.. I SEX="" S ^TMP($J,PLIST,DFN,1)=DFN_U_TODAY_U_"2"_U_BDAY Q
.. I SEX=$P(^DPT(DFN,0),U,2) S ^TMP($J,PLIST,DFN,1)=DFN_U_TODAY_U_"2"_U_BDAY
Q
;
;=========================
CFAGESL(NGET,BDT,EDT,PLIST,PARAM) ;Computed finding that returns a list of
;patients in an inclusive age range defined by minimum age and
;maximum age and optionally filter on sex. AGE can be specified in
;units of D=days, W=weeks, M=months, or Y=years. If no unit is
;specified it defaults to years.
N MAXAGE,MAXBDAY,MINAGE,MINBDAY,MAXUNIT,MINUNIT,SEX,TODAY
S MINAGE=$P(PARAM,U,1),MAXAGE=$P(PARAM,U,2),SEX=$P(PARAM,U,3)
I MINAGE="" Q
I MAXAGE="" Q
S TODAY=$$TODAY^PXRMDATE
S MAXUNIT=$E(MAXAGE,$L(MAXAGE))
I "DWMY"'[MAXUNIT S MAXAGE=MAXAGE_"Y"
S MINBDAY=$$NEWDATE^PXRMDATE(TODAY,"-",MAXAGE)
S MINUNIT=$E(MINAGE,$L(MINAGE))
I "DWMY"'[MINUNIT S MINUNIT="Y",MINAGE=MINAGE_"Y"
I MINUNIT="Y" S MINBDAY=$E(MINBDAY,1,3)_"0101"
S MAXBDAY=$$NEWDATE^PXRMDATE(TODAY,"-",MINAGE)
I MINBDAY>MAXBDAY Q
D BDAYSL(MINBDAY,MAXBDAY,SEX,TODAY,PLIST)
Q
;
;=========================
CFBDAYSL(NGET,BDT,EDT,PLIST,PARAM) ;Computed finding that returns a list of
;patients in an inclusive birth date range defined by minimum birthday
;and maximum birthday and optionally filter on sex.
N MAXBDAY,MINBDAY,SEX,TODAY
S MINBDAY=$P(PARAM,U,1),MAXBDAY=$P(PARAM,U,2),SEX=$P(PARAM,U,3)
I MINBDAY="" Q
I MAXBDAY="" Q
S MINBDAY=$$CTFMD^PXRMDATE(MINBDAY)
S MAXBDAY=$$CTFMD^PXRMDATE(MAXBDAY)
I MINBDAY>MAXBDAY Q
S TODAY=$$TODAY^PXRMDATE
D BDAYSL(MINBDAY,MAXBDAY,SEX,TODAY,PLIST)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMASL 2179 printed Dec 13, 2024@01:43:01 Page 2
PXRMASL ;SLC/PKR - Computed findings for age and sex. ;10/30/2014
+1 ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
+2 ;
+3 ;=========================
BDAYSL(MINBDAY,MAXBDAY,SEX,TODAY,PLIST) ;Build a list of patients based on an
+1 ;inclusive range of birthdates defined by a minimum and maximum
+2 ;birthday. Sex is an optional filter
+3 NEW BDAY,DFN
+4 KILL ^TMP($JOB,PLIST)
+5 SET TODAY=$$TODAY^PXRMDATE
+6 SET BDAY=$$FMADD^XLFDT(MINBDAY,-1,0,0,0)
+7 ;DBIA #10035
+8 FOR
SET BDAY=$ORDER(^DPT("ADOB",BDAY))
if (BDAY>MAXBDAY)!(BDAY="")
QUIT
Begin DoDot:1
+9 SET DFN=""
+10 FOR
SET DFN=$ORDER(^DPT("ADOB",BDAY,DFN))
if DFN=""
QUIT
Begin DoDot:2
+11 IF SEX=""
SET ^TMP($JOB,PLIST,DFN,1)=DFN_U_TODAY_U_"2"_U_BDAY
QUIT
+12 IF SEX=$PIECE(^DPT(DFN,0),U,2)
SET ^TMP($JOB,PLIST,DFN,1)=DFN_U_TODAY_U_"2"_U_BDAY
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
+15 ;=========================
CFAGESL(NGET,BDT,EDT,PLIST,PARAM) ;Computed finding that returns a list of
+1 ;patients in an inclusive age range defined by minimum age and
+2 ;maximum age and optionally filter on sex. AGE can be specified in
+3 ;units of D=days, W=weeks, M=months, or Y=years. If no unit is
+4 ;specified it defaults to years.
+5 NEW MAXAGE,MAXBDAY,MINAGE,MINBDAY,MAXUNIT,MINUNIT,SEX,TODAY
+6 SET MINAGE=$PIECE(PARAM,U,1)
SET MAXAGE=$PIECE(PARAM,U,2)
SET SEX=$PIECE(PARAM,U,3)
+7 IF MINAGE=""
QUIT
+8 IF MAXAGE=""
QUIT
+9 SET TODAY=$$TODAY^PXRMDATE
+10 SET MAXUNIT=$EXTRACT(MAXAGE,$LENGTH(MAXAGE))
+11 IF "DWMY"'[MAXUNIT
SET MAXAGE=MAXAGE_"Y"
+12 SET MINBDAY=$$NEWDATE^PXRMDATE(TODAY,"-",MAXAGE)
+13 SET MINUNIT=$EXTRACT(MINAGE,$LENGTH(MINAGE))
+14 IF "DWMY"'[MINUNIT
SET MINUNIT="Y"
SET MINAGE=MINAGE_"Y"
+15 IF MINUNIT="Y"
SET MINBDAY=$EXTRACT(MINBDAY,1,3)_"0101"
+16 SET MAXBDAY=$$NEWDATE^PXRMDATE(TODAY,"-",MINAGE)
+17 IF MINBDAY>MAXBDAY
QUIT
+18 DO BDAYSL(MINBDAY,MAXBDAY,SEX,TODAY,PLIST)
+19 QUIT
+20 ;
+21 ;=========================
CFBDAYSL(NGET,BDT,EDT,PLIST,PARAM) ;Computed finding that returns a list of
+1 ;patients in an inclusive birth date range defined by minimum birthday
+2 ;and maximum birthday and optionally filter on sex.
+3 NEW MAXBDAY,MINBDAY,SEX,TODAY
+4 SET MINBDAY=$PIECE(PARAM,U,1)
SET MAXBDAY=$PIECE(PARAM,U,2)
SET SEX=$PIECE(PARAM,U,3)
+5 IF MINBDAY=""
QUIT
+6 IF MAXBDAY=""
QUIT
+7 SET MINBDAY=$$CTFMD^PXRMDATE(MINBDAY)
+8 SET MAXBDAY=$$CTFMD^PXRMDATE(MAXBDAY)
+9 IF MINBDAY>MAXBDAY
QUIT
+10 SET TODAY=$$TODAY^PXRMDATE
+11 DO BDAYSL(MINBDAY,MAXBDAY,SEX,TODAY,PLIST)
+12 QUIT
+13 ;
