AUPNPAT3 ; IHS/CMI/LAB - PATIENT RELATED FUNCTIONS ; [ 05/09/2003 8:02 AM ]
;;99.1;IHS DICTIONARIES (PATIENT);**2,8,9,10,18,24**;MAR 9, 1999;Build 1
;
;IHS/CMI/LAB - patch 2 Y2K
;IHS/CMI/LAB - patch 8 DOD check in AGE subroutine
;IHS/OIT/NKD - patch 24 ICD10 support for Cause of Death
Q
;
AGE(DFN,D,F) ;EP - Given DFN, return Age.
I '$G(DFN) Q -1
I '$D(^DPT(DFN,0)) Q -1
I $$DOB^AUPNPAT(DFN,"")<0 Q -1
;S:$G(D)="" D=DT ;IHS/CMI/LAB - added DOD check patch 8
S:$G(D)="" D=$S(+$$DOD^AUPNPAT3(DFN):$$DOD^AUPNPAT3(DFN),1:DT)
S:$G(F)="" F="Y"
NEW %
S %=$$FMDIFF^XLFDT(D,$$DOB^AUPNPAT(DFN,""))
S %1=%\365.25
I F="Y" Q %1
Q $S(%1>2:%1_" YRS",%<31:%_" DYS",1:%\30_" MOS")
;
BEN(DFN,F) ;EP - returns classification/beneficiary in F format
;F="E":name of beneficiary type, F="I":ien of beneficiary type, F="C":code of beneficiary type
I '$G(DFN) Q -1
I '$D(^AUPNPAT(DFN,11)) Q -1
I $P(^AUPNPAT(DFN,11),"^",11)="" Q ""
I '$D(^AUTTBEN($P(^AUPNPAT(DFN,11),"^",11))) Q -1
S F=$G(F)
Q $S(F="I":$P(^AUPNPAT(DFN,11),"^",11),F="E":$P(^AUTTBEN($P(^AUPNPAT(DFN,11),"^",11),0),"^"),1:$P(^AUTTBEN($P(^AUPNPAT(DFN,11),"^",11),0),"^",2))
;
CDEATH(DFN,F) ;EP - returns Cause of Death in F format
;F="E":ICD narrative, F="I":ien of icd code, F="C":icd code
I '$G(DFN) Q ""
I '$D(^AUPNPAT(DFN)) Q ""
I '$P($G(^AUPNPAT(DFN,11)),"^",14) Q ""
I '$D(^ICD9($P(^AUPNPAT(DFN,11),"^",14))) Q ""
S F=$G(F)
I F="I" Q $P(^AUPNPAT(DFN,11),"^",14)
; IHS/OIT/NKD AUPN*99.1*24 - ADDED LINE FOR ICD10 API (SHORT DESCRIPTION)
I F="E",$$VERSION^XPDUTL("AICD")>3.51 Q $$VSTD^ICDEX($P(^AUPNPAT(DFN,11),"^",14),$S($P($G(^DPT(DFN,.35)),U,1)]"":$P(^DPT(DFN,.35),U,1),1:DT))
; IHS/OIT/NKD AUPN*99.1*24 - CORRECTED CALL FOR ICD9 NARRATIVE (SHOULD BE 4TH PIECE)
;I F="E" Q $P($$ICDDX^ICDCODE($P(^AUPNPAT(DFN,11),"^",14),$S($P($G(^DPT(DFN,.35)),U,1)]"":$P(^DPT(DFN,.35),U,1),1:DT)),"^",2) ;CSV
I F="E" Q $P($$ICDDX^ICDCODE($P(^AUPNPAT(DFN,11),"^",14),$S($P($G(^DPT(DFN,.35)),U,1)]"":$P(^DPT(DFN,.35),U,1),1:DT)),"^",4) ;CSV
; IHS/OIT/NKD AUPN*99.1*24 - ADDED LINE FOR ICD10 API (CODE)
I $$VERSION^XPDUTL("AICD")>3.51 Q $$CODEC^ICDEX(80,$P(^AUPNPAT(DFN,11),"^",14))
Q $P($$ICDDX^ICDCODE($P(^AUPNPAT(DFN,11),"^",14)),"^",2)
;
COMMRES(DFN,F) ;EP - Given DFN, return comm of res in F format
;F="E":community name, F="I":community ien, F="C":community STCTYCOM code
I '$G(DFN) Q -1
I '$D(^AUPNPAT(DFN,11)) Q -1
I $P(^AUPNPAT(DFN,11),"^",17)="" Q ""
I '$D(^AUTTCOM($P(^AUPNPAT(DFN,11),"^",17))) Q -1
S F=$G(F)
Q $S(F="I":$P(^AUPNPAT(DFN,11),"^",17),F="E":$P(^AUTTCOM($P(^AUPNPAT(DFN,11),"^",17),0),"^"),1:$P(^AUTTCOM($P(^AUPNPAT(DFN,11),"^",17),0),"^",8))
;
DOB(DFN,F) ;EP - Given DFN, return Date of Birth according to F.
; If F="E" produce the External form, else FM format.
I '$G(DFN) Q -1
I '$D(^DPT(DFN,0)) Q -1
S F=$G(F)
;beginning Y2K mods - change 2 parameter is FMTE call to 5
;Q $S(F="E":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3)),F="S":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3),2),1:$P(^DPT(DFN,0),"^",3)) ;Y2000 IHS/CMI/LAB - commented out
Q $S(F="E":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3)),F="S":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3),5),1:$P(^DPT(DFN,0),"^",3)) ;Y2000 IHS/CMI/LAB
;end Y2K mods
;
DOD(DFN,F) ;EP - Given DFN, return Date of Death according to F.
; If F="E" produce the External form, else FM format.
I '$G(DFN) Q -1
I '$D(^DPT(DFN,0)) Q -1
S F=$G(F)
Q $S(F="E":$$FMTE^XLFDT($P($G(^DPT(DFN,.35)),"^")),1:$P($G(^DPT(DFN,.35)),"^"))
;
ELIGSTAT(DFN,F) ;EP - returns eligibility status in F format
;F="E":eligibility type (name), F="I":internal set of codes
I '$G(DFN) Q -1
I '$D(^AUPNPAT(DFN,11)) Q -1
S F=$G(F)
Q $S(F="E":$$EXTSET^XBFUNC(9000001,1112,$P(^AUPNPAT(DFN,11),"^",12)),1:$P(^AUPNPAT(DFN,11),"^",12))
;
HRN(DFN,L,F) ;EP - return HRN at L location
;L must be ien of location of encounter
;F is optional. If F=2 hrn will be prefixed with site abbreviation
I '$G(DFN) Q -1
I '$D(^AUPNPAT(DFN)) Q -1
I '$G(L) Q -1
I $G(F)=2,'$D(^AUTTLOC(L,0)) Q -1
Q $S($D(^AUPNPAT(DFN,41,L,0)):$S($G(F)=2:$P(^AUTTLOC(L,0),"^",7)_" ",1:"")_$P(^AUPNPAT(DFN,41,L,0),"^",2),1:"")
Q $P($G(^AUPNPAT(DFN,41,L,0)),"^",2)
;
SEX(DFN) ;EP - Given DFN, return Sex.
I '$G(DFN) Q -1
I '$D(^DPT(DFN,0)) Q -1
Q $P(^DPT(DFN,0),"^",2)
;
SSN(DFN) ;EP - Given DFN, return SSN.
I '$G(DFN) Q -1
I '$D(^DPT(DFN,0)) Q -1
Q $P(^DPT(DFN,0),"^",9)
;
TRIBE(DFN,F) ;EP - Given DFN, return Tribe in F format
;If F="E", name of tribe returned, if F="I", internal ien of tribe
;returned, if F="C", tribe code returned
I '$G(DFN) Q -1
I '$D(^AUPNPAT(DFN,11)) Q -1
I $P(^AUPNPAT(DFN,11),"^",8)="" Q ""
I '$D(^AUTTTRI($P(^AUPNPAT(DFN,11),"^",8))) Q -1
S F=$G(F)
Q $S(F="I":$P(^AUPNPAT(DFN,11),"^",8),F="E":$P(^AUTTTRI($P(^AUPNPAT(DFN,11),"^",8),0),"^"),1:$P(^AUTTTRI($P(^AUPNPAT(DFN,11),"^",8),0),"^",2))
;
AUPNPAT3 ; IHS/CMI/LAB - PATIENT RELATED FUNCTIONS ; [ 05/09/2003 8:02 AM ]
+1 ;;99.1;IHS DICTIONARIES (PATIENT);**2,8,9,10,18,24**;MAR 9, 1999;Build 1
+2 ;
+3 ;IHS/CMI/LAB - patch 2 Y2K
+4 ;IHS/CMI/LAB - patch 8 DOD check in AGE subroutine
+5 ;IHS/OIT/NKD - patch 24 ICD10 support for Cause of Death
+6 QUIT
+7 ;
AGE(DFN,D,F) ;EP - Given DFN, return Age.
+1 IF '$GET(DFN)
QUIT -1
+2 IF '$DATA(^DPT(DFN,0))
QUIT -1
+3 IF $$DOB^AUPNPAT(DFN,"")<0
QUIT -1
+4 ;S:$G(D)="" D=DT ;IHS/CMI/LAB - added DOD check patch 8
+5 IF $GET(D)=""
SET D=$SELECT(+$$DOD^AUPNPAT3(DFN):$$DOD^AUPNPAT3(DFN),1:DT)
+6 IF $GET(F)=""
SET F="Y"
+7 NEW %
+8 SET %=$$FMDIFF^XLFDT(D,$$DOB^AUPNPAT(DFN,""))
+9 SET %1=%\365.25
+10 IF F="Y"
QUIT %1
+11 QUIT $SELECT(%1>2:%1_" YRS",%<31:%_" DYS",1:%\30_" MOS")
+12 ;
BEN(DFN,F) ;EP - returns classification/beneficiary in F format
+1 ;F="E":name of beneficiary type, F="I":ien of beneficiary type, F="C":code of beneficiary type
+2 IF '$GET(DFN)
QUIT -1
+3 IF '$DATA(^AUPNPAT(DFN,11))
QUIT -1
+4 IF $PIECE(^AUPNPAT(DFN,11),"^",11)=""
QUIT ""
+5 IF '$DATA(^AUTTBEN($PIECE(^AUPNPAT(DFN,11),"^",11)))
QUIT -1
+6 SET F=$GET(F)
+7 QUIT $SELECT(F="I":$PIECE(^AUPNPAT(DFN,11),"^",11),F="E":$PIECE(^AUTTBEN($PIECE(^AUPNPAT(DFN,11),"^",11),0),"^"),1:$PIECE(^AUTTBEN($PIECE(^AUPNPAT(DFN,11),"^",11),0),"^",2))
+8 ;
CDEATH(DFN,F) ;EP - returns Cause of Death in F format
+1 ;F="E":ICD narrative, F="I":ien of icd code, F="C":icd code
+2 IF '$GET(DFN)
QUIT ""
+3 IF '$DATA(^AUPNPAT(DFN))
QUIT ""
+4 IF '$PIECE($GET(^AUPNPAT(DFN,11)),"^",14)
QUIT ""
+5 IF '$DATA(^ICD9($PIECE(^AUPNPAT(DFN,11),"^",14)))
QUIT ""
+6 SET F=$GET(F)
+7 IF F="I"
QUIT $PIECE(^AUPNPAT(DFN,11),"^",14)
+8 ; IHS/OIT/NKD AUPN*99.1*24 - ADDED LINE FOR ICD10 API (SHORT DESCRIPTION)
+9 IF F="E"
IF $$VERSION^XPDUTL("AICD")>3.51
QUIT $$VSTD^ICDEX($PIECE(^AUPNPAT(DFN,11),"^",14),$SELECT($PIECE($GET(^DPT(DFN,.35)),U,1)]"":$PIECE(^DPT(DFN,.35),U,1),1:DT))
+10 ; IHS/OIT/NKD AUPN*99.1*24 - CORRECTED CALL FOR ICD9 NARRATIVE (SHOULD BE 4TH PIECE)
+11 ;I F="E" Q $P($$ICDDX^ICDCODE($P(^AUPNPAT(DFN,11),"^",14),$S($P($G(^DPT(DFN,.35)),U,1)]"":$P(^DPT(DFN,.35),U,1),1:DT)),"^",2) ;CSV
+12 ;CSV
IF F="E"
QUIT $PIECE($$ICDDX^ICDCODE($PIECE(^AUPNPAT(DFN,11),"^",14),$SELECT($PIECE($GET(^DPT(DFN,.35)),U,1)]"":$PIECE(^DPT(DFN,.35),U,1),1:DT)),"^",4)
+13 ; IHS/OIT/NKD AUPN*99.1*24 - ADDED LINE FOR ICD10 API (CODE)
+14 IF $$VERSION^XPDUTL("AICD")>3.51
QUIT $$CODEC^ICDEX(80,$PIECE(^AUPNPAT(DFN,11),"^",14))
+15 QUIT $PIECE($$ICDDX^ICDCODE($PIECE(^AUPNPAT(DFN,11),"^",14)),"^",2)
+16 ;
COMMRES(DFN,F) ;EP - Given DFN, return comm of res in F format
+1 ;F="E":community name, F="I":community ien, F="C":community STCTYCOM code
+2 IF '$GET(DFN)
QUIT -1
+3 IF '$DATA(^AUPNPAT(DFN,11))
QUIT -1
+4 IF $PIECE(^AUPNPAT(DFN,11),"^",17)=""
QUIT ""
+5 IF '$DATA(^AUTTCOM($PIECE(^AUPNPAT(DFN,11),"^",17)))
QUIT -1
+6 SET F=$GET(F)
+7 QUIT $SELECT(F="I":$PIECE(^AUPNPAT(DFN,11),"^",17),F="E":$PIECE(^AUTTCOM($PIECE(^AUPNPAT(DFN,11),"^",17),0),"^"),1:$PIECE(^AUTTCOM($PIECE(^AUPNPAT(DFN,11),"^",17),0),"^",8))
+8 ;
DOB(DFN,F) ;EP - Given DFN, return Date of Birth according to F.
+1 ; If F="E" produce the External form, else FM format.
+2 IF '$GET(DFN)
QUIT -1
+3 IF '$DATA(^DPT(DFN,0))
QUIT -1
+4 SET F=$GET(F)
+5 ;beginning Y2K mods - change 2 parameter is FMTE call to 5
+6 ;Q $S(F="E":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3)),F="S":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3),2),1:$P(^DPT(DFN,0),"^",3)) ;Y2000 IHS/CMI/LAB - commented out
+7 ;Y2000 IHS/CMI/LAB
QUIT $SELECT(F="E":$$FMTE^XLFDT($PIECE(^DPT(DFN,0),"^",3)),F="S":$$FMTE^XLFDT($PIECE(^DPT(DFN,0),"^",3),5),1:$PIECE(^DPT(DFN,0),"^",3))
+8 ;end Y2K mods
+9 ;
DOD(DFN,F) ;EP - Given DFN, return Date of Death according to F.
+1 ; If F="E" produce the External form, else FM format.
+2 IF '$GET(DFN)
QUIT -1
+3 IF '$DATA(^DPT(DFN,0))
QUIT -1
+4 SET F=$GET(F)
+5 QUIT $SELECT(F="E":$$FMTE^XLFDT($PIECE($GET(^DPT(DFN,.35)),"^")),1:$PIECE($GET(^DPT(DFN,.35)),"^"))
+6 ;
ELIGSTAT(DFN,F) ;EP - returns eligibility status in F format
+1 ;F="E":eligibility type (name), F="I":internal set of codes
+2 IF '$GET(DFN)
QUIT -1
+3 IF '$DATA(^AUPNPAT(DFN,11))
QUIT -1
+4 SET F=$GET(F)
+5 QUIT $SELECT(F="E":$$EXTSET^XBFUNC(9000001,1112,$PIECE(^AUPNPAT(DFN,11),"^",12)),1:$PIECE(^AUPNPAT(DFN,11),"^",12))
+6 ;
HRN(DFN,L,F) ;EP - return HRN at L location
+1 ;L must be ien of location of encounter
+2 ;F is optional. If F=2 hrn will be prefixed with site abbreviation
+3 IF '$GET(DFN)
QUIT -1
+4 IF '$DATA(^AUPNPAT(DFN))
QUIT -1
+5 IF '$GET(L)
QUIT -1
+6 IF $GET(F)=2
IF '$DATA(^AUTTLOC(L,0))
QUIT -1
+7 QUIT $SELECT($DATA(^AUPNPAT(DFN,41,L,0)):$SELECT($GET(F)=2:$PIECE(^AUTTLOC(L,0),"^",7)_" ",1:"")_$PIECE(^AUPNPAT(DFN,41,L,0),"^",2),1:"")
+8 QUIT $PIECE($GET(^AUPNPAT(DFN,41,L,0)),"^",2)
+9 ;
SEX(DFN) ;EP - Given DFN, return Sex.
+1 IF '$GET(DFN)
QUIT -1
+2 IF '$DATA(^DPT(DFN,0))
QUIT -1
+3 QUIT $PIECE(^DPT(DFN,0),"^",2)
+4 ;
SSN(DFN) ;EP - Given DFN, return SSN.
+1 IF '$GET(DFN)
QUIT -1
+2 IF '$DATA(^DPT(DFN,0))
QUIT -1
+3 QUIT $PIECE(^DPT(DFN,0),"^",9)
+4 ;
TRIBE(DFN,F) ;EP - Given DFN, return Tribe in F format
+1 ;If F="E", name of tribe returned, if F="I", internal ien of tribe
+2 ;returned, if F="C", tribe code returned
+3 IF '$GET(DFN)
QUIT -1
+4 IF '$DATA(^AUPNPAT(DFN,11))
QUIT -1
+5 IF $PIECE(^AUPNPAT(DFN,11),"^",8)=""
QUIT ""
+6 IF '$DATA(^AUTTTRI($PIECE(^AUPNPAT(DFN,11),"^",8)))
QUIT -1
+7 SET F=$GET(F)
+8 QUIT $SELECT(F="I":$PIECE(^AUPNPAT(DFN,11),"^",8),F="E":$PIECE(^AUTTTRI($PIECE(^AUPNPAT(DFN,11),"^",8),0),"^"),1:$PIECE(^AUTTTRI($PIECE(^AUPNPAT(DFN,11),"^",8),0),"^",2))
+9 ;
