BQIPTFHH.m

BQIPTFHH ;APTIV/HC/ALA-Family and Household Demographics ; 19 Feb 2008  4:51 PM

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

 ;

EN(DATA,BQIDFN) ;EP -- BQI PATIENT HOUSEHOLD

 ;Input

 ;  BQIDFN - Patient internal entry number

 ;

 NEW UID,II,EMER,NOK,PAR,NHH,MBPL,FBPL

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPTFHH",UID))

 K @DATA

 ;

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTFHH D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 S @DATA@(II)="N00002NUM_HOUSE^T00035EMER_NAME^T00030EMER_RELAT^T00020EMER_PHONE^"

 S @DATA@(II)=@DATA@(II)_"T00035NOK_NAME^T00030NOK_RELAT^T00020NOK_PHONE^"

 S @DATA@(II)=@DATA@(II)_"T00035MOTH_MAID_NAME^T00046MOTH_BIRTHPLACE^T00035FATH_NAME^T00046FATH_BIRTHPLACE"_$C(30)

 ;

 S EMER=$G(^DPT(BQIDFN,.33))

 S NOK=$G(^DPT(BQIDFN,.21))

 S PAR=$G(^DPT(BQIDFN,.24))

 S NHH=$P(^AUPNPAT(BQIDFN,0),U,35) S:NHH="" NHH=-1

 S MBPL=$P($G(^AUPNPAT(BQIDFN,26)),U,5)_" "_$$GET1^DIQ(5,$$GET1^DIQ(9000001,BQIDFN_",",2606,"I"),1,"E")

 S FBPL=$P($G(^AUPNPAT(BQIDFN,26)),U,2)_" "_$$GET1^DIQ(5,$$GET1^DIQ(9000001,BQIDFN_",",2603,"I"),1,"E")

 ;

 S II=II+1,@DATA@(II)=NHH_U_$P(EMER,U,1)_U_$P(EMER,U,2)_U_$P(EMER,U,9)_U_$P(NOK,U,1)_U_$P(NOK,U,2)_U

 S @DATA@(II)=@DATA@(II)_$P(NOK,U,9)_U_$P(PAR,U,3)_U_MBPL_U_$P(PAR,U,1)_U_FBPL_$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

BQIPTFHH  ;APTIV/HC/ALA-Family and Household Demographics ; 19 Feb 2008  4:51 PM

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

 +2       ;

EN(DATA,BQIDFN) ;EP -- BQI PATIENT HOUSEHOLD

 +1       ;Input

 +2       ;  BQIDFN - Patient internal entry number

 +3       ;

 +4        NEW UID,II,EMER,NOK,PAR,NHH,MBPL,FBPL

 +5        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +6        SET DATA=$NAME(^TMP("BQIPTFHH",UID))

 +7        KILL @DATA

 +8       ;

 +9        SET II=0

 +10      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPTFHH D UNWIND^%ZTER"

 +11      ;

 +12       SET @DATA@(II)="N00002NUM_HOUSE^T00035EMER_NAME^T00030EMER_RELAT^T00020EMER_PHONE^"

 +13       SET @DATA@(II)=@DATA@(II)_"T00035NOK_NAME^T00030NOK_RELAT^T00020NOK_PHONE^"

 +14       SET @DATA@(II)=@DATA@(II)_"T00035MOTH_MAID_NAME^T00046MOTH_BIRTHPLACE^T00035FATH_NAME^T00046FATH_BIRTHPLACE"_$CHAR(30)

 +15      ;

 +16       SET EMER=$GET(^DPT(BQIDFN,.33))

 +17       SET NOK=$GET(^DPT(BQIDFN,.21))

 +18       SET PAR=$GET(^DPT(BQIDFN,.24))

 +19       SET NHH=$PIECE(^AUPNPAT(BQIDFN,0),U,35)

           IF NHH=""

               SET NHH=-1

 +20       SET MBPL=$PIECE($GET(^AUPNPAT(BQIDFN,26)),U,5)_" "_$$GET1^DIQ(5,$$GET1^DIQ(9000001,BQIDFN_",",2606,"I"),1,"E")

 +21       SET FBPL=$PIECE($GET(^AUPNPAT(BQIDFN,26)),U,2)_" "_$$GET1^DIQ(5,$$GET1^DIQ(9000001,BQIDFN_",",2603,"I"),1,"E")

 +22      ;

 +23       SET II=II+1

           SET @DATA@(II)=NHH_U_$PIECE(EMER,U,1)_U_$PIECE(EMER,U,2)_U_$PIECE(EMER,U,9)_U_$PIECE(NOK,U,1)_U_$PIECE(NOK,U,2)_U

 +24       SET @DATA@(II)=@DATA@(II)_$PIECE(NOK,U,9)_U_$PIECE(PAR,U,3)_U_MBPL_U_$PIECE(PAR,U,1)_U_FBPL_$CHAR(30)

 +25      ;

 +26       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +27       QUIT 

 +28      ;

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