BQICMDNM.m

BQICMDNM ;VNGT/HS/ALA - Get Care Management Denominator ; 25 Sep 2008  2:41 PM

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

 ;

 Q

 ;

EN(DATA,DFN,CARE) ;EP -- BQI GET CARE MGMT DENOMINATOR

 ;

 ; Input

 ;   DFN  - Patient internal entry number

 ;   CARE - A specific care management

 ;

 NEW UID,II

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

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

 K @DATA

 ;

 S II=0

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

 ;

 S CARE=$G(CARE,"")

 S HDR="T01024DENOMINATOR",VALUE=""

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

 ;

 I CARE'="" D

 . I CARE'?.N S CMN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")

 . I CARE?.N S CMN=CARE

 . D DEF(CMN)

 . ;

 I CARE="" D

 . S CMN=0

 . F  S CMN=$O(^BQI(90506.5,CMN)) Q:'CMN  D DEF(CMN)

 ;

 S VALUE=$$TKO^BQIUL1(VALUE,$C(28))

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

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

 ;

NRPC(DFN,CARE) ;EP - Return denominator as a flag in non RPC call

 I CARE'?.N S CMN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")

 I CARE?.N S CMN=CARE

 Q $$DEFA(CMN)

 ;

DEF(CMN) ; Definition

 S VAL="N"

 I $P(^BQI(90506.5,CMN,0),U,4)'=1 Q

 S EXEC=$G(^BQI(90506.5,CMN,1)) I EXEC="" Q

 X EXEC

 S TIT=$P(^BQI(90506.5,CMN,0),U,1)

 I $G(VAL)="" Q

 S VALUE=VALUE_TIT_"="_$G(VAL)_$C(28)

 Q

 ;

DEFA(CMN) ; EP - Denominator API

 S VAL=0

 I $P(^BQI(90506.5,CMN,0),U,4)'=1 Q VAL

 S EXEC=$G(^BQI(90506.5,CMN,1)) I EXEC="" Q VAL

 X EXEC

 Q $S(VAL="Y":1,1:0)

 ;

HIV(BQDFN,CMN) ; EP

 NEW RESULT,REG,TAG,ACT,BKMIEN,BKMREG,DA,BKMIENS,DXCAT

 S RESULT="N"

 S REG=$P(^BQI(90506.5,CMN,0),U,3) I REG="" Q RESULT

 S TAG=$O(^BQI(90506.2,"AD",REG,"")) I TAG="" Q RESULT

 S ACT=$$ATAG^BQITDUTL(BQDFN,TAG)

 ;

 S BKMIEN=$$BKMIEN^BKMIXX3(BQDFN)

 S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)

 S DA(1)=BKMIEN,DA=BKMREG

 S BKMIENS=$$IENS^DILF(.DA)

 S DXCAT=$$GET1^DIQ(90451.01,BKMIENS,2.3,"I")

 I ACT Q "Y"

 I DXCAT="H"!(DXCAT="A") Q "Y"

 Q RESULT

BQICMDNM  ;VNGT/HS/ALA - Get Care Management Denominator ; 25 Sep 2008  2:41 PM

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

 +2       ;

 +3        QUIT 

 +4       ;

EN(DATA,DFN,CARE) ;EP -- BQI GET CARE MGMT DENOMINATOR

 +1       ;

 +2       ; Input

 +3       ;   DFN  - Patient internal entry number

 +4       ;   CARE - A specific care management

 +5       ;

 +6        NEW UID,II

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

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

 +9        KILL @DATA

 +10      ;

 +11       SET II=0

 +12      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +13      ;

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

 +15       SET HDR="T01024DENOMINATOR"

           SET VALUE=""

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

 +17      ;

 +18       IF CARE'=""

               Begin DoDot:1

 +19               IF CARE'?.N

                       SET CMN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")

 +20               IF CARE?.N

                       SET CMN=CARE

 +21               DO DEF(CMN)

 +22      ;

               End DoDot:1

 +23       IF CARE=""

               Begin DoDot:1

 +24               SET CMN=0

 +25               FOR 

                       SET CMN=$ORDER(^BQI(90506.5,CMN))

                       IF 'CMN

                           QUIT 

                       DO DEF(CMN)

               End DoDot:1

 +26      ;

 +27       SET VALUE=$$TKO^BQIUL1(VALUE,$CHAR(28))

 +28       SET II=II+1

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

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       ;

NRPC(DFN,CARE) ;EP - Return denominator as a flag in non RPC call

 +1        IF CARE'?.N

               SET CMN=$$FIND1^DIC(90506.5,"","B",CARE,"","","ERROR")

 +2        IF CARE?.N

               SET CMN=CARE

 +3        QUIT $$DEFA(CMN)

 +4       ;

DEF(CMN)  ; Definition

 +1        SET VAL="N"

 +2        IF $PIECE(^BQI(90506.5,CMN,0),U,4)'=1

               QUIT 

 +3        SET EXEC=$GET(^BQI(90506.5,CMN,1))

           IF EXEC=""

               QUIT 

 +4        XECUTE EXEC

 +5        SET TIT=$PIECE(^BQI(90506.5,CMN,0),U,1)

 +6        IF $GET(VAL)=""

               QUIT 

 +7        SET VALUE=VALUE_TIT_"="_$GET(VAL)_$CHAR(28)

 +8        QUIT 

 +9       ;

DEFA(CMN) ; EP - Denominator API

 +1        SET VAL=0

 +2        IF $PIECE(^BQI(90506.5,CMN,0),U,4)'=1

               QUIT VAL

 +3        SET EXEC=$GET(^BQI(90506.5,CMN,1))

           IF EXEC=""

               QUIT VAL

 +4        XECUTE EXEC

 +5        QUIT $SELECT(VAL="Y":1,1:0)

 +6       ;

HIV(BQDFN,CMN) ; EP

 +1        NEW RESULT,REG,TAG,ACT,BKMIEN,BKMREG,DA,BKMIENS,DXCAT

 +2        SET RESULT="N"

 +3        SET REG=$PIECE(^BQI(90506.5,CMN,0),U,3)

           IF REG=""

               QUIT RESULT

 +4        SET TAG=$ORDER(^BQI(90506.2,"AD",REG,""))

           IF TAG=""

               QUIT RESULT

 +5        SET ACT=$$ATAG^BQITDUTL(BQDFN,TAG)

 +6       ;

 +7        SET BKMIEN=$$BKMIEN^BKMIXX3(BQDFN)

 +8        SET BKMREG=$$BKMREG^BKMIXX3(BKMIEN)

 +9        SET DA(1)=BKMIEN

           SET DA=BKMREG

 +10       SET BKMIENS=$$IENS^DILF(.DA)

 +11       SET DXCAT=$$GET1^DIQ(90451.01,BKMIENS,2.3,"I")

 +12       IF ACT

               QUIT "Y"

 +13       IF DXCAT="H"!(DXCAT="A")

               QUIT "Y"

 +14       QUIT RESULT