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 ;
