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

AUPNPAT3.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;IHS/CMI/LAB - patch 2 Y2K
  1.  ;IHS/CMI/LAB - patch 8 DOD check in AGE subroutine
  1.  ;IHS/OIT/NKD - patch 24 ICD10 support for Cause of Death
  1.  Q
  1.  ;
  1. AGE(DFN,D,F) ;EP - Given DFN, return Age.
  1.  I '$G(DFN) Q -1
  1.  I '$D(^DPT(DFN,0)) Q -1
  1.  I $$DOB^AUPNPAT(DFN,"")<0 Q -1
  1.  ;S:$G(D)="" D=DT ;IHS/CMI/LAB - added DOD check patch 8
  1.  S:$G(D)="" D=$S(+$$DOD^AUPNPAT3(DFN):$$DOD^AUPNPAT3(DFN),1:DT)
  1.  S:$G(F)="" F="Y"
  1.  NEW %
  1.  S %=$$FMDIFF^XLFDT(D,$$DOB^AUPNPAT(DFN,""))
  1.  S %1=%\365.25
  1.  I F="Y" Q %1
  1.  Q $S(%1>2:%1_" YRS",%<31:%_" DYS",1:%\30_" MOS")
  1.  ;
  1. 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
  1.  I '$G(DFN) Q -1
  1.  I '$D(^AUPNPAT(DFN,11)) Q -1
  1.  I $P(^AUPNPAT(DFN,11),"^",11)="" Q ""
  1.  I '$D(^AUTTBEN($P(^AUPNPAT(DFN,11),"^",11))) Q -1
  1.  S F=$G(F)
  1.  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))
  1.  ;
  1. 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
  1.  I '$G(DFN) Q ""
  1.  I '$D(^AUPNPAT(DFN)) Q ""
  1.  I '$P($G(^AUPNPAT(DFN,11)),"^",14) Q ""
  1.  I '$D(^ICD9($P(^AUPNPAT(DFN,11),"^",14))) Q ""
  1.  S F=$G(F)
  1.  I F="I" Q $P(^AUPNPAT(DFN,11),"^",14)
  1.  ; IHS/OIT/NKD AUPN*99.1*24 - ADDED LINE FOR ICD10 API (SHORT DESCRIPTION)
  1.  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))
  1.  ; IHS/OIT/NKD AUPN*99.1*24 - CORRECTED CALL FOR ICD9 NARRATIVE (SHOULD BE 4TH PIECE)
  1.  ;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
  1.  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
  1.  ; IHS/OIT/NKD AUPN*99.1*24 - ADDED LINE FOR ICD10 API (CODE)
  1.  I $$VERSION^XPDUTL("AICD")>3.51 Q $$CODEC^ICDEX(80,$P(^AUPNPAT(DFN,11),"^",14))
  1.  Q $P($$ICDDX^ICDCODE($P(^AUPNPAT(DFN,11),"^",14)),"^",2)
  1.  ;
  1. 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
  1.  I '$G(DFN) Q -1
  1.  I '$D(^AUPNPAT(DFN,11)) Q -1
  1.  I $P(^AUPNPAT(DFN,11),"^",17)="" Q ""
  1.  I '$D(^AUTTCOM($P(^AUPNPAT(DFN,11),"^",17))) Q -1
  1.  S F=$G(F)
  1.  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))
  1.  ;
  1. DOB(DFN,F) ;EP - Given DFN, return Date of Birth according to F.
  1.  ; If F="E" produce the External form, else FM format.
  1.  I '$G(DFN) Q -1
  1.  I '$D(^DPT(DFN,0)) Q -1
  1.  S F=$G(F)
  1.  ;beginning Y2K mods - change 2 parameter is FMTE call to 5
  1.  ;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
  1.  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
  1.  ;end Y2K mods
  1.  ;
  1. DOD(DFN,F) ;EP - Given DFN, return Date of Death according to F.
  1.  ; If F="E" produce the External form, else FM format.
  1.  I '$G(DFN) Q -1
  1.  I '$D(^DPT(DFN,0)) Q -1
  1.  S F=$G(F)
  1.  Q $S(F="E":$$FMTE^XLFDT($P($G(^DPT(DFN,.35)),"^")),1:$P($G(^DPT(DFN,.35)),"^"))
  1.  ;
  1. ELIGSTAT(DFN,F) ;EP - returns eligibility status in F format
  1.  ;F="E":eligibility type (name), F="I":internal set of codes
  1.  I '$G(DFN) Q -1
  1.  I '$D(^AUPNPAT(DFN,11)) Q -1
  1.  S F=$G(F)
  1.  Q $S(F="E":$$EXTSET^XBFUNC(9000001,1112,$P(^AUPNPAT(DFN,11),"^",12)),1:$P(^AUPNPAT(DFN,11),"^",12))
  1.  ;
  1. HRN(DFN,L,F) ;EP - return HRN at L location
  1.  ;L must be ien of location of encounter
  1.  ;F is optional.  If F=2 hrn will be prefixed with site abbreviation
  1.  I '$G(DFN) Q -1
  1.  I '$D(^AUPNPAT(DFN)) Q -1
  1.  I '$G(L) Q -1
  1.  I $G(F)=2,'$D(^AUTTLOC(L,0)) Q -1
  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:"")
  1.  Q $P($G(^AUPNPAT(DFN,41,L,0)),"^",2)
  1.  ;
  1. SEX(DFN) ;EP - Given DFN, return Sex.
  1.  I '$G(DFN) Q -1
  1.  I '$D(^DPT(DFN,0)) Q -1
  1.  Q $P(^DPT(DFN,0),"^",2)
  1.  ;
  1. SSN(DFN) ;EP - Given DFN, return SSN.
  1.  I '$G(DFN) Q -1
  1.  I '$D(^DPT(DFN,0)) Q -1
  1.  Q $P(^DPT(DFN,0),"^",9)
  1.  ;
  1. 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
  1.  ;returned, if F="C", tribe code returned
  1.  I '$G(DFN) Q -1
  1.  I '$D(^AUPNPAT(DFN,11)) Q -1
  1.  I $P(^AUPNPAT(DFN,11),"^",8)="" Q ""
  1.  I '$D(^AUTTTRI($P(^AUPNPAT(DFN,11),"^",8))) Q -1
  1.  S F=$G(F)
  1.  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))
  1.  ;