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
