APCSSILU.m

APCSSILU ; IHS/CMI/LAB - utilities for ili/h1n1 ;

 ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009

 ;;* 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 aAPCSlity.  STREET+0

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

 ;

 ;----------

DOB(DFN) ;EP

 ;---> Return Patient's Date of APCSrth 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,APCSZ,APCSDT) ;EP

 ;---> Return Patient's Age.

 ;---> Parameters:

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

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

 ;                               2 will be assumed if not passed.

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

 ;

 N APCSDOB,X,X1,X2  S:$G(APCSZ)="" APCSZ=2

 Q:'$G(DFN) ""

 S APCSDOB=$$DOB(DFN)

 Q:'APCSDOB ""

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

 S:'$G(APCSDT) APCSDT=DT

 Q:APCSDT<APCSDOB ""

 ;

 ;---> Age in Years.

 N APCSAGEY,APCSAGEM,APCSD1,APCSD2,APCSM1,APCSM2,APCSY1,APCSY2

 S APCSM1=$E(APCSDOB,4,7),APCSM2=$E(APCSDT,4,7)

 S APCSY1=$E(APCSDOB,1,3),APCSY2=$E(APCSDT,1,3)

 S APCSAGEY=APCSY2-APCSY1 S:APCSM2<APCSM1 APCSAGEY=APCSAGEY-1

 S:APCSAGEY<1 APCSAGEY="<1"

 Q:APCSZ=1 APCSAGEY

 ;

 ;---> Age in Months.

 S APCSD1=$E(APCSM1,3,4),APCSM1=$E(APCSM1,1,2)

 S APCSD2=$E(APCSM2,3,4),APCSM2=$E(APCSM2,1,2)

 S APCSAGEM=12*APCSAGEY

 I APCSM2=APCSM1&(APCSD2<APCSD1) S APCSAGEM=APCSAGEM+12

 I APCSM2>APCSM1 S APCSAGEM=APCSAGEM+APCSM2-APCSM1

 I APCSM2<APCSM1 S APCSAGEM=APCSAGEM+APCSM2+(12-APCSM1)

 S:APCSD2<APCSD1 APCSAGEM=APCSAGEM-1

 Q:APCSZ=2 APCSAGEM

 ;

 ;---> Age in Days.

 S X1=APCSDT,X2=APCSDOB

 D ^%DTC

 Q X

 ;

 ;

 ;----------

AGEF(DFN,APCSDT) ;EP

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

 ;---> Parameters:

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

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

 ;

 N Y

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

 Q:Y["DECEASED" Y

 Q:Y["NOT BORN" Y

 ;

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

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

 ;

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

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

 ;

 ;---> Return months

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

 ;

 ;

 ;----------

DECEASED(DFN,APCSDT) ;EP

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

 ;---> Parameters:

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

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

 ;

 Q:'$G(DFN) 0

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

 Q:'X 0

 Q:'$G(APCSDT) 1

 Q X

 ;

 ;

APCSSILU  ; IHS/CMI/LAB - utilities for ili/h1n1 ;

 +1       ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009

 +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 aAPCSlity.  STREET+0

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

 +7       ;

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

DOB(DFN)  ;EP

 +1       ;---> Return Patient's Date of APCSrth 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,APCSZ,APCSDT) ;EP

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

 +2       ;---> Parameters:

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

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

 +5       ;                               2 will be assumed if not passed.

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

 +7       ;

 +8        NEW APCSDOB,X,X1,X2

           IF $GET(APCSZ)=""

               SET APCSZ=2

 +9        IF '$GET(DFN)

               QUIT ""

 +10       SET APCSDOB=$$DOB(DFN)

 +11       IF 'APCSDOB

               QUIT ""

 +12       IF '$GET(DT)

               SET DT=$$DT^XLFDT

 +13       IF '$GET(APCSDT)

               SET APCSDT=DT

 +14       IF APCSDT<APCSDOB

               QUIT ""

 +15      ;

 +16      ;---> Age in Years.

 +17       NEW APCSAGEY,APCSAGEM,APCSD1,APCSD2,APCSM1,APCSM2,APCSY1,APCSY2

 +18       SET APCSM1=$EXTRACT(APCSDOB,4,7)

           SET APCSM2=$EXTRACT(APCSDT,4,7)

 +19       SET APCSY1=$EXTRACT(APCSDOB,1,3)

           SET APCSY2=$EXTRACT(APCSDT,1,3)

 +20       SET APCSAGEY=APCSY2-APCSY1

           IF APCSM2<APCSM1

               SET APCSAGEY=APCSAGEY-1

 +21       IF APCSAGEY<1

               SET APCSAGEY="<1"

 +22       IF APCSZ=1

               QUIT APCSAGEY

 +23      ;

 +24      ;---> Age in Months.

 +25       SET APCSD1=$EXTRACT(APCSM1,3,4)

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

 +26       SET APCSD2=$EXTRACT(APCSM2,3,4)

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

 +27       SET APCSAGEM=12*APCSAGEY

 +28       IF APCSM2=APCSM1&(APCSD2<APCSD1)

               SET APCSAGEM=APCSAGEM+12

 +29       IF APCSM2>APCSM1

               SET APCSAGEM=APCSAGEM+APCSM2-APCSM1

 +30       IF APCSM2<APCSM1

               SET APCSAGEM=APCSAGEM+APCSM2+(12-APCSM1)

 +31       IF APCSD2<APCSD1

               SET APCSAGEM=APCSAGEM-1

 +32       IF APCSZ=2

               QUIT APCSAGEM

 +33      ;

 +34      ;---> Age in Days.

 +35       SET X1=APCSDT

           SET X2=APCSDOB

 +36       DO ^%DTC

 +37       QUIT X

 +38      ;

 +39      ;

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

AGEF(DFN,APCSDT) ;EP

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

 +2       ;---> Parameters:

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

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

 +5       ;

 +6        NEW Y

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

 +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(APCSDT))

               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(APCSDT))

               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,APCSDT) ;EP

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

 +2       ;---> Parameters:

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

 +4       ;     2 - APCSDT (opt) If APCSDT=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(APCSDT)

               QUIT 1

 +10       QUIT X

 +11      ;

 +12      ;