Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQITDVAL

BQITDVAL.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. VAL(DATA,DFN,TAG,STAT) ;EP -- BQI DX TAG VALIDATION
  1.  ; Input
  1.  ;    DFN  - Patient internal entry number
  1.  ;    TAG  - the diagnosis tag internal entry number for which is being updated
  1.  ;    STAT - status of the tag management
  1.  ;
  1.  ; Output
  1.  ;    RESULT  - 1 is okay to proceed, -1 cannot proceed 
  1.  ;    HANDLER - 'W' is a warning message to be displayed, 'O' is an override
  1.  ;    MSG     - Message to display for either a 'W' or an 'O'
  1.  ; 
  1.  NEW UID,II
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQITDVAL",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITDVAL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S TAG=$G(TAG,"") I TAG="" S BMXSEC="No Diagnosis Category identified" Q
  1.  S STAT=$G(STAT,"") I STAT="" S BMXSEC="No status identified" Q
  1.  S DFN=$G(DFN,"") I DFN="" S BMXSEC="No patient identified" Q
  1.  ;
  1.  NEW THCFL,RESULT,SEX,AGE,HIEN,HORD,ACT
  1.  S @DATA@(II)="I00010RESULT^T00001HANDLER^T01024MSG"_$C(30)
  1.  S THCFL=+$P(^BQI(90506.2,TAG,0),U,10)
  1.  ; If there is no hierachy, then no further checks need to be performed
  1.  ; Status can change to any other status
  1.  I 'THCFL S RESULT="1^^" G DONE
  1.  ; Check status of hierarchy
  1.  S HIEN=$O(^BQI(90506.2,TAG,4,"B",TAG,""))
  1.  S HORD=$P(^BQI(90506.2,TAG,4,HIEN,0),U,2),ORD=HORD,ACT=0
  1.  ; if nothing after this order, then check for higher
  1.  I $O(^BQI(90506.2,TAG,4,"AC",ORD),-1)'="" D HG
  1.  I ACT G DONE
  1.  S ORD=HORD
  1.  I $O(^BQI(90506.2,TAG,4,"AC",ORD))'="" D LW
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. LW ; Check for an active lower hierarchy
  1.  NEW ACT,HCIEN,HCTAG,RIEN,CSTAT ;,ORD
  1.  S ACT=0
  1.  F  S ORD=$O(^BQI(90506.2,TAG,4,"AC",ORD)) Q:ORD=""  D  Q:ACT
  1.  . S HCIEN=$O(^BQI(90506.2,TAG,4,"AC",ORD,""))
  1.  . S HCTAG=$P(^BQI(90506.2,TAG,4,HCIEN,0),U,1)
  1.  . S RIEN=$O(^BQIREG("C",DFN,HCTAG,"")) I RIEN="" Q
  1.  . S CSTAT=$P(^BQIREG(RIEN,0),U,3)
  1.  . I CSTAT="A"!(CSTAT="P") S ACT=1
  1.  I 'ACT,$P($G(RESULT),U)'<0 S RESULT="1^^"
  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")_"."
  1.  Q
  1.  ;
  1. HG ; Check for an active higher hierarchy
  1.  NEW ACT,HCIEN,HCTAG,RIEN,CSTAT ;,ORD
  1.  S ACT=0
  1.  F  S ORD=$O(^BQI(90506.2,TAG,4,"AC",ORD),-1) Q:ORD=""  D  Q:ACT
  1.  . S HCIEN=$O(^BQI(90506.2,TAG,4,"AC",ORD,""))
  1.  . S HCTAG=$P(^BQI(90506.2,TAG,4,HCIEN,0),U,1)
  1.  . S RIEN=$O(^BQIREG("C",DFN,HCTAG,"")) I RIEN="" Q
  1.  . S CSTAT=$P(^BQIREG(RIEN,0),U,3)
  1.  . S ACT=$$ACST^BQITDUTL(CSTAT)
  1.  I 'ACT,$P($G(RESULT),U)'<0 S RESULT="1^^"
  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'."
  1.  Q