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