BQIPTDG ;PRXM/HC/BWF -Get Patient demographic information ; 24 Oct 2005 6:21 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
GET(DATA,DFN) ; EP -- BQI GET PATIENT DEMOGRAPHICS
;
; Input
; DFN - Patients DFN or internal entry number
;
NEW UID,STR,X,GDDATA,FLDS,IEN,BQI,RETURN,PTCSZ,PTTRIBE,CMGR,DPCP,PTBEN,PTSSN
NEW PTNAME,PTSEX,PTDOB,PTAGE,PTADD1,PTCITY,PTSTATE,PTZIP,NAFLG,WKPHONE,EMAIL
NEW PTADR,PTCOMM,HRN,ALRTFLG,HMPHONE,ALTPHONE,GPMET,PTDOD,REMMETH,PFLANG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),BQI=0
S DATA=$NA(^TMP("BQIPTDG",UID))
K @DATA
;
S BQI=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTDG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
D HDR
;
S IEN=DFN_","
S FLDS=".01;4101;1107.2;1102.2;1108;1602.2;1603.2;1604.2;1605.2;1117;1606.2;1607.2;1801;1111;4002;1802"
D GETS^DIQ(9000001,IEN,FLDS,"E","GDDATA")
S PTNAME=$G(GDDATA(9000001,IEN,.01,"E"))
S PTSEX=$$GET1^DIQ(2,IEN,.02,"I")
S PTDOB=$$FMTE^BQIUL1($$GET1^DIQ(2,IEN,.03,"I"))
S PTDOD=$$FMTE^BQIUL1($$GET1^DIQ(2,IEN,.351,"I"))
S PTAGE=$$AGE^BQIAGE(DFN,,1)
S PTADD1=$G(GDDATA(9000001,IEN,1602.2,"E"))
S PTCITY=$G(GDDATA(9000001,IEN,1603.2,"E"))
S PTSTATE=$G(GDDATA(9000001,IEN,1604.2,"E"))
S PTZIP=$G(GDDATA(9000001,IEN,1605.2,"E"))
S PTADR=PTADD1
S PTCSZ=PTCITY_","_PTSTATE_" "_PTZIP
S PTSSN=$G(GDDATA(9000001,IEN,1107.2,"E"))
I PTSSN'="" S PTSSN="XXX-XX-"_$E(PTSSN,6,9)
S PTCOMM=$G(GDDATA(9000001,IEN,1117,"E"))
S PTTRIBE=$G(GDDATA(9000001,IEN,1108,"E"))
S PTBEN=$G(GDDATA(9000001,IEN,1111,"E"))
S EMAIL=$G(GDDATA(9000001,IEN,1802,"E"))
S REMMETH=$G(GDDATA(9000001,IEN,4002,"E"))
;
;S HRN=$$HRN^BQIULPT(DFN)
S HRN=$$HRNL^BQIULPT(DFN)
S ALRTFLG=""
S HMPHONE=$G(GDDATA(9000001,IEN,1606.2,"E"))
S WKPHONE=$G(GDDATA(9000001,IEN,1607.2,"E"))
S ALTPHONE=$G(GDDATA(9000001,IEN,1801,"E"))
S GPMET=$$GMET^BQIULPT(DFN)
S DPCP=$P($$DPCP^BQIULPT(DFN),U,2)
S CMGR=$P($$CM^BQIULPT(DFN),U,2)
S PFLANG=$$PFLNG^BQIULPT(DFN)
;
S RETURN=ALRTFLG_U_PTNAME_U_HRN_U_PTSSN_U_PTDOB_U_PTSEX_U_PTAGE_U_PTADR_U_PTCSZ_U_PTCOMM_U_HMPHONE_U_WKPHONE_U_ALTPHONE_U_PTTRIBE_U_DPCP_U_CMGR_U_$$SENS^BQIULPT(DFN)_U
S RETURN=RETURN_PTDOD_U_PTBEN_U_EMAIL_U_REMMETH_U_PFLANG
S BQI=BQI+1,@DATA@(BQI)=RETURN_$C(30)
S BQI=BQI+1,@DATA@(BQI)=$C(31)
K BGPHOME,BQIH,BQIINDF,BQIINDG,BQIMEASF,BQIMEASG,BQIROU,BQIY,BQIYR
Q
;
HDR ;
S @DATA@(BQI)="T00001FLAG_INDICATOR^T00030PATIENT_NAME^T00030HRN^T00011SSN^D00030DOB^T00001SEX^T00010AGE^T00050ADDRESS^T00070CITY_STATE_ZIP^"
S @DATA@(BQI)=@DATA@(BQI)_"T00030COMMUNITY^T00020HOME_PHONE^T00020WORK_PHONE^T00060ALT_PHONE^T00040TRIBE^T00035DPCP^T00035CASE_MGR^"
S @DATA@(BQI)=@DATA@(BQI)_"T00001SENSITIVE_INDICATOR^D00030DOD^T00030BENEFICIARY^T00065EMAIL^T00010REMMETH^T00060PFLANG"_$C(30)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(BQI),$D(DATA) S BQI=BQI+1,@DATA@(BQI)=$C(31)
Q
BQIPTDG ;PRXM/HC/BWF -Get Patient demographic information ; 24 Oct 2005 6:21 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
GET(DATA,DFN) ; EP -- BQI GET PATIENT DEMOGRAPHICS
+1 ;
+2 ; Input
+3 ; DFN - Patients DFN or internal entry number
+4 ;
+5 NEW UID,STR,X,GDDATA,FLDS,IEN,BQI,RETURN,PTCSZ,PTTRIBE,CMGR,DPCP,PTBEN,PTSSN
+6 NEW PTNAME,PTSEX,PTDOB,PTAGE,PTADD1,PTCITY,PTSTATE,PTZIP,NAFLG,WKPHONE,EMAIL
+7 NEW PTADR,PTCOMM,HRN,ALRTFLG,HMPHONE,ALTPHONE,GPMET,PTDOD,REMMETH,PFLANG
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
SET BQI=0
+9 SET DATA=$NAME(^TMP("BQIPTDG",UID))
+10 KILL @DATA
+11 ;
+12 SET BQI=0
+13 ;
+14 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTDG D UNWIND^%ZTER"
+15 ;
+16 DO HDR
+17 ;
+18 SET IEN=DFN_","
+19 SET FLDS=".01;4101;1107.2;1102.2;1108;1602.2;1603.2;1604.2;1605.2;1117;1606.2;1607.2;1801;1111;4002;1802"
+20 DO GETS^DIQ(9000001,IEN,FLDS,"E","GDDATA")
+21 SET PTNAME=$GET(GDDATA(9000001,IEN,.01,"E"))
+22 SET PTSEX=$$GET1^DIQ(2,IEN,.02,"I")
+23 SET PTDOB=$$FMTE^BQIUL1($$GET1^DIQ(2,IEN,.03,"I"))
+24 SET PTDOD=$$FMTE^BQIUL1($$GET1^DIQ(2,IEN,.351,"I"))
+25 SET PTAGE=$$AGE^BQIAGE(DFN,,1)
+26 SET PTADD1=$GET(GDDATA(9000001,IEN,1602.2,"E"))
+27 SET PTCITY=$GET(GDDATA(9000001,IEN,1603.2,"E"))
+28 SET PTSTATE=$GET(GDDATA(9000001,IEN,1604.2,"E"))
+29 SET PTZIP=$GET(GDDATA(9000001,IEN,1605.2,"E"))
+30 SET PTADR=PTADD1
+31 SET PTCSZ=PTCITY_","_PTSTATE_" "_PTZIP
+32 SET PTSSN=$GET(GDDATA(9000001,IEN,1107.2,"E"))
+33 IF PTSSN'=""
SET PTSSN="XXX-XX-"_$EXTRACT(PTSSN,6,9)
+34 SET PTCOMM=$GET(GDDATA(9000001,IEN,1117,"E"))
+35 SET PTTRIBE=$GET(GDDATA(9000001,IEN,1108,"E"))
+36 SET PTBEN=$GET(GDDATA(9000001,IEN,1111,"E"))
+37 SET EMAIL=$GET(GDDATA(9000001,IEN,1802,"E"))
+38 SET REMMETH=$GET(GDDATA(9000001,IEN,4002,"E"))
+39 ;
+40 ;S HRN=$$HRN^BQIULPT(DFN)
+41 SET HRN=$$HRNL^BQIULPT(DFN)
+42 SET ALRTFLG=""
+43 SET HMPHONE=$GET(GDDATA(9000001,IEN,1606.2,"E"))
+44 SET WKPHONE=$GET(GDDATA(9000001,IEN,1607.2,"E"))
+45 SET ALTPHONE=$GET(GDDATA(9000001,IEN,1801,"E"))
+46 SET GPMET=$$GMET^BQIULPT(DFN)
+47 SET DPCP=$PIECE($$DPCP^BQIULPT(DFN),U,2)
+48 SET CMGR=$PIECE($$CM^BQIULPT(DFN),U,2)
+49 SET PFLANG=$$PFLNG^BQIULPT(DFN)
+50 ;
+51 SET RETURN=ALRTFLG_U_PTNAME_U_HRN_U_PTSSN_U_PTDOB_U_PTSEX_U_PTAGE_U_PTADR_U_PTCSZ_U_PTCOMM_U_HMPHONE_U_WKPHONE_U_ALTPHONE_U_PTTRIBE_U_DPCP_U_CMGR_U_$$SENS^BQIULPT(DFN)_U
+52 SET RETURN=RETURN_PTDOD_U_PTBEN_U_EMAIL_U_REMMETH_U_PFLANG
+53 SET BQI=BQI+1
SET @DATA@(BQI)=RETURN_$CHAR(30)
+54 SET BQI=BQI+1
SET @DATA@(BQI)=$CHAR(31)
+55 KILL BGPHOME,BQIH,BQIINDF,BQIINDG,BQIMEASF,BQIMEASG,BQIROU,BQIY,BQIYR
+56 QUIT
+57 ;
HDR ;
+1 SET @DATA@(BQI)="T00001FLAG_INDICATOR^T00030PATIENT_NAME^T00030HRN^T00011SSN^D00030DOB^T00001SEX^T00010AGE^T00050ADDRESS^T00070CITY_STATE_ZIP^"
+2 SET @DATA@(BQI)=@DATA@(BQI)_"T00030COMMUNITY^T00020HOME_PHONE^T00020WORK_PHONE^T00060ALT_PHONE^T00040TRIBE^T00035DPCP^T00035CASE_MGR^"
+3 SET @DATA@(BQI)=@DATA@(BQI)_"T00001SENSITIVE_INDICATOR^D00030DOD^T00030BENEFICIARY^T00065EMAIL^T00010REMMETH^T00060PFLANG"_$CHAR(30)
+4 QUIT
+5 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(BQI)
IF $DATA(DATA)
SET BQI=BQI+1
SET @DATA@(BQI)=$CHAR(31)
+6 QUIT
