Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMXUTL1

BMXUTL1.m

Go to the documentation of this file. 
  1. BMXUTL1 ; IHS/OIT/HMW - UTIL: PATIENT DEMOGRAPHICS ;
  1.  ;;4.0;BMX;;JUN 28, 2010
  1.  ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  UTILITY: PATIENT DEMOGRAPHICS.
  1.  ;
  1.  ;
  1.  ;----------
  1. NAME(DFN,ORDER) ;EP
  1.  ;---> Return text of Patient Name.
  1.  ;---> Parameters:
  1.  ;     1 - DFN   (req) Patient's IEN (DFN).
  1.  ;     2 - ORDER (opt) ""/0=Last,First   2=First Only
  1.  ;                        1=First Last   3=Last Only
  1.  ;
  1.  Q:'$G(DFN) "NO PATIENT"
  1.  Q:'$D(^DPT(DFN,0)) "Unknown"
  1.  N X S X=$P(^DPT(DFN,0),U)
  1.  Q:'$G(ORDER) X
  1.  S X=$$FL(X)
  1.  Q:ORDER=1 X
  1.  Q:ORDER=2 $P(X," ")
  1.  Q:ORDER=3 $P(X," ",2)
  1.  Q "UNKNOWN ORDER"
  1.  ;
  1.  ;
  1.  ;----------
  1. FL(X) ;EP
  1.  ;---> Switch First and Last Names.
  1.  Q $P($P(X,",",2)," ")_" "_$P(X,",")
  1.  ;
  1.  ;
  1.  ;----------
  1. DOB(DFN) ;EP
  1.  ;---> Return Patient's Date of Birth in Fileman format.
  1.  ;---> Parameters:
  1.  ;     1 - DFN   (req) Patient's IEN (DFN).
  1.  ;
  1.  Q:'$G(DFN) "NO PATIENT"
  1.  Q:'$P($G(^DPT(DFN,0)),U,3) "NOT ENTERED"
  1.  Q $P(^DPT(DFN,0),U,3)
  1.  ;
  1.  ;
  1.  ;----------
  1. DOBF(DFN,BMXDT,BMXNOA) ;EP
  1.  ;---> Date of Birth formatted "09-Sep-1994 (35 Months)"
  1.  ;---> Parameters:
  1.  ;     1 - DFN   (req) Patient's IEN (DFN).
  1.  ;     2 - BMXDT  (opt) Date on which Age should be calculated.
  1.  ;     3 - BMXNOA (opt) 1=No age (don't append age).
  1.  ;
  1.  N X,Y
  1.  S X=$$DOB($G(DFN))
  1.  Q:'X X
  1.  S X=$$TXDT1^BMXUTL5(X)
  1.  Q:$G(BMXNOA) X
  1.  S Y=$$AGEF(DFN,$G(BMXDT))
  1.  S:Y["DECEASED" Y="DECEASED"
  1.  S X=X_" ("_Y_")"
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. AGE(DFN,BMXZ,BMXDT) ;EP
  1.  ;---> Return Patient's Age.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) IEN in PATIENT File.
  1.  ;     2 - BMXZ  (opt) BMXZ=1,2,3  1=years, 2=months, 3=days.
  1.  ;                               2 will be assumed if not passed.
  1.  ;     3 - BMXDT (opt) Date on which Age should be calculated.
  1.  ;
  1.  N BMXDOB,X,X1,X2  S:$G(BMXZ)="" BMXZ=2
  1.  Q:'$G(DFN) "NO PATIENT"
  1.  S BMXDOB=$$DOB(DFN)
  1.  Q:'BMXDOB "Unknown"
  1.  I '$G(BMXDT)&($$DECEASED(DFN)) D  Q X
  1.  .S X="DECEASED: "_$$TXDT1^BMXUTL5(+^DPT(DFN,.35))
  1.  S:'$G(DT) DT=$$DT^XLFDT
  1.  S:'$G(BMXDT) BMXDT=DT
  1.  Q:BMXDT<BMXDOB "NOT BORN"
  1.  ;
  1.  ;---> Age in Years.
  1.  N BMXAGEY,BMXAGEM,BMXD1,BMXD2,BMXM1,BMXM2,BMXY1,BMXY2
  1.  S BMXM1=$E(BMXDOB,4,7),BMXM2=$E(BMXDT,4,7)
  1.  S BMXY1=$E(BMXDOB,1,3),BMXY2=$E(BMXDT,1,3)
  1.  S BMXAGEY=BMXY2-BMXY1 S:BMXM2<BMXM1 BMXAGEY=BMXAGEY-1
  1.  S:BMXAGEY<1 BMXAGEY="<1"
  1.  Q:BMXZ=1 BMXAGEY
  1.  ;
  1.  ;---> Age in Months.
  1.  S BMXD1=$E(BMXM1,3,4),BMXM1=$E(BMXM1,1,2)
  1.  S BMXD2=$E(BMXM2,3,4),BMXM2=$E(BMXM2,1,2)
  1.  S BMXAGEM=12*BMXAGEY
  1.  I BMXM2=BMXM1&(BMXD2<BMXD1) S BMXAGEM=BMXAGEM+12
  1.  I BMXM2>BMXM1 S BMXAGEM=BMXAGEM+BMXM2-BMXM1
  1.  I BMXM2<BMXM1 S BMXAGEM=BMXAGEM+BMXM2+(12-BMXM1)
  1.  S:BMXD2<BMXD1 BMXAGEM=BMXAGEM-1
  1.  Q:BMXZ=2 BMXAGEM
  1.  ;
  1.  ;---> Age in Days.
  1.  S X1=BMXDT,X2=BMXDOB
  1.  D ^%DTC
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. AGEF(DFN,BMXDT) ;EP
  1.  ;---> Age formatted "35 Months" or "23 Years"
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;     2 - BMXDT (opt) Date on which Age should be calculated.
  1.  ;
  1.  N Y
  1.  S Y=$$AGE(DFN,2,$G(BMXDT))
  1.  Q:Y["DECEASED" Y
  1.  Q:Y["NOT BORN" Y
  1.  ;
  1.  ;---> If over 60 months, return years.
  1.  Q:Y>60 $$AGE(DFN,1,$G(BMXDT))_" years"
  1.  ;
  1.  ;---> If under 1 month return days.
  1.  I Y<1 S Y=$$AGE(DFN,3,$G(BMXDT)) Q Y_$S(Y=1:" day",1:" days")
  1.  ;
  1.  ;---> Return months
  1.  Q Y_$S(Y=1:" month",1:" months")
  1.  ;
  1.  ;
  1.  ;----------
  1. DECEASED(DFN,BMXDT) ;EP
  1.  ;---> Return 1 if patient is deceased, 0 if not deceased.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;     2 - BMXDT (opt) If BMXDT=1 return Date of Death (Fileman format).
  1.  ;
  1.  Q:'$G(DFN) 0
  1.  N X S X=+$G(^DPT(DFN,.35))
  1.  Q:'X 0
  1.  Q:'$G(BMXDT) 1
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. SEX(DFN,PRON) ;EP
  1.  ;---> Return "F" is patient is female, "M" if male.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;     2 - PRON (opt) Pronoun: 1=he/she, 2=him/her,3=his,her
  1.  ;
  1.  Q:'$G(DFN) ""
  1.  Q:'$D(^DPT(DFN,0)) ""
  1.  N X S X=$P(^DPT(DFN,0),U,2)
  1.  Q:'$G(PRON) X
  1.  I PRON=1 Q $S(X="F":"she",1:"he")
  1.  I PRON=2 Q $S(X="F":"her",1:"him")
  1.  I PRON=3 Q $S(X="F":"her",1:"his")
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. SEXW(DFN) ;EP
  1.  ;---> Return Patient sex: "Female"/"Male".
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;
  1.  Q:$$SEX(DFN)="M" "Male"
  1.  Q:$$SEX(DFN)="F" "Female"
  1.  Q "Unknown"
  1.  ;
  1.  ;
  1.  ;----------
  1. NAMAGE(DFN) ;EP
  1.  ;---> Return Patient Name concatenated with age.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;
  1.  Q:'$G(DFN) "NO PATIENT"
  1.  Q $$NAME(DFN)_" ("_$$AGE(DFN)_"y/o)"
  1.  ;
  1.  ;
  1.  ;----------
  1. SSN(DFN) ;EP
  1.  ;---> Return Social Security Number (SSN).
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  N X
  1.  Q:'$G(DFN) "NO PATIENT"
  1.  Q:'$D(^DPT(DFN,0)) "Unknown"
  1.  S X=$P(^DPT(DFN,0),U,9)
  1.  Q:X']"" "Unknown"
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. HRCN(DFN,DUZ2,AGD) ;EP
  1.  ;---> Return IHS Health Record Number.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;     2 - DUZ2 (opt) User's Site/Location IEN.  If no DUZ2
  1.  ;                    provided, function will look for DUZ(2).
  1.  ;     3 - AGD  (opt) If AGD=1 return HRCN with no dashes.
  1.  ;
  1.  ;
  1.  S:'$G(DUZ2) DUZ2=$G(DUZ(2))
  1.  Q:'$G(DFN)!('$G(DUZ2)) "Unknown1"
  1.  Q:'$D(^AUPNPAT(DFN,41,DUZ2,0)) "Unknown2"
  1.  Q:'+$P(^AUPNPAT(DFN,41,DUZ2,0),"^",2) "Unknown3"
  1.  N Y S Y=$P(^AUPNPAT(DFN,41,DUZ2,0),"^",2)
  1.  Q:$G(AGD) Y
  1.  Q:'+Y Y
  1.  I $L(Y)=7 D  Q Y
  1.  .S Y=$TR("123-45-67",1234567,Y)
  1.  S Y=$E("00000",0,6-$L(Y))_Y
  1.  S Y=$TR("12-34-56",123456,Y)
  1.  Q Y
  1.  ;
  1.  ;
  1.  ;----------
  1. PHONE(AGDFN,AGOFF) ;EP
  1.  ;---> Return patient's home phone number.
  1.  ;---> Parameters:
  1.  ;     1 - AGDFN (req) Patient's IEN (DFN).
  1.  ;     2 - AGOFF (opt) =1 will return Patient's Office Phone.
  1.  ;
  1.  Q:'$G(AGDFN) "Error: No DFN"
  1.  Q $P($G(^DPT(AGDFN,.13)),U,$S($G(AGOFF):2,1:1))
  1.  ;
  1.  ;
  1.  ;----------
  1. STREET(DFN) ;EP
  1.  ;---> Return patient's street address.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;
  1.  Q:'$G(DFN) "No Patient"
  1.  Q:'$D(^DPT(DFN,.11)) ""
  1.  Q:$P(^DPT(DFN,.11),U)="" ""
  1.  Q $P(^DPT(DFN,.11),U)
  1.  ;
  1.  ;
  1.  ;----------
  1. CITY(DFN) ;EP
  1.  ;---> Return patient's city.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;
  1.  Q:'$G(DFN) "No Patient"
  1.  Q:'$D(^DPT(DFN,.11)) ""
  1.  Q:$P(^DPT(DFN,.11),U,4)="" ""
  1.  Q $P(^DPT(DFN,.11),U,4)
  1.  ;
  1.  ;
  1.  ;----------
  1. STATE(DFN,NOTEXT) ;EP
  1.  ;---> Return patient's state.
  1.  ;---> Parameters:
  1.  ;     1 - DFN    (req) Patient's IEN (DFN).
  1.  ;     2 - NOTEXT (opt) If NOTEXT=1 return only the State IEN.
  1.  ;                      If NOTEXT=2 return IEN|Text.
  1.  ;
  1.  Q:'$G(DFN) ""
  1.  N Y S Y=$P($G(^DPT(DFN,.11)),U,5)
  1.  Q:$G(NOTEXT)=1 Y
  1.  Q:$G(NOTEXT)=2 Y_"|"_$$GET^BMXG(1,Y)
  1.  Q $$GET^BMXG(1,Y)
  1.  ;
  1.  ;
  1.  ;----------
  1. ZIP(DFN) ;EP
  1.  ;---> Return patient's zipcode.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;
  1.  Q:'$G(DFN) "No Patient"
  1.  Q:'$D(^DPT(DFN,.11)) ""
  1.  Q:$P(^DPT(DFN,.11),U,6)="" ""
  1.  Q $P(^DPT(DFN,.11),U,6)
  1.  ;
  1.  ;
  1.  ;----------
  1. CTYSTZ(DFN) ;EP
  1.  ;---> Return patient's city, state zip.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;
  1.  Q:'$G(DFN) "No Patient"
  1.  Q $$CITY(DFN)_", "_$$STATE(DFN)_"  "_$$ZIP(DFN)
  1.  ;
  1.  ;
  1. CURCOM(DFN,NOTEXT) ;EP
  1.  ;---> Return patient's Current Community IEN or Text.
  1.  ;---> (Item 6 on page 1 of Registration).
  1.  ;---> Parameters:
  1.  ;     1 - DFN    (req) Patient's IEN (DFN).
  1.  ;     2 - NOTEXT (opt) If NOTEXT=1 return only the Current Comm IEN.
  1.  ;                      If NOTEXT=2 return IEN|Text.
  1.  ;
  1.  Q:'$G(DFN) "No Patient"
  1.  Q:'$D(^AUPNPAT(DFN,11)) ""  ;"Unknown1"
  1.  ;
  1.  N X,Y,Z
  1.  S X=^AUPNPAT(DFN,11)
  1.  ;---> Set Y=Pointer (IEN in ^AUTTCOM, piece 17), Z=Text (piece 18).
  1.  S Y=$P(X,U,17),Z=$P(X,U,18)
  1.  ;---> If both Pointer and Text are null, return "Unknown2".
  1.  Q:('Y&(Z="")) ""  ;"Unknown2"
  1.  ;
  1.  ;---> If Y is null or a bad pointer, set Y="".
  1.  I Y<1!('$D(^AUTTCOM(+Y,0))) S Y=""
  1.  ;
  1.  ;---> If no valid pointer and if Text (pc 18) exists in the
  1.  ;---> Community file, then set Y=IEN in ^AUTTCOM(.
  1.  I Y<1,$D(^AUTTCOM("B",Z)) S Y=$O(^AUTTCOM("B",Z,0))
  1.  ;
  1.  Q:'$D(^AUTTCOM(+Y,0)) ""  ;"Unknown3"
  1.  Q:$G(NOTEXT)=1 Y
  1.  Q:$G(NOTEXT)=2 Y_"|"_$$GET^BMXG(2,Y)
  1.  Q $$GET^BMXG(2,Y)
  1.  ;
  1.  ;
  1.  ;----------
  1. PERSON(X,ORDER) ;EP
  1.  ;---> Return person's name from File #200.
  1.  ;---> Parameters:
  1.  ;     1 - X     (req) Person's IEN in New Person File #200.
  1.  ;     2 - ORDER (opt) ""/0=Last,First   1=First Last
  1.  ;
  1.  Q:'X "Unknown"
  1.  Q:'$D(^VA(200,X,0)) "Unknown"
  1.  N Y S Y=$P(^VA(200,X,0),U)
  1.  Q:'$G(ORDER) Y
  1.  Q $$FL(Y)