BQIPTDDG ;APTIV/HC/ALA-Patient Detail Demographics ; 03 Mar 2008 1:32 PM
;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37
;
Q
;
EN(DATA,DFN) ; EP -- BQI PATIENT DETAIL DEMOG
;
; Input
; DFN - Patients DFN or internal entry number
;
NEW UID,II,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTDDG",UID))
K @DATA
;
S II=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTDDG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00015MARITAL_STATUS^T00030CLASS^T00012ENROLL_NO^T00042TRIBE^T00030TRIBE_QUANTUM^T00030INDIAN_BLOOD^"
;
NEW MSTAT,CLASS,ENROLL,TRIBE,TQUANT,IQUANT,RETURN,POBC,POBS,POB,DLEN,LENGTH
NEW RACE,BN,ETHN,OTRIB,IEN,POBSI,HMLOC
S IEN=DFN_","
S MSTAT=$$GET1^DIQ(2,IEN,.05,"E")
S CLASS=$$GET1^DIQ(9000001,IEN,1111,"E")
S ENROLL=$$GET1^DIQ(9000001,IEN,.07,"E")
S TRIBE=$$GET1^DIQ(9000001,IEN,1108,"E")
S TQUANT=$$GET1^DIQ(9000001,IEN,1109,"E")
S IQUANT=$$GET1^DIQ(9000001,IEN,1110,"E")
S RETURN=MSTAT_U_CLASS_U_ENROLL_U_TRIBE_U_TQUANT_U_IQUANT_U
S POBC=$$GET1^DIQ(2,IEN,.092,"E"),POBS=""
;S POBSI=$$GET1^DIQ(2,IEN,.093,"I") I POBSI'="" S POBS=$$GET1^DIQ(5,IEN,1,"E")
S POBS=$$GET1^DIQ(5,$$GET1^DIQ(2,IEN,.093,"I"),1,"E")
S POB=POBC_" "_POBS,LENGTH=$L(POB),DLEN=$E("00000",$L(LENGTH)+1,5)_LENGTH
S HDR=HDR_"T"_DLEN_"PLACE_OF_BIRTH"_U,RETURN=RETURN_POB_U
;
S BN=0,RACE=""
F S BN=$O(^DPT(DFN,.02,BN)) Q:'BN D
. NEW DA,IENS
. S DA(1)=DFN,DA=BN,IENS=$$IENS^DILF(.DA)
. S RACE=RACE_$$GET1^DIQ(2.02,IENS,.01,"E")_";"
S RACE=$$TKO^BQIUL1(RACE,";"),LENGTH=$L(RACE)
S:LENGTH=""!(LENGTH=0) LENGTH=45
S DLEN=$E("00000",$L(LENGTH)+1,5)_LENGTH
S HDR=HDR_"T"_DLEN_"RACE"_U,RETURN=RETURN_RACE_U
;
S BN=0,ETHN=""
F S BN=$O(^DPT(DFN,.06,BN)) Q:'BN D
. NEW DA,IENS
. S DA(1)=DFN,DA=BN,IENS=$$IENS^DILF(.DA)
. S ETHN=ETHN_$$GET1^DIQ(2.06,IENS,.01,"E")_";"
S ETHN=$$TKO^BQIUL1(ETHN,";"),LENGTH=$L(ETHN)
S:LENGTH=""!(LENGTH=0) LENGTH=30
S DLEN=$E("00000",$L(LENGTH)+1,5)_LENGTH
S HDR=HDR_"T"_DLEN_"ETHNICITY"_U,RETURN=RETURN_ETHN_U
;
S BN=0,OTRIB=""
F S BN=$O(^AUPNPAT(DFN,43,BN)) Q:'BN D
. NEW DA,IENS
. S DA(1)=DFN,DA=BN,IENS=$$IENS^DILF(.DA)
. S OTRIB=OTRIB_$$GET1^DIQ(9000001.43,IENS,.01,"E")_";"
S OTRIB=$$TKO^BQIUL1(OTRIB,";"),LENGTH=$L(OTRIB)
S:LENGTH=""!(LENGTH=0) LENGTH=42
S DLEN=$E("00000",$L(LENGTH)+1,5)_(LENGTH+1)
S HDR=HDR_"T"_DLEN_"OTHER_TRIBES"_U,RETURN=RETURN_OTRIB_U
;
;Location of Home
S HMLOC=$$HMLOC(DFN)
S HDR=HDR_"T01024HMLOC",RETURN=RETURN_HMLOC
;
S @DATA@(II)=HDR_$C(30)
S II=II+1,@DATA@(II)=RETURN_$C(30)
S II=II+1,@DATA@(II)=$C(31)
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(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
HMLOC(DFN) ;EP - Return Patient Location of Home Value (Panel View field HMLOC)
;
N IEN,LIEN,HMLOC,FLDS,GDDATA
S IEN=DFN_","
S FLDS="1201"
D GETS^DIQ(9000001,IEN,FLDS,"E","GDDATA")
;
;Patient Location
S (HMLOC,LIEN)="" F S LIEN=$O(GDDATA(9000001,IEN,1201,LIEN)) Q:'LIEN D
. S HMLOC=$G(HMLOC)_$S($G(HMLOC)]"":" ",1:"")_$G(GDDATA(9000001,IEN,1201,LIEN))
K LIEN
;
Q HMLOC
BQIPTDDG ;APTIV/HC/ALA-Patient Detail Demographics ; 03 Mar 2008 1:32 PM
+1 ;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37
+2 ;
+3 QUIT
+4 ;
EN(DATA,DFN) ; EP -- BQI PATIENT DETAIL DEMOG
+1 ;
+2 ; Input
+3 ; DFN - Patients DFN or internal entry number
+4 ;
+5 NEW UID,II,HDR
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("BQIPTDDG",UID))
+8 KILL @DATA
+9 ;
+10 SET II=0
+11 ;
+12 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTDDG D UNWIND^%ZTER"
+13 ;
+14 SET HDR="T00015MARITAL_STATUS^T00030CLASS^T00012ENROLL_NO^T00042TRIBE^T00030TRIBE_QUANTUM^T00030INDIAN_BLOOD^"
+15 ;
+16 NEW MSTAT,CLASS,ENROLL,TRIBE,TQUANT,IQUANT,RETURN,POBC,POBS,POB,DLEN,LENGTH
+17 NEW RACE,BN,ETHN,OTRIB,IEN,POBSI,HMLOC
+18 SET IEN=DFN_","
+19 SET MSTAT=$$GET1^DIQ(2,IEN,.05,"E")
+20 SET CLASS=$$GET1^DIQ(9000001,IEN,1111,"E")
+21 SET ENROLL=$$GET1^DIQ(9000001,IEN,.07,"E")
+22 SET TRIBE=$$GET1^DIQ(9000001,IEN,1108,"E")
+23 SET TQUANT=$$GET1^DIQ(9000001,IEN,1109,"E")
+24 SET IQUANT=$$GET1^DIQ(9000001,IEN,1110,"E")
+25 SET RETURN=MSTAT_U_CLASS_U_ENROLL_U_TRIBE_U_TQUANT_U_IQUANT_U
+26 SET POBC=$$GET1^DIQ(2,IEN,.092,"E")
SET POBS=""
+27 ;S POBSI=$$GET1^DIQ(2,IEN,.093,"I") I POBSI'="" S POBS=$$GET1^DIQ(5,IEN,1,"E")
+28 SET POBS=$$GET1^DIQ(5,$$GET1^DIQ(2,IEN,.093,"I"),1,"E")
+29 SET POB=POBC_" "_POBS
SET LENGTH=$LENGTH(POB)
SET DLEN=$EXTRACT("00000",$LENGTH(LENGTH)+1,5)_LENGTH
+30 SET HDR=HDR_"T"_DLEN_"PLACE_OF_BIRTH"_U
SET RETURN=RETURN_POB_U
+31 ;
+32 SET BN=0
SET RACE=""
+33 FOR
SET BN=$ORDER(^DPT(DFN,.02,BN))
IF 'BN
QUIT
Begin DoDot:1
+34 NEW DA,IENS
+35 SET DA(1)=DFN
SET DA=BN
SET IENS=$$IENS^DILF(.DA)
+36 SET RACE=RACE_$$GET1^DIQ(2.02,IENS,.01,"E")_";"
End DoDot:1
+37 SET RACE=$$TKO^BQIUL1(RACE,";")
SET LENGTH=$LENGTH(RACE)
+38 IF LENGTH=""!(LENGTH=0)
SET LENGTH=45
+39 SET DLEN=$EXTRACT("00000",$LENGTH(LENGTH)+1,5)_LENGTH
+40 SET HDR=HDR_"T"_DLEN_"RACE"_U
SET RETURN=RETURN_RACE_U
+41 ;
+42 SET BN=0
SET ETHN=""
+43 FOR
SET BN=$ORDER(^DPT(DFN,.06,BN))
IF 'BN
QUIT
Begin DoDot:1
+44 NEW DA,IENS
+45 SET DA(1)=DFN
SET DA=BN
SET IENS=$$IENS^DILF(.DA)
+46 SET ETHN=ETHN_$$GET1^DIQ(2.06,IENS,.01,"E")_";"
End DoDot:1
+47 SET ETHN=$$TKO^BQIUL1(ETHN,";")
SET LENGTH=$LENGTH(ETHN)
+48 IF LENGTH=""!(LENGTH=0)
SET LENGTH=30
+49 SET DLEN=$EXTRACT("00000",$LENGTH(LENGTH)+1,5)_LENGTH
+50 SET HDR=HDR_"T"_DLEN_"ETHNICITY"_U
SET RETURN=RETURN_ETHN_U
+51 ;
+52 SET BN=0
SET OTRIB=""
+53 FOR
SET BN=$ORDER(^AUPNPAT(DFN,43,BN))
IF 'BN
QUIT
Begin DoDot:1
+54 NEW DA,IENS
+55 SET DA(1)=DFN
SET DA=BN
SET IENS=$$IENS^DILF(.DA)
+56 SET OTRIB=OTRIB_$$GET1^DIQ(9000001.43,IENS,.01,"E")_";"
End DoDot:1
+57 SET OTRIB=$$TKO^BQIUL1(OTRIB,";")
SET LENGTH=$LENGTH(OTRIB)
+58 IF LENGTH=""!(LENGTH=0)
SET LENGTH=42
+59 SET DLEN=$EXTRACT("00000",$LENGTH(LENGTH)+1,5)_(LENGTH+1)
+60 SET HDR=HDR_"T"_DLEN_"OTHER_TRIBES"_U
SET RETURN=RETURN_OTRIB_U
+61 ;
+62 ;Location of Home
+63 SET HMLOC=$$HMLOC(DFN)
+64 SET HDR=HDR_"T01024HMLOC"
SET RETURN=RETURN_HMLOC
+65 ;
+66 SET @DATA@(II)=HDR_$CHAR(30)
+67 SET II=II+1
SET @DATA@(II)=RETURN_$CHAR(30)
+68 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+69 QUIT
+70 ;
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(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
HMLOC(DFN) ;EP - Return Patient Location of Home Value (Panel View field HMLOC)
+1 ;
+2 NEW IEN,LIEN,HMLOC,FLDS,GDDATA
+3 SET IEN=DFN_","
+4 SET FLDS="1201"
+5 DO GETS^DIQ(9000001,IEN,FLDS,"E","GDDATA")
+6 ;
+7 ;Patient Location
+8 SET (HMLOC,LIEN)=""
FOR
SET LIEN=$ORDER(GDDATA(9000001,IEN,1201,LIEN))
IF 'LIEN
QUIT
Begin DoDot:1
+9 SET HMLOC=$GET(HMLOC)_$SELECT($GET(HMLOC)]"":" ",1:"")_$GET(GDDATA(9000001,IEN,1201,LIEN))
End DoDot:1
+10 KILL LIEN
+11 ;
+12 QUIT HMLOC
