BQIPTFHR ;VNGT/HS/BEE-Family History Display ; 12 Sep 2008 12:30 PM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
Q
;
EN(DATA,DFN) ; EP -- BQI GET FAM HIST DISPLAY
;
;Description - all the family history that a patient has
;
;Input Parameters
; DFN - Patient internal entry number
;
NEW ARRAY,UID,II,FAM,FHCIEN,FHRIEN,FHRREL,FHRDES,FHRSTS,FHRDTU,FHRMB,FHRMBT,FHRMBD,FHRAAD,FHRCOD,RORD,RELNM
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTFHR",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTFHR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
I $$VERSION^XPDUTL("BJPC")<2.0 S BMXSEC="RPC Call Failed: IHS PCC SUITE 2.0 must be installed in RPMS" Q
;
;Verify Patient DFN is populated
I $G(DFN)="" S BMXSEC="Patient DFN is required" Q
;
S @DATA@(II)="I00010FHCIEN^I00010FHRIEN^T00060FHRREL^T00030FHRDES^T00060FHCDX^T00080FHCNAR^"
S @DATA@(II)=@DATA@(II)_"T00020FHCAAO^T00020FHRSTS^D00030FHCDTN^T00100APCDTNQ^T00050FHCPRV^"
S @DATA@(II)=@DATA@(II)_"T00015FHRAAD^T00060FHRCOD^T00010FHRMB^T00020FHRMBT^T00030FHRMBD^D00015FHCDTM^D00030FHRDTU"_$C(30)
;
S FHCIEN="" F S FHCIEN=$O(^AUPNFH("AC",DFN,FHCIEN)) Q:FHCIEN="" D
. ;
. N APCDTNQ,BQICND,DIEN,FHCAAO,FHCDX,FHCDTM,FHCDTN,FHCNAR,FHCPRV,REIN
. D GETS^DIQ(9000014,FHCIEN,"**","IE","BQICND")
. ;
. ;Date Noted
. S FHCDTN=$G(BQICND(9000014,FHCIEN_",",".03","I"))
. ;
. ;DX Code (Condition)
. S DIEN=$$GET1^DIQ(9000014,FHCIEN_",",.01,"I") ;Using $$GET1^DIQ as GETS^DIQ sometimes omits .01 entry
. I DIEN="" Q
. I $$VERSION^XPDUTL("BCSV") S FHCDX=$$ICD9^BQIUL3(DIEN,FHCDTN,2)_"-"_$$ICD9^BQIUL3(DIEN,FHCDTN,4) ; csv
. I '$$VERSION^XPDUTL("BCSV") S FHCDX=$$GET1^DIQ(80,DIEN_",",.01,"E")_"-"_$$GET1^DIQ(80,DIEN_",",3,"E")
. S FHCDX=DIEN_$C(28)_FHCDX S:$P(FHCDX,$C(28))="-" FHCDX=""
. ;
. ;Diagnosis Narrative (Provider Narrative)
. ;S FHCNAR=$G(BQICND(9000014,FHCIEN_",",".04","E"))
. ;
. ;Narrative
. NEW NIEN
. S APCDTNQ=""
. S NIEN=$G(BQICND(9000014,FHCIEN_",",".04","I"))
. I $$PATCH^XPDUTL("BJPC*2.0*10") S FHCNAR=$$PNPROB^AUPNVUTL(NIEN)
. E S FHCNAR=$G(BQICND(9000014,FHCIEN_",",".04","E"))
. S APCDTNQ=NIEN_$C(28)_FHCNAR
. S:$P(APCDTNQ,$C(28))="" APCDTNQ=""
. ;
. ;Age at Onset
. S FHCAAO=$G(BQICND(9000014,FHCIEN_",",".11","I"))_$C(28)_$G(BQICND(9000014,FHCIEN_",",".11","E"))
. S:$P(FHCAAO,$C(28))="" FHCAAO=""
. ;
. ;Provider
. S FHCPRV=$G(BQICND(9000014,FHCIEN_",",".08","I"))_$C(28)_$G(BQICND(9000014,FHCIEN_",",".08","E"))
. S:$P(FHCPRV,$C(28))="" FHCPRV=""
. ;
. ;Relation IEN
. S FHRIEN=$G(BQICND(9000014,FHCIEN_",",".09","I"))
. I FHRIEN'="" S FAM(FHRIEN)=""
. ;
. ;Pull Relation Information - FHRREL, FHRDES, FHRSTS, FHRDTU, FHRMB, FHRMBT, FHRMBD, FHRAAD, FHRCOD
. D GFAM(FHRIEN)
. ;
. ;Date Last Modified
. S FHCDTM=$G(BQICND(9000014,FHCIEN_",",".12","I"))
. ;
. ;Set up sorting array
. S ARRAY(RORD,RELNM,FHCIEN)=FHCIEN_U_FHRIEN_U_FHRREL_U_FHRDES_U_FHCDX_U_FHCNAR_U_FHCAAO_U_FHRSTS_U_$$FMTE^BQIUL1(FHCDTN)_U_APCDTNQ_U_FHCPRV_U_FHRAAD_U_FHRCOD_U_FHRMB_U_FHRMBT_U_FHRMBD_U_$$FMTE^BQIUL1(FHCDTM)_U_$$FMTE^BQIUL1(FHRDTU)_$C(30)
;
S RIEN="" F S RIEN=$O(^AUPNFHR("AA",DFN,RIEN)) Q:'RIEN D
. S FHRIEN="" F S FHRIEN=$O(^AUPNFHR("AA",DFN,RIEN,FHRIEN)) Q:FHRIEN="" D
.. I $D(FAM(FHRIEN)) Q
.. ;
.. ; For family without diagnoses search FAMILY HISTORY FAMILY MEMBERS file
.. D GFAM(FHRIEN)
.. S ARRAY(RORD,RELNM,"R"_FHRIEN)=U_FHRIEN_U_FHRREL_U_FHRDES_U_U_U_U_FHRSTS_U_U_U_U_FHRAAD_U_FHRCOD_U_FHRMB_U_FHRMBT_U_FHRMBD_U_U_$$FMTE^BQIUL1(FHRDTU)_$C(30)
;
;Create record entries
S RORD="" F S RORD=$O(ARRAY(RORD)) Q:RORD="" D
. S RELNM="" F S RELNM=$O(ARRAY(RORD,RELNM)) Q:RELNM="" D
.. S FHCIEN="" F S FHCIEN=$O(ARRAY(RORD,RELNM,FHCIEN)) Q:FHCIEN="" D
... S II=II+1,@DATA@(II)=ARRAY(RORD,RELNM,FHCIEN)
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(FHRIEN) ; Get FAMILY HISTORY FAMILY MEMBERS Data
;
N BQIREL,RIEN,RELT
S (FHRREL,FHRDES,FHRSTS,FHRDTU,FHRMB,FHRMBT,FHRMBD,FHRAAD,FHRCOD)=""
;
I FHRIEN="" S (RORD,RELNM)="~" Q
;
D GETS^DIQ(9000014.1,FHRIEN,"**","IE","BQIREL")
;
;Relative (Relation) and Sort variables
S REIN=$G(BQIREL(9000014.1,FHRIEN_",",".01","I"))
S RELT=$G(BQIREL(9000014.1,FHRIEN_",",".01","E"))
S RELNM=RELT S:RELNM="" RELNM="~"
S FHRREL="" I REIN'="" S FHRREL=REIN_$C(28)_RELT
S RORD=$$GET1^DIQ(9999999.36,REIN_",",2103,"E") S:RORD="" RORD="~"
;
;Relation Modifier (Description)
S FHRDES=$G(BQIREL(9000014.1,FHRIEN_",",".03","E"))
;
;Status
S FHRSTS=$G(BQIREL(9000014.1,FHRIEN_",",".04","I"))_$C(28)_$G(BQIREL(9000014.1,FHRIEN_",",".04","E"))
S:$P(FHRSTS,$C(28))="" FHRSTS=""
;
;Date Updated
S FHRDTU=$G(BQIREL(9000014.1,FHRIEN_",",".09","I"))
;
;Multiple Birth Status
S FHRMB=$G(BQIREL(9000014.1,FHRIEN_",",".07","I"))_$C(28)_$G(BQIREL(9000014.1,FHRIEN_",",".07","E"))
S FHRMBD=FHRMB
S:$P(FHRMB,$C(28))="" FHRMB=""
;
;Multiple Birth Type
S FHRMBT=$G(BQIREL(9000014.1,FHRIEN_",",".08","I"))_$C(28)_$G(BQIREL(9000014.1,FHRIEN_",",".08","E"))
S FHRMBD=FHRMBD_$C(28)_FHRMBT
S:$P(FHRMBT,$C(28))="" FHRMBT=""
;
;Multiple Birth Display
I $TR(FHRMBD,$C(28))="" S FHRMBD=""
;
;Age at Death
S FHRAAD=$G(BQIREL(9000014.1,FHRIEN_",",".05","I"))_$C(28)_$G(BQIREL(9000014.1,FHRIEN_",",".05","E"))
S:$P(FHRAAD,$C(28))="" FHRAAD=""
;
;Cause of Death
S FHRCOD=$G(BQIREL(9000014.1,FHRIEN_",",".06","E"))
;
Q
BQIPTFHR ;VNGT/HS/BEE-Family History Display ; 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 GET FAM HIST DISPLAY
+1 ;
+2 ;Description - all the family history that a patient has
+3 ;
+4 ;Input Parameters
+5 ; DFN - Patient internal entry number
+6 ;
+7 NEW ARRAY,UID,II,FAM,FHCIEN,FHRIEN,FHRREL,FHRDES,FHRSTS,FHRDTU,FHRMB,FHRMBT,FHRMBD,FHRAAD,FHRCOD,RORD,RELNM
+8 ;
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BQIPTFHR",UID))
+11 KILL @DATA
+12 ;
+13 SET II=0
+14 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTFHR D UNWIND^%ZTER"
+15 ;
+16 IF $$VERSION^XPDUTL("BJPC")<2.0
SET BMXSEC="RPC Call Failed: IHS PCC SUITE 2.0 must be installed in RPMS"
QUIT
+17 ;
+18 ;Verify Patient DFN is populated
+19 IF $GET(DFN)=""
SET BMXSEC="Patient DFN is required"
QUIT
+20 ;
+21 SET @DATA@(II)="I00010FHCIEN^I00010FHRIEN^T00060FHRREL^T00030FHRDES^T00060FHCDX^T00080FHCNAR^"
+22 SET @DATA@(II)=@DATA@(II)_"T00020FHCAAO^T00020FHRSTS^D00030FHCDTN^T00100APCDTNQ^T00050FHCPRV^"
+23 SET @DATA@(II)=@DATA@(II)_"T00015FHRAAD^T00060FHRCOD^T00010FHRMB^T00020FHRMBT^T00030FHRMBD^D00015FHCDTM^D00030FHRDTU"_$CHAR(30)
+24 ;
+25 SET FHCIEN=""
FOR
SET FHCIEN=$ORDER(^AUPNFH("AC",DFN,FHCIEN))
IF FHCIEN=""
QUIT
Begin DoDot:1
+26 ;
+27 NEW APCDTNQ,BQICND,DIEN,FHCAAO,FHCDX,FHCDTM,FHCDTN,FHCNAR,FHCPRV,REIN
+28 DO GETS^DIQ(9000014,FHCIEN,"**","IE","BQICND")
+29 ;
+30 ;Date Noted
+31 SET FHCDTN=$GET(BQICND(9000014,FHCIEN_",",".03","I"))
+32 ;
+33 ;DX Code (Condition)
+34 ;Using $$GET1^DIQ as GETS^DIQ sometimes omits .01 entry
SET DIEN=$$GET1^DIQ(9000014,FHCIEN_",",.01,"I")
+35 IF DIEN=""
QUIT
+36 ; csv
IF $$VERSION^XPDUTL("BCSV")
SET FHCDX=$$ICD9^BQIUL3(DIEN,FHCDTN,2)_"-"_$$ICD9^BQIUL3(DIEN,FHCDTN,4)
+37 IF '$$VERSION^XPDUTL("BCSV")
SET FHCDX=$$GET1^DIQ(80,DIEN_",",.01,"E")_"-"_$$GET1^DIQ(80,DIEN_",",3,"E")
+38 SET FHCDX=DIEN_$CHAR(28)_FHCDX
IF $PIECE(FHCDX,$CHAR(28))="-"
SET FHCDX=""
+39 ;
+40 ;Diagnosis Narrative (Provider Narrative)
+41 ;S FHCNAR=$G(BQICND(9000014,FHCIEN_",",".04","E"))
+42 ;
+43 ;Narrative
+44 NEW NIEN
+45 SET APCDTNQ=""
+46 SET NIEN=$GET(BQICND(9000014,FHCIEN_",",".04","I"))
+47 IF $$PATCH^XPDUTL("BJPC*2.0*10")
SET FHCNAR=$$PNPROB^AUPNVUTL(NIEN)
+48 IF '$TEST
SET FHCNAR=$GET(BQICND(9000014,FHCIEN_",",".04","E"))
+49 SET APCDTNQ=NIEN_$CHAR(28)_FHCNAR
+50 IF $PIECE(APCDTNQ,$CHAR(28))=""
SET APCDTNQ=""
+51 ;
+52 ;Age at Onset
+53 SET FHCAAO=$GET(BQICND(9000014,FHCIEN_",",".11","I"))_$CHAR(28)_$GET(BQICND(9000014,FHCIEN_",",".11","E"))
+54 IF $PIECE(FHCAAO,$CHAR(28))=""
SET FHCAAO=""
+55 ;
+56 ;Provider
+57 SET FHCPRV=$GET(BQICND(9000014,FHCIEN_",",".08","I"))_$CHAR(28)_$GET(BQICND(9000014,FHCIEN_",",".08","E"))
+58 IF $PIECE(FHCPRV,$CHAR(28))=""
SET FHCPRV=""
+59 ;
+60 ;Relation IEN
+61 SET FHRIEN=$GET(BQICND(9000014,FHCIEN_",",".09","I"))
+62 IF FHRIEN'=""
SET FAM(FHRIEN)=""
+63 ;
+64 ;Pull Relation Information - FHRREL, FHRDES, FHRSTS, FHRDTU, FHRMB, FHRMBT, FHRMBD, FHRAAD, FHRCOD
+65 DO GFAM(FHRIEN)
+66 ;
+67 ;Date Last Modified
+68 SET FHCDTM=$GET(BQICND(9000014,FHCIEN_",",".12","I"))
+69 ;
+70 ;Set up sorting array
+71 SET ARRAY(RORD,RELNM,FHCIEN)=FHCIEN_U_FHRIEN_U_FHRREL_U_FHRDES_U_FHCDX_U_FHCNAR_U_FHCAAO_U_FHRSTS_U_$$FMTE^BQIUL1(FHCDTN)_U_APCDTNQ_U_FHCPRV_U_FHRAAD_U_FHRCOD_U_FHRMB_U_FHRMBT_U_FHRMBD_U_$$FMTE^BQIUL1(FHCDTM)_U_$$FMTE^BQIUL1(FHRDTU)_$CH
AR(30)
End DoDot:1
+72 ;
+73 SET RIEN=""
FOR
SET RIEN=$ORDER(^AUPNFHR("AA",DFN,RIEN))
IF 'RIEN
QUIT
Begin DoDot:1
+74 SET FHRIEN=""
FOR
SET FHRIEN=$ORDER(^AUPNFHR("AA",DFN,RIEN,FHRIEN))
IF FHRIEN=""
QUIT
Begin DoDot:2
+75 IF $DATA(FAM(FHRIEN))
QUIT
+76 ;
+77 ; For family without diagnoses search FAMILY HISTORY FAMILY MEMBERS file
+78 DO GFAM(FHRIEN)
+79 SET ARRAY(RORD,RELNM,"R"_FHRIEN)=U_FHRIEN_U_FHRREL_U_FHRDES_U_U_U_U_FHRSTS_U_U_U_U_FHRAAD_U_FHRCOD_U_FHRMB_U_FHRMBT_U_FHRMBD_U_U_$$FMTE^BQIUL1(FHRDTU)_$CHAR(30)
End DoDot:2
End DoDot:1
+80 ;
+81 ;Create record entries
+82 SET RORD=""
FOR
SET RORD=$ORDER(ARRAY(RORD))
IF RORD=""
QUIT
Begin DoDot:1
+83 SET RELNM=""
FOR
SET RELNM=$ORDER(ARRAY(RORD,RELNM))
IF RELNM=""
QUIT
Begin DoDot:2
+84 SET FHCIEN=""
FOR
SET FHCIEN=$ORDER(ARRAY(RORD,RELNM,FHCIEN))
IF FHCIEN=""
QUIT
Begin DoDot:3
+85 SET II=II+1
SET @DATA@(II)=ARRAY(RORD,RELNM,FHCIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+86 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+87 QUIT
+88 ;
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(FHRIEN) ; Get FAMILY HISTORY FAMILY MEMBERS Data
+1 ;
+2 NEW BQIREL,RIEN,RELT
+3 SET (FHRREL,FHRDES,FHRSTS,FHRDTU,FHRMB,FHRMBT,FHRMBD,FHRAAD,FHRCOD)=""
+4 ;
+5 IF FHRIEN=""
SET (RORD,RELNM)="~"
QUIT
+6 ;
+7 DO GETS^DIQ(9000014.1,FHRIEN,"**","IE","BQIREL")
+8 ;
+9 ;Relative (Relation) and Sort variables
+10 SET REIN=$GET(BQIREL(9000014.1,FHRIEN_",",".01","I"))
+11 SET RELT=$GET(BQIREL(9000014.1,FHRIEN_",",".01","E"))
+12 SET RELNM=RELT
IF RELNM=""
SET RELNM="~"
+13 SET FHRREL=""
IF REIN'=""
SET FHRREL=REIN_$CHAR(28)_RELT
+14 SET RORD=$$GET1^DIQ(9999999.36,REIN_",",2103,"E")
IF RORD=""
SET RORD="~"
+15 ;
+16 ;Relation Modifier (Description)
+17 SET FHRDES=$GET(BQIREL(9000014.1,FHRIEN_",",".03","E"))
+18 ;
+19 ;Status
+20 SET FHRSTS=$GET(BQIREL(9000014.1,FHRIEN_",",".04","I"))_$CHAR(28)_$GET(BQIREL(9000014.1,FHRIEN_",",".04","E"))
+21 IF $PIECE(FHRSTS,$CHAR(28))=""
SET FHRSTS=""
+22 ;
+23 ;Date Updated
+24 SET FHRDTU=$GET(BQIREL(9000014.1,FHRIEN_",",".09","I"))
+25 ;
+26 ;Multiple Birth Status
+27 SET FHRMB=$GET(BQIREL(9000014.1,FHRIEN_",",".07","I"))_$CHAR(28)_$GET(BQIREL(9000014.1,FHRIEN_",",".07","E"))
+28 SET FHRMBD=FHRMB
+29 IF $PIECE(FHRMB,$CHAR(28))=""
SET FHRMB=""
+30 ;
+31 ;Multiple Birth Type
+32 SET FHRMBT=$GET(BQIREL(9000014.1,FHRIEN_",",".08","I"))_$CHAR(28)_$GET(BQIREL(9000014.1,FHRIEN_",",".08","E"))
+33 SET FHRMBD=FHRMBD_$CHAR(28)_FHRMBT
+34 IF $PIECE(FHRMBT,$CHAR(28))=""
SET FHRMBT=""
+35 ;
+36 ;Multiple Birth Display
+37 IF $TRANSLATE(FHRMBD,$CHAR(28))=""
SET FHRMBD=""
+38 ;
+39 ;Age at Death
+40 SET FHRAAD=$GET(BQIREL(9000014.1,FHRIEN_",",".05","I"))_$CHAR(28)_$GET(BQIREL(9000014.1,FHRIEN_",",".05","E"))
+41 IF $PIECE(FHRAAD,$CHAR(28))=""
SET FHRAAD=""
+42 ;
+43 ;Cause of Death
+44 SET FHRCOD=$GET(BQIREL(9000014.1,FHRIEN_",",".06","E"))
+45 ;
+46 QUIT
