BQIGPRA3.m

BQIGPRA3 ;PRXM/HC/ALA - GPRA Summary Indicators ; 10 Feb 2006  5:11 PM

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

 ;

 Q

 ;

EN(DATA,YEAR) ; EP -- BQI GET GPRA MEASURE LIST

 ; Description

 ;   Get GPRA indicator list for the specified year

 ; Input

 ;   YEAR - The GPRA Year

 ;

 NEW UID,II,BQI1,BQI2,X

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

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

 K @DATA

 ;

 S II=0

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

 ;

 S YEAR=$G(YEAR,"")

 I YEAR="" D

 . I $G(BQIH)="" S BQIH=$$SPM^BQIGPUTL()

 . S YEAR=$$GET1^DIQ(90508,BQIH_",",2,"E")

 ;

 ; Get the demographics list

 D EN^BQIMSLST(.BQILOC,"D")

 S LII=$O(@BQILOC@(""),-1)

 F II=0:1:LII-1 S @DATA@(II)=@BQILOC@(II)

 ;

 ; Get the National Measures List

 D EN^BQIMSLST(.BQILOC,"G")

 S LII=$O(@BQILOC@(""),-1)

 F BI=1:1:LII-1 S II=II+1,@DATA@(II)=@BQILOC@(BI)

 ;

DONE ;

 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

 ;

MEAS(DATA,DFN,BQIMEAS) ; EP -- BQI GET GPRA ADHERENCE

 ; Input

 ;   DFN     - Patient IEN

 ;   BQIMEAS - GPRA measure code value

 ;

 NEW UID,II

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

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

 K @DATA

 ;

 S II=0

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

 ;

 S HDR="T00015MEAS_CODE^T00100ADHER_VALUE"

 S @DATA@(II)=HDR_$C(30)

 ;

 S IEN=""

 S IEN=$O(^BQIPAT(DFN,30,"B",BQIMEAS,IEN)) G DONE:IEN=""

 S VALUE=$P(^BQIPAT(DFN,30,IEN,0),U,2)

 S VALUE=$P(VALUE,"|||",2)

 S II=II+1,@DATA@(II)=BQIMEAS_U_VALUE_$C(30)

 G DONE

BQIGPRA3  ;PRXM/HC/ALA - GPRA Summary Indicators ; 10 Feb 2006  5:11 PM

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

 +2       ;

 +3        QUIT 

 +4       ;

EN(DATA,YEAR) ; EP -- BQI GET GPRA MEASURE LIST

 +1       ; Description

 +2       ;   Get GPRA indicator list for the specified year

 +3       ; Input

 +4       ;   YEAR - The GPRA Year

 +5       ;

 +6        NEW UID,II,BQI1,BQI2,X

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

 +8        SET DATA=$NAME(^TMP("BQIGPRA3",UID))

 +9        KILL @DATA

 +10      ;

 +11       SET II=0

 +12      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +13      ;

 +14       SET YEAR=$GET(YEAR,"")

 +15       IF YEAR=""

               Begin DoDot:1

 +16               IF $GET(BQIH)=""

                       SET BQIH=$$SPM^BQIGPUTL()

 +17               SET YEAR=$$GET1^DIQ(90508,BQIH_",",2,"E")

               End DoDot:1

 +18      ;

 +19      ; Get the demographics list

 +20       DO EN^BQIMSLST(.BQILOC,"D")

 +21       SET LII=$ORDER(@BQILOC@(""),-1)

 +22       FOR II=0:1:LII-1

               SET @DATA@(II)=@BQILOC@(II)

 +23      ;

 +24      ; Get the National Measures List

 +25       DO EN^BQIMSLST(.BQILOC,"G")

 +26       SET LII=$ORDER(@BQILOC@(""),-1)

 +27       FOR BI=1:1:LII-1

               SET II=II+1

               SET @DATA@(II)=@BQILOC@(BI)

 +28      ;

DONE      ;

 +1        SET II=II+1

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

 +2        QUIT 

 +3       ;

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       ;

MEAS(DATA,DFN,BQIMEAS) ; EP -- BQI GET GPRA ADHERENCE

 +1       ; Input

 +2       ;   DFN     - Patient IEN

 +3       ;   BQIMEAS - GPRA measure code value

 +4       ;

 +5        NEW UID,II

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

 +7        SET DATA=$NAME(^TMP("BQIGPMEAS",UID))

 +8        KILL @DATA

 +9       ;

 +10       SET II=0

 +11      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +12      ;

 +13       SET HDR="T00015MEAS_CODE^T00100ADHER_VALUE"

 +14       SET @DATA@(II)=HDR_$CHAR(30)

 +15      ;

 +16       SET IEN=""

 +17       SET IEN=$ORDER(^BQIPAT(DFN,30,"B",BQIMEAS,IEN))

           IF IEN=""

               GOTO DONE

 +18       SET VALUE=$PIECE(^BQIPAT(DFN,30,IEN,0),U,2)

 +19       SET VALUE=$PIECE(VALUE,"|||",2)

 +20       SET II=II+1

           SET @DATA@(II)=BQIMEAS_U_VALUE_$CHAR(30)

 +21       GOTO DONE