BQITDVAL ;APTIV/HC/ALA-Dx Tag Validation Program ; 09 Apr 2008 6:58 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
VAL(DATA,DFN,TAG,STAT) ;EP -- BQI DX TAG VALIDATION
; Input
; DFN - Patient internal entry number
; TAG - the diagnosis tag internal entry number for which is being updated
; STAT - status of the tag management
;
; Output
; RESULT - 1 is okay to proceed, -1 cannot proceed
; HANDLER - 'W' is a warning message to be displayed, 'O' is an override
; MSG - Message to display for either a 'W' or an 'O'
;
NEW UID,II
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQITDVAL",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITDVAL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S TAG=$G(TAG,"") I TAG="" S BMXSEC="No Diagnosis Category identified" Q
S STAT=$G(STAT,"") I STAT="" S BMXSEC="No status identified" Q
S DFN=$G(DFN,"") I DFN="" S BMXSEC="No patient identified" Q
;
NEW THCFL,RESULT,SEX,AGE,HIEN,HORD,ACT
S @DATA@(II)="I00010RESULT^T00001HANDLER^T01024MSG"_$C(30)
S THCFL=+$P(^BQI(90506.2,TAG,0),U,10)
; If there is no hierachy, then no further checks need to be performed
; Status can change to any other status
I 'THCFL S RESULT="1^^" G DONE
; Check status of hierarchy
S HIEN=$O(^BQI(90506.2,TAG,4,"B",TAG,""))
S HORD=$P(^BQI(90506.2,TAG,4,HIEN,0),U,2),ORD=HORD,ACT=0
; if nothing after this order, then check for higher
I $O(^BQI(90506.2,TAG,4,"AC",ORD),-1)'="" D HG
I ACT G DONE
S ORD=HORD
I $O(^BQI(90506.2,TAG,4,"AC",ORD))'="" D LW
;
DONE ;
S II=II+1,@DATA@(II)=RESULT_$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
;
LW ; Check for an active lower hierarchy
NEW ACT,HCIEN,HCTAG,RIEN,CSTAT ;,ORD
S ACT=0
F S ORD=$O(^BQI(90506.2,TAG,4,"AC",ORD)) Q:ORD="" D Q:ACT
. S HCIEN=$O(^BQI(90506.2,TAG,4,"AC",ORD,""))
. S HCTAG=$P(^BQI(90506.2,TAG,4,HCIEN,0),U,1)
. S RIEN=$O(^BQIREG("C",DFN,HCTAG,"")) I RIEN="" Q
. S CSTAT=$P(^BQIREG(RIEN,0),U,3)
. I CSTAT="A"!(CSTAT="P") S ACT=1
I 'ACT,$P($G(RESULT),U)'<0 S RESULT="1^^"
I ACT S RESULT="-1^O^Patient already has "_$$GET1^DIQ(90509,RIEN_",",.01,"E")_" with a status of "_$$GET1^DIQ(90509,RIEN_",",.03,"E")_"."
Q
;
HG ; Check for an active higher hierarchy
NEW ACT,HCIEN,HCTAG,RIEN,CSTAT ;,ORD
S ACT=0
F S ORD=$O(^BQI(90506.2,TAG,4,"AC",ORD),-1) Q:ORD="" D Q:ACT
. S HCIEN=$O(^BQI(90506.2,TAG,4,"AC",ORD,""))
. S HCTAG=$P(^BQI(90506.2,TAG,4,HCIEN,0),U,1)
. S RIEN=$O(^BQIREG("C",DFN,HCTAG,"")) I RIEN="" Q
. S CSTAT=$P(^BQIREG(RIEN,0),U,3)
. S ACT=$$ACST^BQITDUTL(CSTAT)
I 'ACT,$P($G(RESULT),U)'<0 S RESULT="1^^"
I ACT S RESULT="-1^W^Patient already has "_$$GET1^DIQ(90509,RIEN_",",.01,"E")_" with a status of "_$$GET1^DIQ(90509,RIEN_",",.03,"E")_". You must first change its status to 'NOT ACCEPTED'."
Q
BQITDVAL ;APTIV/HC/ALA-Dx Tag Validation Program ; 09 Apr 2008 6:58 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
VAL(DATA,DFN,TAG,STAT) ;EP -- BQI DX TAG VALIDATION
+1 ; Input
+2 ; DFN - Patient internal entry number
+3 ; TAG - the diagnosis tag internal entry number for which is being updated
+4 ; STAT - status of the tag management
+5 ;
+6 ; Output
+7 ; RESULT - 1 is okay to proceed, -1 cannot proceed
+8 ; HANDLER - 'W' is a warning message to be displayed, 'O' is an override
+9 ; MSG - Message to display for either a 'W' or an 'O'
+10 ;
+11 NEW UID,II
+12 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+13 SET DATA=$NAME(^TMP("BQITDVAL",UID))
+14 KILL @DATA
+15 SET II=0
+16 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQITDVAL D UNWIND^%ZTER"
+17 ;
+18 SET TAG=$GET(TAG,"")
IF TAG=""
SET BMXSEC="No Diagnosis Category identified"
QUIT
+19 SET STAT=$GET(STAT,"")
IF STAT=""
SET BMXSEC="No status identified"
QUIT
+20 SET DFN=$GET(DFN,"")
IF DFN=""
SET BMXSEC="No patient identified"
QUIT
+21 ;
+22 NEW THCFL,RESULT,SEX,AGE,HIEN,HORD,ACT
+23 SET @DATA@(II)="I00010RESULT^T00001HANDLER^T01024MSG"_$CHAR(30)
+24 SET THCFL=+$PIECE(^BQI(90506.2,TAG,0),U,10)
+25 ; If there is no hierachy, then no further checks need to be performed
+26 ; Status can change to any other status
+27 IF 'THCFL
SET RESULT="1^^"
GOTO DONE
+28 ; Check status of hierarchy
+29 SET HIEN=$ORDER(^BQI(90506.2,TAG,4,"B",TAG,""))
+30 SET HORD=$PIECE(^BQI(90506.2,TAG,4,HIEN,0),U,2)
SET ORD=HORD
SET ACT=0
+31 ; if nothing after this order, then check for higher
+32 IF $ORDER(^BQI(90506.2,TAG,4,"AC",ORD),-1)'=""
DO HG
+33 IF ACT
GOTO DONE
+34 SET ORD=HORD
+35 IF $ORDER(^BQI(90506.2,TAG,4,"AC",ORD))'=""
DO LW
+36 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
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 ;
LW ; Check for an active lower hierarchy
+1 ;,ORD
NEW ACT,HCIEN,HCTAG,RIEN,CSTAT
+2 SET ACT=0
+3 FOR
SET ORD=$ORDER(^BQI(90506.2,TAG,4,"AC",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+4 SET HCIEN=$ORDER(^BQI(90506.2,TAG,4,"AC",ORD,""))
+5 SET HCTAG=$PIECE(^BQI(90506.2,TAG,4,HCIEN,0),U,1)
+6 SET RIEN=$ORDER(^BQIREG("C",DFN,HCTAG,""))
IF RIEN=""
QUIT
+7 SET CSTAT=$PIECE(^BQIREG(RIEN,0),U,3)
+8 IF CSTAT="A"!(CSTAT="P")
SET ACT=1
End DoDot:1
IF ACT
QUIT
+9 IF 'ACT
IF $PIECE($GET(RESULT),U)'<0
SET RESULT="1^^"
+10 IF ACT
SET RESULT="-1^O^Patient already has "_$$GET1^DIQ(90509,RIEN_",",.01,"E")_" with a status of "_$$GET1^DIQ(90509,RIEN_",",.03,"E")_"."
+11 QUIT
+12 ;
HG ; Check for an active higher hierarchy
+1 ;,ORD
NEW ACT,HCIEN,HCTAG,RIEN,CSTAT
+2 SET ACT=0
+3 FOR
SET ORD=$ORDER(^BQI(90506.2,TAG,4,"AC",ORD),-1)
IF ORD=""
QUIT
Begin DoDot:1
+4 SET HCIEN=$ORDER(^BQI(90506.2,TAG,4,"AC",ORD,""))
+5 SET HCTAG=$PIECE(^BQI(90506.2,TAG,4,HCIEN,0),U,1)
+6 SET RIEN=$ORDER(^BQIREG("C",DFN,HCTAG,""))
IF RIEN=""
QUIT
+7 SET CSTAT=$PIECE(^BQIREG(RIEN,0),U,3)
+8 SET ACT=$$ACST^BQITDUTL(CSTAT)
End DoDot:1
IF ACT
QUIT
+9 IF 'ACT
IF $PIECE($GET(RESULT),U)'<0
SET RESULT="1^^"
+10 IF ACT
SET RESULT="-1^W^Patient already has "_$$GET1^DIQ(90509,RIEN_",",.01,"E")_" with a status of "_$$GET1^DIQ(90509,RIEN_",",.03,"E")_". You must first change its status to 'NOT ACCEPTED'."
+11 QUIT
