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

BQIULPT.m

Go to the documentation of this file. 
  1. BQIULPT ;VNGT/HS/ALA-Patient Data Utilities ; 17 Oct 2005  3:17 PM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
  1.  ;
  1.  ; This is a utility program containing special function calls
  1.  ; needed for patient demographic data.
  1.  Q
  1.  ;
  1. HRN(DFN) ;EP -- Current Location Patient Health Record Number
  1.  ;
  1.  ;Description
  1.  ;  Returns the patient's health record number
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;  DUZ(2) - Assumes DUZ(2) exists since it's defined by
  1.  ;           signing on to the system as the user's default
  1.  ;           facility
  1.  ;Output
  1.  ;  HRN - Health Record number for the user's default
  1.  ;        facility
  1.  ;
  1.  I $G(DUZ(2))="" Q ""
  1.  I $G(DFN)="" Q ""
  1.  ;
  1.  NEW HRN
  1.  S HRN=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
  1.  I $P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,3)'="" S HRN="*"_HRN
  1.  Q HRN
  1.  ;
  1. HRNL(DFN) ;EP -- List of HRNs for a patient
  1.  NEW HRN,LOC,HDATA,ABR,VAL,ULOC,DVAL
  1.  S LOC=0,VAL=""
  1.  S DVAL=$$HLK(DUZ(2)),DVAL=$$TKO^BQIUL1(DVAL,"-")
  1.  I DVAL'="" S VAL=VAL_DVAL_";"
  1.  F  S LOC=$O(^AUPNPAT(DFN,41,LOC)) Q:'LOC  D
  1.  . Q:LOC=DUZ(2)
  1.  . S DVAL=$$HLK(LOC),DVAL=$$TKO^BQIUL1(DVAL,"-")
  1.  . I DVAL'="" S VAL=VAL_DVAL_";"
  1.  Q $$TKO^BQIUL1(VAL,";")
  1.  ;
  1. HLK(ULOC) ; EP - Get HRN data for a location
  1.  NEW HDATA,IACT
  1.  S HDATA=$G(^AUPNPAT(DFN,41,ULOC,0))
  1.  S HRN=$P(HDATA,U,2),IACT=$P(HDATA,U,3)
  1.  I HRN="" Q ""
  1.  ;S ABR=$P($G(^AUTTLOC(ULOC,1)),U,2)
  1.  S ABR=$P(^AUTTLOC(ULOC,0),U,7)
  1.  I IACT'="" S HRN="*"_HRN
  1.  Q HRN_"-"_ABR
  1.  ;
  1. DPCP(DFN) ;EP -- Get patient's designated primary care provider
  1.  ;
  1.  ;Description
  1.  ;  Checks the 'Designated Provider Management System' first
  1.  ;  for the patient's primary care provider, otherwise it
  1.  ;  checks the Patient file.
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;Output
  1.  ;  DPCPN^DPCPNM
  1.  ;    DPCPN  - Primary Care Provider internal entry number
  1.  ;    DPCPNM - Primary Care Provider Name
  1.  ;
  1.  NEW DPCAT,DPIEN,DPCPN,DPCPNM,TRM
  1.  S DPCPN="",TRM=0
  1.  S DPCAT=$O(^BDPTCAT("B","DESIGNATED PRIMARY PROVIDER",""))
  1.  I DPCAT'="" D
  1.  . S DPIEN=$O(^BDPRECN("AA",DFN,DPCAT,""))
  1.  . I DPIEN="" Q
  1.  . S DPCPN=$$GET1^DIQ(90360.1,DPIEN_",",.03,"I") I DPCPN="" Q
  1.  . I $P($G(^VA(200,DPCPN,0)),"^",13)'="" S TRM=1
  1.  . S DPCPNM=$$GET1^DIQ(90360.1,DPIEN_",",.03,"E")
  1.  I DPCPN'="" Q DPCPN_"^"_$S(TRM:"*",1:"")_DPCPNM
  1.  ;
  1.  S DPCPN=$$GET1^DIQ(9000001,DFN_",",.14,"I")
  1.  I DPCPN'="",$P($G(^VA(200,DPCPN,0)),"^",13)'="" S TRM=1
  1.  S DPCPNM=$$GET1^DIQ(9000001,DFN_",",.14,"E")
  1.  Q DPCPN_"^"_$S(TRM:"*",1:"")_DPCPNM
  1.  ;
  1. CM(DFN) ;EP -- Get patient's case manager
  1.  ;
  1.  ;Description
  1.  ;  Check the 'Designated Provider Management System' for a
  1.  ;  Case Manager, if there isn't one where look then?**
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;Output
  1.  ;  CMGRN - Case Manager internal entry number
  1.  NEW DPCAT,DPIEN,CMGRN,CMGRNM
  1.  S CMGRN=""
  1.  S DPCAT=$O(^BDPTCAT("B","CASE MANAGER",""))
  1.  I DPCAT'="" D
  1.  . S DPIEN=$O(^BDPRECN("AA",DFN,DPCAT,""))
  1.  . I DPIEN="" Q
  1.  . S CMGRN=$$GET1^DIQ(90360.1,DPIEN_",",.03,"I")
  1.  . S CMGRNM=$$GET1^DIQ(90360.1,DPIEN_",",.03,"E")
  1.  I CMGRN'="" Q CMGRN_"^"_CMGRNM
  1.  Q CMGRN
  1.  ;
  1. BPD(DFN,VWIEN) ;EP - Get patient's provider from DSPM
  1.  NEW PROV,VCODE,VCAT,VDN,VDESC,VALUE
  1.  S VCODE=$P(^BQI(90506.1,VWIEN,0),U,1),VCAT=$E(VCODE,4,$L(VCODE))
  1.  I VCODE="" Q ""
  1.  I VCAT="" Q ""
  1.  S VDN=$O(^BDPTCAT("C",VCAT,"")),VDESC=$P(^BDPTCAT(VDN,0),U,1)
  1.  D ALLDP^BDPAPI(DFN,VDESC,.VALUE)
  1.  I '$D(VALUE) Q ""
  1.  Q $P(VALUE(VDESC),U,2)_"^"_$P(VALUE(VDESC),U,1)
  1.  ;
  1. LVD(DFN) ;EP -- Get patient's last visit
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;
  1.  NEW VIEN,LVISIT,QFL,LVSDT
  1.  S VIEN="",LVISIT="",QFL=0,LVSDT=""
  1.  S LVSDT=$O(^AUPNVSIT("AA",DFN,LVSDT)) I LVSDT="" Q LVISIT
  1.  S LVSDT=""
  1.  F  S LVSDT=$O(^AUPNVSIT("AA",DFN,LVSDT)) Q:LVSDT=""  D  Q:QFL
  1.  . F  S VIEN=$O(^AUPNVSIT("AA",DFN,LVSDT,VIEN)) Q:VIEN=""  D  Q:QFL
  1.  .. I $$GET1^DIQ(9000010,VIEN,.11,"I")=1 Q
  1.  .. I $G(^AUPNVSIT(VIEN,0))="" Q
  1.  .. Q:"DXCTI"[$P(^AUPNVSIT(VIEN,0),U,7)
  1.  .. S LVISIT=VIEN,QFL=1
  1.  Q LVISIT
  1.  ;
  1. LVDT(DFN) ;EP -- Get patient's last visit date/time
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;
  1.  NEW VIEN
  1.  S VIEN=$$LVD(.DFN)
  1.  I VIEN="" Q ""
  1.  Q $$FMTE^BQIUL1($$GET1^DIQ(9000010,VIEN_",",.01,"I"))
  1.  ;
  1. LVC(DFN) ;EP -- Get patient's last visit clinic
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW VIEN,CST
  1.  S VIEN=$$LVD(.DFN)
  1.  I VIEN="" Q ""
  1.  S CST=$$GET1^DIQ(9000010,VIEN_",",.08,"I")
  1.  I CST="" Q ""
  1.  Q $$GET1^DIQ(9000010,VIEN_",",.08,"E")_" "_$$GET1^DIQ(40.7,CST_",",1,"E")
  1.  ;
  1. LVLC(DFN) ;EP -- Get patient's last visit location
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW VIEN,CST
  1.  S VIEN=$$LVD(.DFN)
  1.  I VIEN="" Q ""
  1.  S CST=$$GET1^DIQ(9000010,VIEN_",",.06,"E")
  1.  I CST="" Q "UNKNOWN"
  1.  Q CST
  1.  ;
  1. LVP(DFN) ;EP -- Get patient's last visit primary provider
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW VIEN,PRV
  1.  S VIEN=$$LVD(.DFN)
  1.  I VIEN="" Q ""
  1.  S PRV=$$PRIMVPRV^PXUTL1(VIEN)
  1.  I PRV=0 Q ""
  1.  Q $$GET1^DIQ(200,PRV_",",.01,"E")
  1.  ;
  1. LVDN(DFN) ;EP -- Get patient's last visit POV narratives
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW VIEN,TEXT,IEN,POVN
  1.  S VIEN=$$LVD(.DFN),TEXT="",IEN=""
  1.  I VIEN="" Q ""
  1.  F  S IEN=$O(^AUPNVPOV("AD",VIEN,IEN)) Q:IEN=""  D
  1.  . S POVN=$$GET1^DIQ(9000010.07,IEN_",",".019","E")
  1.  . I $L(TEXT)+$L(POVN)>250 Q
  1.  . S TEXT=TEXT_POVN_$C(13)_$C(10)
  1.  Q $$TKO^BQIUL1(TEXT,$C(13)_$C(10))
  1.  ;
  1. LVPN(DFN) ;EP -- Get patient's last visit provider narratives
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW VIEN,TEXT,IEN,PRVN
  1.  S VIEN=$$LVD(.DFN),TEXT="",IEN=""
  1.  I VIEN="" Q ""
  1.  F  S IEN=$O(^AUPNVPOV("AD",VIEN,IEN)) Q:IEN=""  D
  1.  . S PRVN=$$GET1^DIQ(9000010.07,IEN_",",".04","E")
  1.  . I $L(TEXT)+$L(PRVN)>250 Q
  1.  . S TEXT=TEXT_PRVN_$C(13)_$C(10)
  1.  Q $$TKO^BQIUL1(TEXT,$C(13)_$C(10))
  1.  ;
  1. NAD(DFN) ;EP -- Get patient's next appt date
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW NAPTM
  1.  S NAPTM=$$NOW^XLFDT()
  1.  S NAPTM=$O(^DPT(DFN,"S",NAPTM)) I NAPTM="" Q ""
  1.  I $P(^DPT(DFN,"S",NAPTM,0),"^",2)'="" Q ""
  1.  Q $$FMTE^BQIUL1(NAPTM)
  1.  ;
  1. NAPT(DFN) ;EP -- Get patient's next appt
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW NAPTM
  1.  S NAPTM=$$NOW^XLFDT()
  1.  Q $O(^DPT(DFN,"S",NAPTM))
  1.  ;
  1. NAC(DFN) ;EP -- Get patient's next appt date's clinic
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;
  1.  NEW NAPTM,IENS,DA,NAN,CSTCD,CST
  1.  S NAPTM=$$NAPT(DFN)
  1.  I NAPTM="" Q ""
  1.  S DA(1)=DFN,DA=NAPTM,IENS=$$IENS^DILF(.DA)
  1.  S NAN=$$GET1^DIQ(2.98,IENS,.01,"I")
  1.  I NAN="" Q ""
  1.  S CST=$$GET1^DIQ(44,NAN_",",8,"I"),CSTCD=""
  1.  I CST'="" S CSTCD=$$GET1^DIQ(40.7,CST_",",1,"E")
  1.  Q $$GET1^DIQ(2.98,IENS,.01,"E")_" "_CSTCD
  1.  ;
  1. NAPV(DFN) ;EP -- Get patient's next appt provider
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;
  1.  NEW NAPTM,IENS,DA,NAN,CSTCD,CST,PRNAME,PRNM,PRN
  1.  S NAPTM=$$NAPT(DFN)
  1.  I NAPTM="" Q ""
  1.  S DA(1)=DFN,DA=NAPTM,IENS=$$IENS^DILF(.DA)
  1.  S NAN=$$GET1^DIQ(2.98,IENS,.01,"I")
  1.  I NAN="" Q ""
  1.  S PRNAME=$$GET1^DIQ(44,NAN_",",16,"E")
  1.  I PRNAME="" D
  1.  . S PRN=0
  1.  . F  S PRN=$O(^SC(NAN,"PR",PRN)) Q:'PRN  D
  1.  .. I $P($G(^SC(NAN,"PR",PRN,0)),U,2)=1 D
  1.  ... S PRNM=$P($G(^SC(NAN,"PR",PRN,0)),U,1)
  1.  ... S PRNAME=$$GET1^DIQ(200,PRNM_",",.01,"E")
  1.  Q PRNAME
  1.  ;
  1. SENS(DFN) ;EP -- Is patient sensitive flag
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW FLAG
  1.  S FLAG=+$P($G(^DGSL(38.1,+DFN,0)),"^",2)
  1.  S FLAG=$S(FLAG=1:"Y",1:"N")
  1.  Q FLAG
  1.  ;
  1. FLG(USR,PANEL,DFN) ;EP -- Get flag indicator for a specific user and panel
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;  USR - User internal entry number
  1.  ;  PANEL - Panel internal entry number
  1.  ;
  1.  NEW BQIPREF,FLG
  1.  D RET^BQIFLAG(USR,.BQIPREF)
  1.  S FLG=$$FPAT^BQIFLAG(DFN,USR,.BQIPREF)
  1.  S FLG=$S(FLG>0:"Y",1:"")
  1.  Q FLG
  1.  ;
  1. MFLAG(USR,PANEL,DFN) ;EP -- Get manual flag
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;  USR - User internal entry number
  1.  ;  PANEL - Panel internal entry number
  1.  NEW DA,IENS,MFLG
  1.  S MFLG=""
  1.  I $G(USR)="" Q MFLG
  1.  I $G(PANEL)="" Q MFLG
  1.  I $G(DFN)="" Q MFLG
  1.  S DA(2)=USR,DA(1)=PANEL,DA=DFN,IENS=$$IENS^DILF(.DA)
  1.  S MFLG=$$GET1^DIQ(90505.04,IENS,.02,"I")
  1.  Q MFLG
  1.  ;
  1. PADD(USR,PANEL,DFN) ;EP -- Get patient added to panel date/time
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  ;  USR - User internal entry number
  1.  ;  PANEL - Panel internal entry number
  1.  NEW DA,IENS,ADDTM
  1.  S ADDTM=""
  1.  I $G(USR)="" Q ADDTM
  1.  I $G(PANEL)="" Q ADDTM
  1.  I $G(DFN)="" Q ADDTM
  1.  S DA(2)=USR,DA(1)=PANEL,DA=DFN,IENS=$$IENS^DILF(.DA)
  1.  S ADDTM=$$GET1^DIQ(90505.04,IENS,.04,"I")
  1.  I ADDTM="" S ADDTM=$$GET1^DIQ(90505.04,IENS,.07,"I")
  1.  Q $$FMTE^BQIUL1(ADDTM)
  1.  ;
  1. GMET(DFN) ;EP -- Get a patient's GPRA MET value
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW STVW,GMET,GHDR,HDR,VAL,NUM,DEN,BQIDOD
  1.  S GMET="",GHDR="T00003GPRM",STVW=""
  1.  S BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
  1.  F  S STVW=$O(^BQIPAT(DFN,30,"B",STVW)) Q:STVW=""  D
  1.  . D GVAL^BQIGPRA1
  1.  Q $S(BQIDOD'="":"D",GMET=1:"YES",GMET=0:"NO",1:"NDA")
  1.  ;
  1. DCAT(DFN) ;EP -- Get a patient's diagnosis categories
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW CAT,CATA,LIST,DIEN,STAT,CNAM,DOD
  1.  S DOD=$$GET1^DIQ(2,DFN_",",.351,"I")
  1.  I DOD'="" Q "{D}"  ;Deceased patient
  1.  S CAT=""
  1.  F  S CAT=$O(^BQIREG("C",DFN,CAT)) Q:CAT=""  D
  1.  . S DIEN=""
  1.  . F  S DIEN=$O(^BQIREG("C",DFN,CAT,DIEN)) Q:DIEN=""  D
  1.  .. S CATA=$$GET1^DIQ(90506.2,CAT_",",.07,"E")
  1.  .. S CNAM=$$GET1^DIQ(90506.2,CAT_",",.01,"E")
  1.  .. S STAT=$P(^BQIREG(DIEN,0),U,3)
  1.  .. I STAT="V"!(STAT="S")!(STAT="N") Q
  1.  .. ;I STAT="V"!(STAT="S") S CATA(CATA)="" Q
  1.  .. ;S CATA(CATA)=$S(STAT="A":"*",1:"?")
  1.  .. S CATA(CATA)=" ("_STAT_")"
  1.  ;
  1.  S CAT="",LIST=""
  1.  F  S CAT=$O(CATA(CAT)) Q:CAT=""  S LIST=LIST_CAT_CATA(CAT)_"; "
  1.  S LIST=$E(LIST,1,$L(LIST)-2)
  1.  Q LIST
  1.  ;
  1. REM(DFN,MIEN) ;EP -- Get a patient's reminder value
  1.  ;Input
  1.  ;  DFN  - Patient internal entry number
  1.  ;  MIEN - Reminder my measure internal entry number
  1.  I $G(MIEN)="" Q ""
  1.  NEW TYPE,CODE,TIEN,NAME,PIEN,VALUE,DUDT,VAL,CT,ODT
  1.  S TYPE=$P($G(^BQI(90506.1,MIEN,3)),U,1) I TYPE="" Q ""
  1.  S CODE=$P(^BQI(90506.1,MIEN,0),U,1)
  1.  S TIEN=$P(CODE,"_",2)
  1.  S NAME=$P(^BQI(90506.1,MIEN,0),U,3)
  1.  ;
  1.  S PIEN=$O(^BQIPAT(DFN,40,"B",CODE,"")) I PIEN="" Q ""
  1.  S VALUE=$G(^BQIPAT(DFN,40,PIEN,0))
  1.  S CT=0
  1.  F I=2:1:4 S:$P(VALUE,U,I)'="" CT=CT+1
  1.  I CT=0 Q "N/A"
  1.  S DUDT=$P(VALUE,U,4) S:DUDT="" DUDT=DT
  1.  S ODT=$$FMADD^XLFDT(DT,-30)
  1.  Q $S(DUDT<ODT:"O",DUDT>DT:"F",1:"C")
  1.  ;
  1. OVD(DFN) ; EP - Overdue reminders
  1.  ; Output
  1.  ;   1 if patient has any overdue reminders
  1.  ;   0 if patient does not have any overdue reminders
  1.  NEW TYPE,CODE,TIEN,NAME,PIEN,VALUE,DUDT,VAL,CT,ODT,OVDF
  1.  S MIEN="",OVDF=0
  1.  F  S MIEN=$O(^BQI(90506.1,"AC","R",MIEN)) Q:MIEN=""  D
  1.  . I $P(^BQI(90506.1,MIEN,0),U,10)=1 Q
  1.  . S CODE=$P(^BQI(90506.1,MIEN,0),U,1)
  1.  . S TIEN=$P(CODE,"_",2)
  1.  . S NAME=$P(^BQI(90506.1,MIEN,0),U,3)
  1.  . ;
  1.  . S PIEN=$O(^BQIPAT(DFN,40,"B",CODE,"")) I PIEN="" Q
  1.  . S VALUE=$G(^BQIPAT(DFN,40,PIEN,0))
  1.  . S CT=0
  1.  . F I=2:1:4 S:$P(VALUE,U,I)'="" CT=CT+1
  1.  . I CT=0 S OVDF=0 Q
  1.  . S DUDT=$P(VALUE,U,4) S:DUDT="" DUDT=DT
  1.  . S ODT=$$FMADD^XLFDT(DT,-30)
  1.  . ; If the due date (DUDT) is less then it's overdue
  1.  . S OVDF=$S(DUDT<ODT:1,1:0)
  1.  Q OVDF
  1.  ;
  1. PER(DFN,MIEN) ;EP -- Get a patient's performance value
  1.  ;Input
  1.  ;  DFN  - Patient internal entry number
  1.  ;  MIEN - Reminder my measure internal entry number
  1.  I $G(MIEN)="" Q ""
  1.  NEW TYPE,CODE,TIEN,PIEN,GYR,BQIH,BQIY,NAFLG,DEN,NUM,VER,BQIDOD
  1.  S TYPE=$P($G(^BQI(90506.1,MIEN,3)),U,1) I TYPE="" Q ""
  1.  S CODE=$P(^BQI(90506.1,MIEN,0),U,1)
  1.  S GYR=$P(CODE,"_",1),TIEN=$P(CODE,"_",2)
  1.  ;
  1.  S BQIDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
  1.  S PIEN=$O(^BQIPAT(DFN,30,"B",CODE,""))
  1.  I PIEN="",BQIDOD'="" Q "D"  ;Deceased patient
  1.  I PIEN="" Q "NDA"
  1.  S BQIH=$$SPM^BQIGPUTL()
  1.  S BQIY=$$LKP^BQIGPUTL(GYR)
  1.  D GFN^BQIGPUTL(BQIH,BQIY)
  1.  S VER=$$VERSION^XPDUTL("BGP")
  1.  I VER>7.0 D
  1.  . S NAFLG=$$GET1^DIQ(BQIMEASF,TIEN_",",1704,"I")
  1.  . S NAFLG=$S(NAFLG="Y":1,1:0)
  1.  ;
  1.  S DEN=$P(^BQIPAT(DFN,30,PIEN,0),U,4)
  1.  S NUM=+$P(^BQIPAT(DFN,30,PIEN,0),U,3)
  1.  I DEN="" S VAL=$S(NAFLG=1:0,1:"N/A")
  1.  I DEN D
  1.  . I 'NUM S VAL=$S(NAFLG=1:0,1:"NO"),GMET=0 Q
  1.  . S VAL=$S(NAFLG=1:NUM,1:"YES")
  1.  Q VAL
  1.  ;
  1. CALR(DFN) ;EP - Get community alert flag
  1.  NEW TEMP,ADATE,COMM,CMN
  1.  S ADATE=$$DATE^BQIUL1("T-30")
  1.  ;S ADATE=$$DATE^BQIUL1("T-36M") ;**Temporary for testing**
  1.  ;
  1.  S COMM=$$GET1^DIQ(9000001,DFN_",",1117,"I"),CMN=COMM
  1.  I COMM="" Q "N"
  1.  ; If no alerts for the patient's community, quit
  1.  I $D(^BQI(90507.6,COMM))<1 Q "N"
  1.  S TEMP="BQITMP" K @TEMP
  1.  D FND^BQICASPL
  1.  I $D(@TEMP)>0 K @TEMP Q "Y"
  1.  Q "N"
  1.  ;
  1. POP(DFN) ;EP - Get patient population
  1.  NEW BQZ,GP,VALUE,PPP,RV,QFL,PVAL
  1.  S GP=0
  1.  F  S GP=$O(^BQIPAT(DFN,30,GP)) Q:'GP  D
  1.  . S VALUE=$P(^BQIPAT(DFN,30,GP,0),"^",2)
  1.  . I VALUE="" Q
  1.  . S PPP=$P(VALUE,"|||",1)
  1.  . I PPP="" Q
  1.  . S BQZ(PPP)=""
  1.  ;
  1.  I $D(BQZ)<1 Q ""
  1.  S RV="",QFL=0,PVAL=""
  1.  F  S RV=$O(BQZ(RV),-1) Q:RV=""  D  Q:QFL
  1.  . I $F(RV,"AC")>0 S QFL=1,PVAL="AC" Q
  1.  . I $F(RV,"UP")>0 S QFL=1,PVAL="UP" Q
  1.  Q PVAL
  1.  ;
  1. PFLNG(DFN) ;EP - Get preferred language
  1.  NEW MRDT,MRIEN,IENS,DA,PVAL
  1.  S MRDT=$O(^AUPNPAT(DFN,86,"B",""),-1)
  1.  I MRDT="" Q ""
  1.  S MRIEN=$O(^AUPNPAT(DFN,86,"B",MRDT,""),-1),PVAL=""
  1.  S DA(1)=DFN,DA=MRIEN,IENS=$$IENS^DILF(.DA)
  1.  I $G(VFIEN)'="" S PVAL=$$GET1^DIQ(9000001.86,IENS,.04,"I")_$C(28)_$$GET1^DIQ(9000001.86,IENS,.04,"E")
  1.  I $G(VFIEN)="" S PVAL=$$GET1^DIQ(9000001.86,IENS,.04,"E")
  1.  Q PVAL
  1.  ;
  1. COUN(DFN) ;EP - Get the county of the patient's current community
  1.  NEW COMM
  1.  S COMM=$$GET1^DIQ(9000001,DFN_",",1117,"I") I COMM="" Q ""
  1.  Q $$GET1^DIQ(9999999.05,COMM_",",.02,"E")
  1.  ;
  1. LVDPCP(DFN) ;EP - Last visit with the DPCP
  1.  NEW DPN,IEN,VSDT,VISIT,QFL
  1.  S DPN=$P($$DPCP(DFN),U,1) I DPN="" Q ""
  1.  S IEN="",VSDT="",QFL=0
  1.  F  S IEN=$O(^AUPNVPRV("AC",DFN,IEN),-1) Q:IEN=""  D  Q:QFL
  1.  . I $P($G(^AUPNVPRV(IEN,0)),U,1)'=DPN Q
  1.  . S VISIT=$P(^AUPNVPRV(IEN,0),U,3)
  1.  . I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1.  . I $G(^AUPNVSIT(VISIT,0))="" Q
  1.  . Q:"DXCTI"[$P(^AUPNVSIT(VISIT,0),U,7)
  1.  . S VSDT=$P(^AUPNVSIT(VISIT,0),U,1)\1,QFL=1
  1.  Q $$FMTE^BQIUL1(VSDT)
  1.  ;
  1. COD(DFN) ;EP - Cause of Death
  1.  NEW DN
  1.  S DN=$P($G(^AUPNPAT(DFN,11)),U,14)
  1.  I DN="" Q ""
  1.  I $$VERSION^XPDUTL("AICD")>3.51 Q $$VST^ICDCODE(DN,"",80)_" ["_$$CODEC^ICDCODE(DN,80)_"]"
  1.  Q $P(^ICD9(DN,0),U,3)_" ["_$P(^ICD9(DN,0),U,1)_"]"