Routine: BQIPTDG

BQIPTDG ;PRXM/HC/BWF -Get Patient demographic information ; 24 Oct 2005  6:21 PM

 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

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

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)

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)

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

BQIPTDG.m