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