BUD9UTL2.m

BUD9UTL2 ; IHS/CMI/LAB - utilities for BUD ;

 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50

 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 ;;  RETRIEVE PATIENTS FOR DUE LISTS & LETTERS.

 ;;  PATCH 1: Correct test for Active Chart at site DUZ2.  INACTREG+11

 ;;           Also, add Street Address Line 2 aAPCLlity.  STREET+0

 ;;           Also, provide test for patient IneligiAPCLlity  INELIG+0

 ;

 ;----------

DOB(DFN) ;EP

 ;---> Return Patient's Date of APCLrth in Fileman format.

 ;---> Parameters:

 ;     1 - DFN   (req) Patient's IEN (DFN).

 ;

 Q:'$G(DFN) "NO PATIENT"

 Q:'$P($G(^DPT(DFN,0)),U,3) "NOT ENTERED"

 Q $P(^DPT(DFN,0),U,3)

 ;

 ;

 ;

 ;----------

AGE(DFN,APCLZ,APCLDT) ;EP

 ;---> Return Patient's Age.

 ;---> Parameters:

 ;     1 - DFN  (req) IEN in PATIENT File.

 ;     2 - APCLZ  (opt) APCLZ=1,2,3  1=years, 2=months, 3=days.

 ;                               2 will be assumed if not passed.

 ;     3 - APCLDT (opt) Date on which Age should be calculated.

 ;

 N APCLDOB,X,X1,X2  S:$G(APCLZ)="" APCLZ=2

 Q:'$G(DFN) ""

 S APCLDOB=$$DOB(DFN)

 Q:'APCLDOB ""

 S:'$G(DT) DT=$$DT^XLFDT

 S:'$G(APCLDT) APCLDT=DT

 Q:APCLDT<APCLDOB ""

 ;

 ;---> Age in Years.

 N APCLAGEY,APCLAGEM,APCLD1,APCLD2,APCLM1,APCLM2,APCLY1,APCLY2

 S APCLM1=$E(APCLDOB,4,7),APCLM2=$E(APCLDT,4,7)

 S APCLY1=$E(APCLDOB,1,3),APCLY2=$E(APCLDT,1,3)

 S APCLAGEY=APCLY2-APCLY1 S:APCLM2<APCLM1 APCLAGEY=APCLAGEY-1

 S:APCLAGEY<1 APCLAGEY="<1"

 Q:APCLZ=1 APCLAGEY

 ;

 ;---> Age in Months.

 S APCLD1=$E(APCLM1,3,4),APCLM1=$E(APCLM1,1,2)

 S APCLD2=$E(APCLM2,3,4),APCLM2=$E(APCLM2,1,2)

 S APCLAGEM=12*APCLAGEY

 I APCLM2=APCLM1&(APCLD2<APCLD1) S APCLAGEM=APCLAGEM+12

 I APCLM2>APCLM1 S APCLAGEM=APCLAGEM+APCLM2-APCLM1

 I APCLM2<APCLM1 S APCLAGEM=APCLAGEM+APCLM2+(12-APCLM1)

 S:APCLD2<APCLD1 APCLAGEM=APCLAGEM-1

 Q:APCLZ=2 APCLAGEM

 ;

 ;---> Age in Days.

 S X1=APCLDT,X2=APCLDOB

 D ^%DTC

 Q X

 ;

 ;

 ;----------

AGEF(DFN,APCLDT) ;EP

 ;---> Age formatted "35 Months" or "23 Years"

 ;---> Parameters:

 ;     1 - DFN  (req) Patient's IEN (DFN).

 ;     2 - APCLDT (opt) Date on which Age should be calculated.

 ;

 N Y

 S Y=$$AGE(DFN,2,$G(APCLDT))

 Q:Y["DECEASED" Y

 Q:Y["NOT BORN" Y

 ;

 ;---> If over 60 months, return years.

 I Y>60 S Y=$$AGE(DFN,1,$G(APCLDT)) Q Y_$S(Y=1:"year",1:" yrs")

 ;

 ;---> If under 1 month return days.

 I Y<1 S Y=$$AGE(DFN,3,$G(APCLDT)) Q Y_$S(Y=1:" day",1:" days")

 ;

 ;---> Return months

 Q Y_$S(Y=1:" mth",1:" mths")

 ;

 ;

 ;----------

DECEASED(DFN,APCLDT) ;EP

 ;---> Return 1 if patient is deceased, 0 if not deceased.

 ;---> Parameters:

 ;     1 - DFN  (req) Patient's IEN (DFN).

 ;     2 - APCLDT (opt) If APCLDT=1 return Date of Death (Fileman format).

 ;

 Q:'$G(DFN) 0

 N X S X=+$G(^DPT(DFN,.35))

 Q:'X 0

 Q:'$G(APCLDT) 1

 Q X

 ;

 ;

BUD9UTL2  ; IHS/CMI/LAB - utilities for BUD ;

 +1       ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50

 +2       ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 +3       ;;  RETRIEVE PATIENTS FOR DUE LISTS & LETTERS.

 +4       ;;  PATCH 1: Correct test for Active Chart at site DUZ2.  INACTREG+11

 +5       ;;           Also, add Street Address Line 2 aAPCLlity.  STREET+0

 +6       ;;           Also, provide test for patient IneligiAPCLlity  INELIG+0

 +7       ;

 +8       ;----------

DOB(DFN)  ;EP

 +1       ;---> Return Patient's Date of APCLrth in Fileman format.

 +2       ;---> Parameters:

 +3       ;     1 - DFN   (req) Patient's IEN (DFN).

 +4       ;

 +5        IF '$GET(DFN)

               QUIT "NO PATIENT"

 +6        IF '$PIECE($GET(^DPT(DFN,0)),U,3)

               QUIT "NOT ENTERED"

 +7        QUIT $PIECE(^DPT(DFN,0),U,3)

 +8       ;

 +9       ;

 +10      ;

 +11      ;----------

AGE(DFN,APCLZ,APCLDT) ;EP

 +1       ;---> Return Patient's Age.

 +2       ;---> Parameters:

 +3       ;     1 - DFN  (req) IEN in PATIENT File.

 +4       ;     2 - APCLZ  (opt) APCLZ=1,2,3  1=years, 2=months, 3=days.

 +5       ;                               2 will be assumed if not passed.

 +6       ;     3 - APCLDT (opt) Date on which Age should be calculated.

 +7       ;

 +8        NEW APCLDOB,X,X1,X2

           IF $GET(APCLZ)=""

               SET APCLZ=2

 +9        IF '$GET(DFN)

               QUIT ""

 +10       SET APCLDOB=$$DOB(DFN)

 +11       IF 'APCLDOB

               QUIT ""

 +12       IF '$GET(DT)

               SET DT=$$DT^XLFDT

 +13       IF '$GET(APCLDT)

               SET APCLDT=DT

 +14       IF APCLDT<APCLDOB

               QUIT ""

 +15      ;

 +16      ;---> Age in Years.

 +17       NEW APCLAGEY,APCLAGEM,APCLD1,APCLD2,APCLM1,APCLM2,APCLY1,APCLY2

 +18       SET APCLM1=$EXTRACT(APCLDOB,4,7)

           SET APCLM2=$EXTRACT(APCLDT,4,7)

 +19       SET APCLY1=$EXTRACT(APCLDOB,1,3)

           SET APCLY2=$EXTRACT(APCLDT,1,3)

 +20       SET APCLAGEY=APCLY2-APCLY1

           IF APCLM2<APCLM1

               SET APCLAGEY=APCLAGEY-1

 +21       IF APCLAGEY<1

               SET APCLAGEY="<1"

 +22       IF APCLZ=1

               QUIT APCLAGEY

 +23      ;

 +24      ;---> Age in Months.

 +25       SET APCLD1=$EXTRACT(APCLM1,3,4)

           SET APCLM1=$EXTRACT(APCLM1,1,2)

 +26       SET APCLD2=$EXTRACT(APCLM2,3,4)

           SET APCLM2=$EXTRACT(APCLM2,1,2)

 +27       SET APCLAGEM=12*APCLAGEY

 +28       IF APCLM2=APCLM1&(APCLD2<APCLD1)

               SET APCLAGEM=APCLAGEM+12

 +29       IF APCLM2>APCLM1

               SET APCLAGEM=APCLAGEM+APCLM2-APCLM1

 +30       IF APCLM2<APCLM1

               SET APCLAGEM=APCLAGEM+APCLM2+(12-APCLM1)

 +31       IF APCLD2<APCLD1

               SET APCLAGEM=APCLAGEM-1

 +32       IF APCLZ=2

               QUIT APCLAGEM

 +33      ;

 +34      ;---> Age in Days.

 +35       SET X1=APCLDT

           SET X2=APCLDOB

 +36       DO ^%DTC

 +37       QUIT X

 +38      ;

 +39      ;

 +40      ;----------

AGEF(DFN,APCLDT) ;EP

 +1       ;---> Age formatted "35 Months" or "23 Years"

 +2       ;---> Parameters:

 +3       ;     1 - DFN  (req) Patient's IEN (DFN).

 +4       ;     2 - APCLDT (opt) Date on which Age should be calculated.

 +5       ;

 +6        NEW Y

 +7        SET Y=$$AGE(DFN,2,$GET(APCLDT))

 +8        IF Y["DECEASED"

               QUIT Y

 +9        IF Y["NOT BORN"

               QUIT Y

 +10      ;

 +11      ;---> If over 60 months, return years.

 +12       IF Y>60

               SET Y=$$AGE(DFN,1,$GET(APCLDT))

               QUIT Y_$SELECT(Y=1:"year",1:" yrs")

 +13      ;

 +14      ;---> If under 1 month return days.

 +15       IF Y<1

               SET Y=$$AGE(DFN,3,$GET(APCLDT))

               QUIT Y_$SELECT(Y=1:" day",1:" days")

 +16      ;

 +17      ;---> Return months

 +18       QUIT Y_$SELECT(Y=1:" mth",1:" mths")

 +19      ;

 +20      ;

 +21      ;----------

DECEASED(DFN,APCLDT) ;EP

 +1       ;---> Return 1 if patient is deceased, 0 if not deceased.

 +2       ;---> Parameters:

 +3       ;     1 - DFN  (req) Patient's IEN (DFN).

 +4       ;     2 - APCLDT (opt) If APCLDT=1 return Date of Death (Fileman format).

 +5       ;

 +6        IF '$GET(DFN)

               QUIT 0

 +7        NEW X

           SET X=+$GET(^DPT(DFN,.35))

 +8        IF 'X

               QUIT 0

 +9        IF '$GET(APCLDT)

               QUIT 1

 +10       QUIT X

 +11      ;

 +12      ;