BQIPTFHD ;VNGT/HS/ALA-Family History Detail ; 12 Sep 2008 12:30 PM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
Q
;
EN(DATA,DFN) ; EP -- BQI PAT FAM HISTORY DETAIL
;
;Description - all the family history that a patient has
;
;Input Parameters
; DFN - Patient internal entry number
;Parameters
;
NEW UID,II,IEN,DIAG,NARR,RELAT,AGE,STAT,DTMNT,PROV,RELN,RELT,STC,STT,PRVR,PRVN,NIEN
NEW ARRAY,CIEN,RIEN,AGC,FHXDTLM,RORD,ORD,PROV,AGDTH,AGEDT,CASDTH,DIEN,FLD,MLTB,MLTBT
NEW MULT,MULTYP,NARRT,PRV,RELD,RELNM,FAM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTFHD",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTFHD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010FHXIEN^I00010FHXRIEN^T00060FHXRLTN^T00030FHXREL^T00060FHXDXN^T00080DXNARR^"
S @DATA@(II)=@DATA@(II)_"T00020FHXAGE^T00020FHXSTAT^D00030FHXDTNT^T00100APCDTNQ^T00050FHXPROV^"
S @DATA@(II)=@DATA@(II)_"T00015FHXAAD^T00060FHXCDTH^T00010FHXMBRTH^T00020FHXMBTY^D00015FHXDTLM"_$C(30)
S CIEN=""
F S CIEN=$O(^AUPNFH("AC",DFN,CIEN)) Q:CIEN="" D
. S DTMNT=$$GET1^DIQ(9000014,CIEN_",",.03,"I")
. S DIEN=$$GET1^DIQ(9000014,CIEN_",",.01,"I") I DIEN="" Q
. I $$VERSION^XPDUTL("BCSV") S DIAG=$$ICD9^BQIUL3(DIEN,DTMNT,2)_"-"_$$ICD9^BQIUL3(DIEN,DTMNT,4) ; csv
. I '$$VERSION^XPDUTL("BCSV") S DIAG=$$GET1^DIQ(80,DIEN_",",.01,"E")_"-"_$$GET1^DIQ(80,DIEN_",",3,"E")
. S DIAG=DIEN_$C(28)_DIAG
. S NARR=$$GET1^DIQ(9000014,CIEN_",",.04,"E")
. S NIEN=$$GET1^DIQ(9000014,CIEN_",",.04,"I")
. I $$PATCH^XPDUTL("BJPC*2.0*10") S NARR=$$PNPROB^AUPNVUTL(NIEN)
. S NARRT="" I NIEN'="" S NARRT=NIEN_$C(28)_NARR
. S FLD=.11,AGC=$$GET1^DIQ(9000014,CIEN_",",FLD,"I")
. I AGC=FLD S AGC=""
. S AGE="" I AGC'="" S AGE=AGC_$C(28)_$$GET1^DIQ(9000014,CIEN_",",.11,"E")
. S FLD=.09,RIEN=$$GET1^DIQ(9000014,CIEN_",",.09,"I")
. I RIEN=FLD S RIEN=""
. I RIEN'="" S FAM(RIEN)=""
. D GFAM
. S PRV=$$GET1^DIQ(9000014,CIEN_",",.08,"I")
. S PROV="" I PRV'="" S PROV=PRV_$C(28)_$$GET1^DIQ(9000014,CIEN_",",.08,"E")
. S ARRAY(RORD,RELNM,CIEN)=CIEN_U_RIEN_U_RELAT_U_RELD_U_DIAG_U_NARR_U_AGE_U_STAT_U_$$FMTE^BQIUL1(DTMNT)_U_NARRT_U_PROV_U_AGEDT_U_CASDTH_U_MULT_U_MULTYP_U_$$FMTE^BQIUL1(FHXDTLM)_$C(30)
. ;
S CIEN=""
F S CIEN=$O(^AUPNFHR("AA",DFN,CIEN)) Q:'CIEN S RIEN="" D
. F S RIEN=$O(^AUPNFHR("AA",DFN,CIEN,RIEN)) Q:RIEN="" D
.. I $D(FAM(RIEN)) Q
.. ; For family without diagnoses search FAMILY HISTORY FAMILY MEMBERS file
.. D GFAM
.. S ARRAY(RORD,RELNM,"R"_RIEN)=U_RIEN_U_RELAT_U_RELD_U_U_U_U_STAT_U_U_U_U_AGEDT_U_CASDTH_U_MULT_U_MULTYP_U_$$FMTE^BQIUL1(FHXDTLM)_$C(30)
S ORD=""
F S ORD=$O(ARRAY(ORD)) Q:ORD="" D
. S RELNM=""
. F S RELNM=$O(ARRAY(ORD,RELNM)) Q:RELNM="" D
.. S IEN=""
.. F S IEN=$O(ARRAY(ORD,RELNM,IEN)) Q:IEN="" D
... S II=II+1,@DATA@(II)=ARRAY(ORD,RELNM,IEN)
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
;
GFAM ; Get family history family members data
S RELN=$$GET1^DIQ(9000014.1,RIEN_",",.01,"I")
S RORD=$$GET1^DIQ(9999999.36,RELN_",",2103,"E") S:RORD="" RORD="~"
S RELT=$$GET1^DIQ(9000014.1,RIEN_",",.01,"E")
S RELNM=RELT S:RELNM="" RELNM="~"
S RELD=$$GET1^DIQ(9000014.1,RIEN_",",.03,"E")
S RELAT="" I RELN'="" S RELAT=RELN_$C(28)_RELT
S STC=$$GET1^DIQ(9000014.1,RIEN_",",.04,"I")
S STAT="" I STC'="" S STAT=STC_$C(28)_$$GET1^DIQ(9000014.1,RIEN_",",.04,"E")
S FHXDTLM=$$GET1^DIQ(9000014.1,RIEN_",",.09,"I")
S MLTB=$$GET1^DIQ(9000014.1,RIEN_",",.07,"I")
S MULT="" I MLTB'="" S MULT=MLTB_$C(28)_$$GET1^DIQ(9000014.1,RIEN_",",.07,"E")
S AGDTH=$$GET1^DIQ(9000014.1,RIEN_",",.05,"I")
S AGEDT="" I AGDTH'="" S AGEDT=AGDTH_$C(28)_$$GET1^DIQ(9000014.1,RIEN_",",.05,"E")
S CASDTH=$$GET1^DIQ(9000014.1,RIEN_",",.06,"E")
S MLTBT=$$GET1^DIQ(9000014.1,RIEN_",",.08,"I")
S MULTYP="" I MLTBT'="" S MULTYP=MLTBT_$C(28)_$$GET1^DIQ(9000014.1,RIEN_",",.08,"E")
Q
BQIPTFHD ;VNGT/HS/ALA-Family History Detail ; 12 Sep 2008 12:30 PM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 ;
+3 QUIT
+4 ;
EN(DATA,DFN) ; EP -- BQI PAT FAM HISTORY DETAIL
+1 ;
+2 ;Description - all the family history that a patient has
+3 ;
+4 ;Input Parameters
+5 ; DFN - Patient internal entry number
+6 ;Parameters
+7 ;
+8 NEW UID,II,IEN,DIAG,NARR,RELAT,AGE,STAT,DTMNT,PROV,RELN,RELT,STC,STT,PRVR,PRVN,NIEN
+9 NEW ARRAY,CIEN,RIEN,AGC,FHXDTLM,RORD,ORD,PROV,AGDTH,AGEDT,CASDTH,DIEN,FLD,MLTB,MLTBT
+10 NEW MULT,MULTYP,NARRT,PRV,RELD,RELNM,FAM
+11 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+12 SET DATA=$NAME(^TMP("BQIPTFHD",UID))
+13 KILL @DATA
+14 ;
+15 SET II=0
+16 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTFHD D UNWIND^%ZTER"
+17 ;
+18 SET @DATA@(II)="I00010FHXIEN^I00010FHXRIEN^T00060FHXRLTN^T00030FHXREL^T00060FHXDXN^T00080DXNARR^"
+19 SET @DATA@(II)=@DATA@(II)_"T00020FHXAGE^T00020FHXSTAT^D00030FHXDTNT^T00100APCDTNQ^T00050FHXPROV^"
+20 SET @DATA@(II)=@DATA@(II)_"T00015FHXAAD^T00060FHXCDTH^T00010FHXMBRTH^T00020FHXMBTY^D00015FHXDTLM"_$CHAR(30)
+21 SET CIEN=""
+22 FOR
SET CIEN=$ORDER(^AUPNFH("AC",DFN,CIEN))
IF CIEN=""
QUIT
Begin DoDot:1
+23 SET DTMNT=$$GET1^DIQ(9000014,CIEN_",",.03,"I")
+24 SET DIEN=$$GET1^DIQ(9000014,CIEN_",",.01,"I")
IF DIEN=""
QUIT
+25 ; csv
IF $$VERSION^XPDUTL("BCSV")
SET DIAG=$$ICD9^BQIUL3(DIEN,DTMNT,2)_"-"_$$ICD9^BQIUL3(DIEN,DTMNT,4)
+26 IF '$$VERSION^XPDUTL("BCSV")
SET DIAG=$$GET1^DIQ(80,DIEN_",",.01,"E")_"-"_$$GET1^DIQ(80,DIEN_",",3,"E")
+27 SET DIAG=DIEN_$CHAR(28)_DIAG
+28 SET NARR=$$GET1^DIQ(9000014,CIEN_",",.04,"E")
+29 SET NIEN=$$GET1^DIQ(9000014,CIEN_",",.04,"I")
+30 IF $$PATCH^XPDUTL("BJPC*2.0*10")
SET NARR=$$PNPROB^AUPNVUTL(NIEN)
+31 SET NARRT=""
IF NIEN'=""
SET NARRT=NIEN_$CHAR(28)_NARR
+32 SET FLD=.11
SET AGC=$$GET1^DIQ(9000014,CIEN_",",FLD,"I")
+33 IF AGC=FLD
SET AGC=""
+34 SET AGE=""
IF AGC'=""
SET AGE=AGC_$CHAR(28)_$$GET1^DIQ(9000014,CIEN_",",.11,"E")
+35 SET FLD=.09
SET RIEN=$$GET1^DIQ(9000014,CIEN_",",.09,"I")
+36 IF RIEN=FLD
SET RIEN=""
+37 IF RIEN'=""
SET FAM(RIEN)=""
+38 DO GFAM
+39 SET PRV=$$GET1^DIQ(9000014,CIEN_",",.08,"I")
+40 SET PROV=""
IF PRV'=""
SET PROV=PRV_$CHAR(28)_$$GET1^DIQ(9000014,CIEN_",",.08,"E")
+41 SET ARRAY(RORD,RELNM,CIEN)=CIEN_U_RIEN_U_RELAT_U_RELD_U_DIAG_U_NARR_U_AGE_U_STAT_U_$$FMTE^BQIUL1(DTMNT)_U_NARRT_U_PROV_U_AGEDT_U_CASDTH_U_MULT_U_MULTYP_U_$$FMTE^BQIUL1(FHXDTLM)_$CHAR(30)
+42 ;
End DoDot:1
+43 SET CIEN=""
+44 FOR
SET CIEN=$ORDER(^AUPNFHR("AA",DFN,CIEN))
IF 'CIEN
QUIT
SET RIEN=""
Begin DoDot:1
+45 FOR
SET RIEN=$ORDER(^AUPNFHR("AA",DFN,CIEN,RIEN))
IF RIEN=""
QUIT
Begin DoDot:2
+46 IF $DATA(FAM(RIEN))
QUIT
+47 ; For family without diagnoses search FAMILY HISTORY FAMILY MEMBERS file
+48 DO GFAM
+49 SET ARRAY(RORD,RELNM,"R"_RIEN)=U_RIEN_U_RELAT_U_RELD_U_U_U_U_STAT_U_U_U_U_AGEDT_U_CASDTH_U_MULT_U_MULTYP_U_$$FMTE^BQIUL1(FHXDTLM)_$CHAR(30)
End DoDot:2
End DoDot:1
+50 SET ORD=""
+51 FOR
SET ORD=$ORDER(ARRAY(ORD))
IF ORD=""
QUIT
Begin DoDot:1
+52 SET RELNM=""
+53 FOR
SET RELNM=$ORDER(ARRAY(ORD,RELNM))
IF RELNM=""
QUIT
Begin DoDot:2
+54 SET IEN=""
+55 FOR
SET IEN=$ORDER(ARRAY(ORD,RELNM,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+56 SET II=II+1
SET @DATA@(II)=ARRAY(ORD,RELNM,IEN)
End DoDot:3
End DoDot:2
End DoDot:1
+57 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+58 QUIT
+59 ;
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 ;
GFAM ; Get family history family members data
+1 SET RELN=$$GET1^DIQ(9000014.1,RIEN_",",.01,"I")
+2 SET RORD=$$GET1^DIQ(9999999.36,RELN_",",2103,"E")
IF RORD=""
SET RORD="~"
+3 SET RELT=$$GET1^DIQ(9000014.1,RIEN_",",.01,"E")
+4 SET RELNM=RELT
IF RELNM=""
SET RELNM="~"
+5 SET RELD=$$GET1^DIQ(9000014.1,RIEN_",",.03,"E")
+6 SET RELAT=""
IF RELN'=""
SET RELAT=RELN_$CHAR(28)_RELT
+7 SET STC=$$GET1^DIQ(9000014.1,RIEN_",",.04,"I")
+8 SET STAT=""
IF STC'=""
SET STAT=STC_$CHAR(28)_$$GET1^DIQ(9000014.1,RIEN_",",.04,"E")
+9 SET FHXDTLM=$$GET1^DIQ(9000014.1,RIEN_",",.09,"I")
+10 SET MLTB=$$GET1^DIQ(9000014.1,RIEN_",",.07,"I")
+11 SET MULT=""
IF MLTB'=""
SET MULT=MLTB_$CHAR(28)_$$GET1^DIQ(9000014.1,RIEN_",",.07,"E")
+12 SET AGDTH=$$GET1^DIQ(9000014.1,RIEN_",",.05,"I")
+13 SET AGEDT=""
IF AGDTH'=""
SET AGEDT=AGDTH_$CHAR(28)_$$GET1^DIQ(9000014.1,RIEN_",",.05,"E")
+14 SET CASDTH=$$GET1^DIQ(9000014.1,RIEN_",",.06,"E")
+15 SET MLTBT=$$GET1^DIQ(9000014.1,RIEN_",",.08,"I")
+16 SET MULTYP=""
IF MLTBT'=""
SET MULTYP=MLTBT_$CHAR(28)_$$GET1^DIQ(9000014.1,RIEN_",",.08,"E")
+17 QUIT
