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

BQIUTB2.m

Go to the documentation of this file. 
  1. BQIUTB2 ;PRXM/HC/ALA-Get Reminders List and Help ; 15 Feb 2007  5:35 PM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,FAKE) ;EP -- BQI GET REMINDERS LIST
  1.  NEW UID,II,BQILOC,LII,BI
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIUTB2",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUTB1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D EN^BQIMSLST(.BQILOC,"D")
  1.  S LII=$O(@BQILOC@(""),-1)
  1.  F II=0:1:LII-1 S @DATA@(II)=@BQILOC@(II)
  1.  D EN^BQIMSLST(.BQILOC,"R")
  1.  S LII=$O(@BQILOC@(""),-1)
  1.  F BI=1:1:LII-1 S II=II+1,@DATA@(II)=@BQILOC@(BI)
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  K @BQILOC
  1.  Q
  1.  ;
  1. VFL(DATA,FTYP) ;EP - Get list of Vfiles
  1.  S II=0
  1.  S @DATA@(II)="I00010IEN^T00030^T00100SORT_ORDER^T00100SORT_DIR^T00001FILTER^T00001VIEW_ONLY"_$C(30)
  1.  NEW IEN,IACT,SORT,SN,SIEN,COLMN,SDIR,DIR
  1.  S IEN=0
  1.  F  S IEN=$O(^BQI(90506.3,"D",FTYP,IEN)) Q:'IEN  D
  1.  . NEW DNDSP
  1.  . ; If vfile entry is flagged 'Do not display or extract', quit
  1.  . I $$GET1^DIQ(90506.3,IEN_",",.05,"I")=1 Q
  1.  . S DNDSP="N" I +$$GET1^DIQ(90506.3,IEN_",",.05,"I") S DNDSP="Y"
  1.  . S IACT=$$GET1^DIQ(90506.3,IEN_",",.03,"I")
  1.  . S NAME=$$GET1^DIQ(90506.3,IEN_",",.01,"E")
  1.  . ; If a sub-definition, do not pull
  1.  . I $$GET1^DIQ(90506.3,IEN_",",.07,"I")=1 Q
  1.  . S FILTER=$S($D(^BQI(90506.3,IEN,7)):"Y",1:"N")
  1.  . ;
  1.  . ; Get Sort Order
  1.  . S SORT="",SN="",SDIR=""
  1.  . F  S SN=$O(^BQI(90506.3,IEN,10,"D",SN)) Q:SN=""  D
  1.  .. S SIEN=""
  1.  .. F  S SIEN=$O(^BQI(90506.3,IEN,10,"D",SN,SIEN)) Q:SIEN=""  D
  1.  ... ; If the field is inactive, quit
  1.  ... I $P(^BQI(90506.3,IEN,10,SIEN,0),U,11)=1 Q
  1.  ... S COLMN=$P(^BQI(90506.3,IEN,10,SIEN,0),U,2)
  1.  ... S DIR=$P(^BQI(90506.3,IEN,10,SIEN,0),U,13)
  1.  ... ; Strip off the size and only keep the name
  1.  ... S COLMN=$E(COLMN,7,$L(COLMN))
  1.  ... S SORT=SORT_COLMN_$C(29)
  1.  ... S SDIR=SDIR_DIR_$C(29)
  1.  . S SORT=$$TKO^BQIUL1(SORT,$C(29))
  1.  . S SDIR=$$TKO^BQIUL1(SDIR,$C(29))
  1.  . S II=II+1,@DATA@(II)=IEN_U_$S(IACT=1:"*",1:"")_NAME_U_SORT_U_SDIR_U_FILTER_U_DNDSP_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. APST(DATA) ;EP - Get appointment statuses
  1.  NEW SDATA,II,BI
  1.  S II=0
  1.  S @DATA@(II)="T00003IEN^T00045"_$C(30)
  1.  S SDATA=$P($G(^DD(2.98,3,0)),U,3) I SDATA="" Q
  1.  S II=II+1,@DATA@(II)="AC^ACTIVE"_$C(30)
  1.  F BI=1:1:$L(SDATA,";")-1 D
  1.  . S II=II+1,@DATA@(II)=$P($P(SDATA,";",BI),":",1)_"^"_$P($P(SDATA,";",BI),":",2)_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. PRST(DATA) ;EP - Get problem list statuses
  1.  NEW SDATA,II,BI,CODE,DESC,ACT
  1.  S II=0
  1.  S @DATA@(II)="T00003IEN^T00045^T00001ACTIVE"_$C(30)
  1.  S SDATA=$P($G(^DD(9000011,.12,0)),U,3) I SDATA="" Q
  1.  F BI=1:1:$L(SDATA,";")-1 D
  1.  . S CODE=$P($P(SDATA,";",BI),":",1),DESC=$P($P(SDATA,";",BI),":",2)
  1.  . S ACT="Y"
  1.  . I DESC="DELETED"!(DESC="INACTIVE") S ACT="N"
  1.  . S II=II+1,@DATA@(II)=CODE_"^"_DESC_"^"_ACT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. EPLIST(DATA) ;EP - Get EHR personal lists
  1.  NEW TDATA,II,BI
  1.  K TDATA
  1.  D PLSTLST^BEHOPTP2(.TDATA)
  1.  S II=0,BI=0
  1.  S @DATA@(II)="T00003IEN^T00060"_$C(30)
  1.  F  S BI=$O(TDATA(BI)) Q:BI=""  D
  1.  . S II=II+1,@DATA@(II)=TDATA(BI)_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. UCL(DATA) ;EP - Get User Classes
  1.  NEW UN
  1.  S II=0,UN=0
  1.  S @DATA@(II)="T00003IEN^T00060"_$C(30)
  1.  F  S UN=$O(^USR(8930,UN)) Q:'UN  D
  1.  . I $P(^USR(8930,UN,0),U,3)'=1 Q
  1.  . S II=II+1,@DATA@(II)=UN_U_$S($P(^USR(8930,UN,0),U,4)'="":$P(^USR(8930,UN,0),U,4),1:$P(^USR(8930,UN,0),U,1))_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. FLTR(DATA) ;EP - Get list of filters
  1.  S II=0
  1.  S @DATA@(II)="I00010VDEF_IEN^T00030VDEF_TYPE^T00030FILTER_NAME^T00030FILTER_CATEGORY^T00030FILTER_CLINICAL_GROUP"_$C(30)
  1.  NEW IEN,VALUE,FN,FLN,CGRP,CLN,CAT,NAME
  1.  S IEN=0
  1.  F  S IEN=$O(^BQI(90506.3,IEN)) Q:'IEN  D
  1.  . ; If vfile entry is flagged 'Do not display or extract', quit
  1.  . I $$GET1^DIQ(90506.3,IEN_",",.05,"I")=1 Q
  1.  . S II=II+1
  1.  . S VALUE=IEN_U_$P(^BQI(90506.3,IEN,0),U,1)
  1.  . S FN=0
  1.  . F  S FN=$O(^BQI(90506.3,IEN,7,FN)) Q:'FN  D
  1.  .. NEW DA,IENS
  1.  .. S DA(1)=IEN,DA=FN,IENS=$$IENS^DILF(.DA)
  1.  .. S NAME=$$GET1^DIQ(90506.38,IENS,.01,"E")
  1.  .. S FLN=$$GET1^DIQ(90506.38,IENS,.01,"I")
  1.  .. S CLN=0,CAT="",CGRP=""
  1.  .. I $O(^BQI(90506.5,FLN,6,CLN))="" S II=II+1,@DATA@(II)=VALUE_U_NAME_U_CAT_U_CGRP_$C(30) Q
  1.  .. F  S CLN=$O(^BQI(90506.5,FLN,6,CLN)) Q:'CLN  D
  1.  ... S CGRP=$P(^BQI(90506.5,FLN,6,CLN,0),U,2)
  1.  ... S II=II+1,@DATA@(II)=VALUE_U_NAME_U_CAT_U_CGRP_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. IPCAT(DATA) ;EP - Get the table of IPC categories
  1.  NEW IEN,TEXT,CAT2,CAT1,SBN,SBN,CRIPC
  1.  S II=0
  1.  S @DATA@(II)="T00010IEN^T00030CAT1^T00030CAT2"_$C(30)
  1.  S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
  1.  ;S CRIPC="IPCMH"
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^BQI(90506.8,IEN)) Q:'IEN  D
  1.  . I $P(^BQI(90506.8,IEN,0),U,3)'="C" Q
  1.  . S CAT1=$P(^BQI(90506.8,IEN,0),"^",1)
  1.  . S CAT2=$$GET1^DIQ(90506.8,IEN_",",.04,"E")
  1.  . I CAT2'="" S TEXT=CAT2,CAT2=CAT1
  1.  . I CAT2="" S TEXT=CAT1
  1.  . ; If inactive
  1.  . I '$D(^BQI(90506.8,"AC",IEN)) S II=II+1,@DATA@(II)=IEN_"^"_TEXT_"^"_CAT2_$C(30) Q
  1.  . S SBN=""
  1.  . F  S SBN=$O(^BQI(90506.8,"AC",IEN,SBN)) Q:SBN=""  D
  1.  .. I $P(^BQI(90506.8,SBN,0),"^",2)=1 Q
  1.  .. I $P(^BQI(90506.8,SBN,0),U,5)'=CRIPC Q
  1.  .. S CAT1=$P(^BQI(90506.8,SBN,0),"^",1)
  1.  .. S CAT2=$$GET1^DIQ(90506.8,SBN_",",.04,"E")
  1.  .. I CAT2'="" S TEXT=CAT2,CAT2=CAT1
  1.  .. I CAT2="" S TEXT=CAT1
  1.  .. S II=II+1,@DATA@(II)=SBN_"^"_TEXT_"^"_CAT2_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. CLIN(DATA) ;EP - Get the clinic codes
  1.  NEW IEN,TEXT
  1.  S II=0
  1.  S @DATA@(II)="T00010IEN^T00030"_$C(30)
  1.  S IEN=0
  1.  F  S IEN=$O(^DIC(40.7,IEN)) Q:'IEN  D
  1.  . S TEXT=$P(^DIC(40.7,IEN,0),"^",1)_" ("_$P(^(0),U,2)_")"
  1.  . S II=II+1,@DATA@(II)=IEN_"^"_TEXT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. IPCL(DATA) ;EP - Get the IPC clinic codes
  1.  Q
  1.  ;
  1. DPCP(DATA) ;EP - Get DPCPs
  1.  NEW IEN,TEXT
  1.  S II=0
  1.  S @DATA@(II)="T00010IEN^T00030"_$C(30)
  1.  S IEN=""
  1.  F  S IEN=$O(^AUPNPAT("AK",IEN)) Q:IEN=""  D
  1.  . S TEXT=$P(^VA(200,IEN,0),U,1)
  1.  . S II=II+1,@DATA@(II)=IEN_"^"_TEXT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. MUT(DATA) ;EP - Get MU Tabs
  1.  S II=0
  1.  S @DATA@(II)="T00001CHOICE_TAB^T00030CHOICE_TEXT"_$C(30)
  1.  S II=II+1,@DATA@(II)="P^Performance Measures"_$C(30)
  1.  S II=II+1,@DATA@(II)="C^Clinical Quality Measures"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q