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

BQICMLST.m

Go to the documentation of this file. 
  1. BQICMLST ;VNGT/HS/ALA-Care Management List ; 28 May 2008  6:59 PM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,TYPE) ;EP -- BQI GET CARE MGMT LIST
  1.  ;
  1.  ; Input
  1.  ;   TYPE - type of measures to list see table 90506.5 for list
  1.  ;
  1.  NEW UID,II,TTYPE,SCAT,SCLIN,BQMEAS,CAT,CLIN,TITLE,BATCH,BQIMEASF,CMCOD
  1.  NEW EDIT,NCAT,NCLIN,NVIEW,ORD,PIND,YEAR,SDIR,BQISORT,INACTIVE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQICMLST",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQICMLST D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010MEAS_IEN^T00030TYPE^T00030CATEGORY^T00030CLIN_GROUP^T00050DISPLAY_NAME^T00015CODE^T00001VIEW^T00001PER_DIRECT^"
  1.  S @DATA@(II)=@DATA@(II)_"T00001EXCEPT^I00003SIZE^T00003EDIT^T00003BATCH^T00001DEFAULT_SORT"_$C(30)
  1.  ;
  1.  S TYPE=$G(TYPE,"")
  1.  ;
  1.  I TYPE'="" D  G DONE
  1.  . N TPC,NTYPE
  1.  . F TPC=1:1:$L(TYPE,$C(29)) S NTYPE=$P(TYPE,$C(29),TPC) I NTYPE]"" D
  1.  .. I NTYPE'?.N S CMCOD=$$FIND1^DIC(90506.5,"","X",NTYPE,"B","","ERROR")
  1.  .. I CMCOD=0 S CMCOD=$$FIND1^DIC(90506.5,"","X",NTYPE,"C","","ERROR")
  1.  .. I NTYPE?.N S CMCOD=NTYPE
  1.  .. ;
  1.  .. S TTYPE=$P($G(^BQI(90506.5,CMCOD,0)),U,2)
  1.  .. I TTYPE'="" D RET
  1.  .. ;
  1.  .. ;Get care management columns
  1.  .. D CMGT
  1.  ;
  1.  S TTYPE=""
  1.  F  S TTYPE=$O(^BQI(90506.5,"C",TTYPE)) Q:TTYPE=""  D
  1.  . S CMCOD=$O(^BQI(90506.5,"C",TTYPE,""))
  1.  . S INACTIVE=$$GET1^DIQ(90506.5,CMCOD_",",.1,"I") Q:INACTIVE
  1.  . S IEN=$O(^BQI(90506.1,"AD",TTYPE,""))
  1.  . ;I IEN="" D CMGT Q
  1.  . I IEN'="" D RET
  1.  . D CMGT
  1.  . ;D RET
  1.  ;
  1. DONE ;
  1.  S SRC=""
  1.  F  S SRC=$O(BQISORT(SRC)) Q:SRC=""  D
  1.  . S CAT=""
  1.  . F  S CAT=$O(BQISORT(SRC,CAT)) Q:CAT=""  D
  1.  .. S CLIN=""
  1.  .. F  S CLIN=$O(BQISORT(SRC,CAT,CLIN)) Q:CLIN=""  D
  1.  ... S TITLE=""
  1.  ... F  S TITLE=$O(BQISORT(SRC,CAT,CLIN,TITLE)) Q:TITLE=""  D
  1.  .... S BQMEAS=""
  1.  .... F  S BQMEAS=$O(BQISORT(SRC,CAT,CLIN,TITLE,BQMEAS)) Q:BQMEAS=""  D
  1.  ..... S II=II+1,@DATA@(II)=BQISORT(SRC,CAT,CLIN,TITLE,BQMEAS)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  K BQISORT
  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. RET ; Data retrieval
  1.  NEW IEN,FDATA,SRC,GCAT,RCAT,DCAT,GCLIN,RCLIN,GVIEW,DVIEW,VIEW,DCLIN
  1.  NEW CAT,CLIN,RVIEW,MVIEW,PDIR,EXCEPT,SIZE,SRCN,KEY
  1.  ; Check for Alternate Display Order fist
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90506.1,"AF",TTYPE,ORD)) Q:ORD=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BQI(90506.1,"AF",TTYPE,ORD,IEN)) Q:IEN=""  D GET(IEN)
  1.  ;
  1.  ; Get normal order
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90506.1,"AD",TTYPE,ORD)) Q:ORD=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BQI(90506.1,"AD",TTYPE,ORD,IEN)) Q:IEN=""  D GET(IEN)
  1.  Q
  1.  ;
  1. GET(IEN) ;EP - Get data values
  1.  S FDATA=$G(^BQI(90506.1,IEN,0)),EXCEPT="",SIZE=""
  1.  I $$GET1^DIQ(90506.1,IEN_",",.1,"I")=1 Q
  1.  I $$GET1^DIQ(90506.1,IEN_",",3.07,"I")=1 Q
  1.  S KEY=$$GET1^DIQ(90506.1,IEN_",",3.1,"E")
  1.  I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
  1.  S SRCN=$$GET1^DIQ(90506.1,IEN_",",3.01,"I")
  1.  S SRC=$S($$GET1^DIQ(90506.5,SRCN_",",.06,"E")'="":$$GET1^DIQ(90506.5,SRCN_",",.06,"E"),1:$$GET1^DIQ(90506.5,SRCN_",",.01,"E"))
  1.  ;S SRC=$$GET1^DIQ(90506.1,IEN_",",3.01,"E")
  1.  S NCAT=$$GET1^DIQ(90506.1,IEN_",",3.03,"E")
  1.  S NCLIN=$$GET1^DIQ(90506.1,IEN_",",3.02,"E")
  1.  S NVIEW=$$GET1^DIQ(90506.1,IEN_",",3.04,"I")
  1.  S PDIR=$$GET1^DIQ(90506.1,IEN_",",.14,"I")
  1.  S SIZE=$$GET1^DIQ(90506.1,IEN_",",.15,"E")
  1.  S EDIT=+$$GET1^DIQ(90506.1,IEN_",",.16,"I")
  1.  S EDIT=$S(EDIT=1:"YES",1:"NO")
  1.  S BATCH=+$$GET1^DIQ(90506.1,IEN_",",.17,"I")
  1.  S BATCH=$S(BATCH=1:"YES",1:"NO")
  1.  S SDIR=$$GET1^DIQ(90506.1,IEN_",",3.08,"I")
  1.  S:SDIR="" SDIR="A"
  1.  S VIEW=NVIEW
  1.  S:VIEW="" VIEW="O"
  1.  S DCLIN=""
  1.  S CAT=NCAT
  1.  S CLIN=NCLIN
  1.  I TTYPE="G" D
  1.  . NEW CODE,BQIH,BQIYR,BQMEAS,VER
  1.  . S CODE=$P(FDATA,U,1),YEAR=$P(CODE,"_",1)
  1.  . S BQMEAS=$P(CODE,"_",2)
  1.  . S BQIH=$$SPM^BQIGPUTL()
  1.  . S BQIYR=$$LKP^BQIGPUTL(YEAR)
  1.  . S VER=$$VERSION^XPDUTL("BGP")
  1.  . I VER>7.0 D
  1.  .. D GFN^BQIGPUTL(BQIH,BQIYR)
  1.  .. S EXCEPT=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1704,"I")
  1.  .. S EXCEPT=$S(EXCEPT="Y":"C",1:"N")
  1.  .. S PDIR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1705,"E")
  1.  S SCAT=$S(CAT="":"@",1:CAT),SCLIN=$S(CLIN="":"@",1:CLIN)
  1.  S BQISORT(SRC,SCAT,SCLIN,$P(FDATA,U,3),IEN)=IEN_U_SRC_U_CAT_U_CLIN_U_$P(FDATA,U,3)_U_$P(FDATA,U,1)_U_VIEW_U_$G(PDIR)_U_$G(EXCEPT)_U_SIZE_U_EDIT_U_BATCH_U_SDIR_$C(30)
  1.  ;S II=II+1,@DATA@(II)=IEN_U_SRC_U_CAT_U_CLIN_U_$P(FDATA,U,3)_U_$P(FDATA,U,1)_U_VIEW_U_PDIR_U_EXCEPT_U_SIZE_U_EDIT_U_BATCH_U_SDIR_$C(30)
  1.  Q
  1.  ;
  1. CMGT ; Additional Care Mgmt columns
  1.  NEW KEY,DXCL,FDATA,CAT,REQ,SRC,FTY,CLIN,SCLIN
  1.  S KEY=$P(^BQI(90506.5,CMCOD,0),U,12)
  1.  I KEY'="",'$$KEYCHK^BQIULSC(KEY,DUZ) Q
  1.  S DXCL=0
  1.  F  S DXCL=$O(^BQI(90506.5,CMCOD,10,DXCL)) Q:'DXCL  D
  1.  . S FDATA=^BQI(90506.5,CMCOD,10,DXCL,0)
  1.  . I $P(FDATA,U,9)=1 Q
  1.  . S FTY=$P(FDATA,U,2),CAT="",CLIN="",SCLIN=""
  1.  . S CAT=$P($G(^BQI(90506.5,CMCOD,10,DXCL,5)),"^",2),CLIN=$P($G(^BQI(90506.5,CMCOD,10,DXCL,5)),"^",1)
  1.  . I FTY'="" D
  1.  .. I CAT'=""!(CLIN'="") Q
  1.  .. S CAT=$$GET1^DIQ(90621.1,FTY_",",.07,"E")
  1.  .. I CAT="Other" S CLIN=$$GET1^DIQ(90621.1,FTY_",",.08,"E"),SCLIN=$$LOWER^VALM1(CLIN)
  1.  .. ;I CLIN="" S CLIN="@",SCLIN=""
  1.  . S REQ=$S($P(FDATA,U,6)'="":$P(FDATA,U,6),1:"O")
  1.  . S SCAT=$S(CAT="":"@",1:CAT),SCLIN=$S(CLIN="":"@",1:CLIN)
  1.  . S SRC=$S($$GET1^DIQ(90506.5,CMCOD_",",.06,"E")'="":$$GET1^DIQ(90506.5,CMCOD_",",.06,"E"),1:$$GET1^DIQ(90506.5,CMCOD_",",.01,"E"))
  1.  . S BQISORT(SRC,SCAT,SCLIN,$P(FDATA,U,3),DXCL)=DXCL_U_SRC_U_CAT_U_CLIN_U_$P(FDATA,U,3)_U_$P(FDATA,U,1)_U_REQ_U_U_U_U_U_U_$C(30)
  1.  . ;
  1.  ;Get locally created care management columns if associated with a dx tag
  1.  NEW DXTN
  1.  S DXTN=$P($G(^BQI(90506.5,CMCOD,0)),U,11) I DXTN="" Q
  1.  S DXCL=0
  1.  F  S DXCL=$O(^BQI(90506.2,DXTN,6,DXCL)) Q:'DXCL  D
  1.  . S CAT="Local",CLIN="",SCLIN=""
  1.  . S FDATA=^BQI(90506.2,DXTN,6,DXCL,0)
  1.  . I $P(FDATA,U,9)=1 Q
  1.  . S REQ=$S($P(FDATA,U,6)'="":$P(FDATA,U,6),1:"O")
  1.  . S SCAT=$S(CAT="":"@",1:CAT),SCLIN=$S(CLIN="":"@",1:CLIN)
  1.  . S SRC=$S($$GET1^DIQ(90506.5,CMCOD_",",.06,"E")'="":$$GET1^DIQ(90506.5,CMCOD_",",.06,"E"),1:$$GET1^DIQ(90506.5,CMCOD_",",.01,"E"))
  1.  . S BQISORT(SCAT,SCLIN,$P(FDATA,U,3),DXCL)=DXCL_U_SRC_U_CAT_U_CLIN_U_$P(FDATA,U,3)_U_$P(FDATA,U,1)_U_REQ_U_U_U_U_U_U_$C(30)
  1.  Q