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

BQIPLRT.m

Go to the documentation of this file. 
  1. BQIPLRT ;PRXM/HC/DLS - Panel List Displays ; 26 Oct 2005  9:24 AM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  ;
  1.  Q
  1.  ;
  1.  ; NOTE: There are three types of lists you can generate here.
  1.  ;     You can run:
  1.  ;        LISTS  - to get a combined list (both owned & shared).  
  1.  ;        OWNED  - to get Panels owned by the user.
  1.  ;        SHARED - to get Panels shared by the user (owned by someone else).
  1.  ;
  1. LISTS(DATA,OWNR) ; PEP -- BQI GET PANEL LIST
  1.  ;Description
  1.  ;  Returns a list of panels owned by the user and shared by the user with another owner.
  1.  ;  
  1.  ;Input
  1.  ;  OWNR - DUZ of the panel list owner (if not the current user)
  1.  ;  FAKE - extra 'blank' parameter required by BMXNET async 'feature'
  1.  ;
  1.  ;Output
  1.  ;  ^TMP("BQIPLRT") - name of global (passed by reference) in which the data is stored.
  1.  ;
  1.  ;Variables Used
  1.  ;  UID - Unique TMP global subscript.
  1.  ;
  1.  N UID,X,BQII,DA,OWNRNM,OWNRIEN,PLMSG,PLNME,PLIEN,IENS,PLDEFUPD,PCAT
  1.  N PLAUTO,PLLSTPOP,PLLSTUPD,PLCNT,PLDESC,PLRTS,PLCRBY,PLDATA,PLID,PLSTAT
  1.  N SHSTDT,SHENDT,SHAXCS,AUTOSTAT,PLCRDT,PLDFUPBY,PLPOPBY,PLUPBY,IPCPL
  1.  N BQIPREF,BQIFLAG
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S BQII=0
  1.  S DATA=$NA(^TMP("BQIPLRT",UID))
  1.  K @DATA
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLRT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ;Default to DUZ if OWNR is not passed in
  1.  S:$G(OWNR)="" OWNR=DUZ
  1.  ;
  1.  D HDR
  1.  ;
  1.  ; If there are no owned or shared panels, don't do anything.
  1.  I '$D(^BQICARE(OWNR,1,"B")),'$D(^BQICARE("C",OWNR)) G DONE
  1.  ;
  1.  ; Get Panels Owned by User
  1.  S OWNRNM=$$GET1^DIQ(90505,OWNR,.01,"E")
  1.  D RET^BQIFLAG(OWNR,.BQIPREF)
  1.  S PLIEN=0,DA(1)=OWNR
  1.  F  S PLIEN=$O(^BQICARE(OWNR,1,PLIEN)) Q:'PLIEN  D
  1.  . I $G(^BQICARE(OWNR,1,PLIEN,0))="" K ^BQICARE(OWNR,1,PLIEN) Q
  1.  . S DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1.  . S PLID=$$PLID^BQIUG1(OWNR,PLIEN)
  1.  . D GETDATA(OWNR,PLIEN)
  1.  . S BQII=BQII+1,@DATA@(BQII)=OWNR_PLDATA_$C(30)
  1.  . I $O(^BQICARE(OWNR,1,PLIEN,30,0))'="" D
  1.  .. S @DATA@(BQII)=OWNR_PLDATA_"Y"_$C(30)
  1.  ;
  1.  ; Get Panels Shared with Another Owner
  1.  S (OWNRIEN,PLIEN)=""
  1.  F  S OWNRIEN=$O(^BQICARE("C",OWNR,OWNRIEN)) Q:'OWNRIEN  D
  1.  . F  S PLIEN=$O(^BQICARE("C",OWNR,OWNRIEN,PLIEN)) Q:'PLIEN  D
  1.  .. N DA
  1.  .. S DA(2)=OWNRIEN,DA(1)=PLIEN,DA=OWNR
  1.  .. S IENS=$$IENS^DILF(.DA)
  1.  .. S SHAXCS=$$GET1^DIQ(90505.03,IENS,.02,"I")
  1.  .. S SHSTDT=$$GET1^DIQ(90505.03,IENS,.03,"I")
  1.  .. S SHENDT=$$GET1^DIQ(90505.03,IENS,.04,"I")
  1.  .. ; IF shared user start date is not after today (or null) AND
  1.  .. ; IF shared user  end  date is     after today (or null) AND
  1.  .. ; IF shared user access is not 'I'nactive, THEN proceed.
  1.  .. I SHSTDT'>DT,((SHENDT'<DT)!(SHENDT="")),SHAXCS'="I" D
  1.  ... N DA
  1.  ... S DA=PLIEN,DA(1)=OWNRIEN,IENS=$$IENS^DILF(.DA)
  1.  ... S OWNRNM=$$GET1^DIQ(90505,OWNRIEN,.01,"E")
  1.  ... S PLID=$$PLID^BQIUG1(OWNRIEN,PLIEN)
  1.  ... NEW PLDEFUPD,PLDFUPBY,PLLSTPOP,PLLSTUPD,PLPOPBY,PLUPBY
  1.  ... D GETDATA(OWNRIEN,PLIEN)
  1.  ... S BQII=BQII+1,@DATA@(BQII)=OWNRIEN_PLDATA_SHAXCS_$C(30)
  1.  G DONE
  1.  ;
  1. OWNED(DATA,FAKE)  ;EP - BQI LIST OF OWNED PANELS OF A USER
  1.  ;Description
  1.  ;  Returns a list of panels owned by the user.
  1.  ;  
  1.  ;Input
  1.  ;  DUZ - User internal entry number
  1.  ;
  1.  ;Output
  1.  ;  ^TMP("BQIPLRT") - Name of global (passed by reference) in which the data is stored.
  1.  ;
  1.  ;Variables Used
  1.  ;  UID - Unique TMP global subscript.
  1.  ;
  1.  N UID,X,BQII,DA,OWNRNM,OWNRIEN,PLMSG,PLNME,PLIEN,IENS,PLDEFUPD,PLAUTO,PLLSTPOP,PLLSTUPD
  1.  N PLCNT,PLDESC,PLRTS,PLCRBY,PLDATA,PLID
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPLRT",UID))
  1.  K ^TMP("BQIPLRT",UID)
  1.  ;
  1.  S BQII=0
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLRT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D HDR
  1.  ;
  1.  I '$D(^BQICARE(DUZ,1,"B")) G DONE
  1.  ;
  1.  S OWNRNM=$$GET1^DIQ(90505,DUZ,.01,"E")
  1.  S PLIEN=0,DA(1)=DUZ
  1.  F  S PLIEN=$O(^BQICARE(DUZ,1,PLIEN)) Q:'PLIEN  D
  1.  . S DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1.  . S PLID=$$PLID^BQIUG1(DUZ,PLIEN)
  1.  . D GETDATA(DUZ,PLIEN)
  1.  . S BQII=BQII+1,@DATA@(BQII)=DUZ_PLDATA_$C(30)
  1.  G DONE
  1.  ;
  1. SHARED(DATA,FAKE) ;EP - BQI LIST OF SHARED PANELS OF A USER
  1.  ;Description
  1.  ;  Returns a list of panels shared by the user with another owner.
  1.  ;  
  1.  ;Input
  1.  ;  DUZ - User internal entry number
  1.  ;
  1.  ;Output
  1.  ;  ^TMP("BQIPLRT") - Name of global (passed by reference) in which the data is stored.
  1.  ;
  1.  ;Variables Used
  1.  ;  UID - Unique TMP global subscript.
  1.  ;
  1.  N UID,X,BQII,DA,OWNRNM,OWNRIEN,PLMSG,PLNME,PLIEN,IENS,PLDEFUPD,PLAUTO,PLLSTPOP,PLLSTUPD
  1.  N PLCNT,PLDESC,PLRTS,PLCRBY,PLDATA,PLID
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPLRT",UID))
  1.  K @DATA
  1.  ;
  1.  S BQII=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLRT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  D HDR
  1.  ;
  1.  I '$D(^BQICARE("C",DUZ)) G DONE
  1.  ;
  1.  S (OWNRIEN,PLIEN)=""
  1.  F  S OWNRIEN=$O(^BQICARE("C",DUZ,OWNRIEN)) Q:'OWNRIEN  D
  1.  . F  S PLIEN=$O(^BQICARE("C",DUZ,OWNRIEN,PLIEN)) Q:'PLIEN  D
  1.  .. S DA=PLIEN,DA(1)=OWNRIEN,IENS=$$IENS^DILF(.DA)
  1.  .. I $G(^BQICARE(OWNRIEN,1,PLIEN,0))="" Q
  1.  .. S OWNRNM=$$GET1^DIQ(90505,OWNRIEN,.01,"E")
  1.  .. S PLID=$$PLID^BQIUG1(OWNRIEN,PLIEN)
  1.  .. D GETDATA(OWNRIEN,PLIEN)
  1.  .. S BQII=BQII+1,@DATA@(BQII)=OWNRIEN_PLDATA_$C(30)
  1.  G DONE
  1.  ;
  1. HDR ;
  1.  NEW HDR
  1.  S HDR="I00010OWNER^T00035OWNER_NAME^I00010PANEL_IEN^T00015PANEL_ID^T00120PANEL_NAME^T00250PANEL_DESCRIPTION^"
  1.  S HDR=HDR_"T00003FLAGS^I00006TOTAL_PATIENTS^D00021DT_DEF_LAST_UPDATED^D00021DT_LAST_POPULATED^D00021DT_PATIENT_LIST_LAST_UPDATED^"
  1.  S HDR=HDR_"T00009AUTOPOPULATE_FLAG^T00035CREATED_BY^T00001STATUS^T00035DEF_LAST_UPDATED_BY^T00035PAT_LIST_UPDATED_BY^"
  1.  S HDR=HDR_"T00035LAST_POPULATED_BY^T00001AUTO_STATUS^T00001SOURCE_TYPE^T00003IPC_PANEL^T00030PANEL_CATEGORY^T00002SHARE_ACCESS"
  1.  S @DATA@(BQII)=HDR_$C(30)
  1.  Q
  1.  ;
  1. GETDATA(OWNR,PLIEN) ;EP
  1.  ;Parameters
  1.  ; PLNME    - Panel Name
  1.  ; PLDEFUPD - Date/time panel definition last updated
  1.  ; PLAUTO   - Autorefresh flag
  1.  ; PLLSTPOP - Date/time panel last populated
  1.  ; PLLSTUPD - Date/time patient list last updated
  1.  ; PLUPBY   - Definition last updated by
  1.  ; PLDFUPBY - Patient list last updated by
  1.  ; PLCRDT   - Date/time panel created
  1.  ; PLSTAT   - Status of panel while editing
  1.  ; PLCNT    - Number of patients in panel
  1.  ; PLDESC   - Panel description
  1.  ; PLRTS    - Panel contains patients with flags
  1.  ; PLCRBY   - Panel created by (owner)
  1.  ; AUTOSTAT - Autopopulate status
  1.  ; IPCPL    - IPC Panel flag
  1.  ; PCAT     - Panel Category
  1.  NEW BQITMP,PCAT,IPCPL
  1.  NEW PLNME,PLDEFUPD,PLAUTO,PLLSTPOP,PLLSTUPD,PLUPBY,PLDFUPBY,PLPOPBY,PLCRDT,PLSTAT,PLCNT
  1.  NEW PLDESC,PLRTS,PLCRBY,AUTOSTAT,SRCTYP
  1.  D GETS^DIQ(90505.01,IENS,".01;.02;.03;.04;.05;.06;.07;.08;.09;.1;.12;.13;1;2.1;2.2;3.4;3.5;3.6","IE","BQITMP")
  1.  S PLNME=$G(BQITMP(90505.01,IENS,.01,"E"))
  1.  S SRCTYP=$G(BQITMP(90505.01,IENS,.03,"I"))
  1.  S PLDEFUPD=$$FMTE^BQIUL1($G(BQITMP(90505.01,IENS,.05,"I")))
  1.  S PLAUTO=$G(BQITMP(90505.01,IENS,.06,"I"))
  1.  I $G(BQITMP(90505.01,IENS,.07,"I"))'="" S PLLSTPOP=$$FMTE^BQIUL1(BQITMP(90505.01,IENS,.07,"I"))
  1.  I $G(BQITMP(90505.01,IENS,.09,"I"))'="" S PLLSTUPD=$$FMTE^BQIUL1(BQITMP(90505.01,IENS,.09,"I"))
  1.  S PLUPBY=$G(BQITMP(90505.01,IENS,.04,"E"))
  1.  S PLDFUPBY=$G(BQITMP(90505.01,IENS,.08,"E"))
  1.  S PLPOPBY=$G(BQITMP(90505.01,IENS,3.5,"E"))
  1.  I $G(BQITMP(90505.01,IENS,.02,"I"))'="" S PLCRDT=$$FMTE^BQIUL1(BQITMP(90505.01,IENS,.02,"I"))
  1.  S PLSTAT=$G(BQITMP(90505.01,IENS,.13,"I"))
  1.  S PLCNT=$G(BQITMP(90505.01,IENS,.1,"E"))
  1.  I PLCNT="" S PLCNT=0
  1.  S PLDESC=$G(BQITMP(90505.01,IENS,1,"E"))
  1.  S PLRTS=$G(BQITMP(90505.01,IENS,.12,"E"))
  1.  ;
  1.  NEW DFN
  1.  S DFN=0,BQIFLAG=0
  1.  F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D  Q:BQIFLAG
  1.  . I $P(^BQICARE(OWNR,1,PLIEN,40,DFN,0),U,2)="R" Q
  1.  . S BQIFLAG=$$FPAT^BQIFLAG(DFN,DUZ,.BQIPREF)
  1.  S PLRTS=$S(BQIFLAG:"YES",1:"")
  1.  S PLCRBY=OWNRNM
  1.  S AUTOSTAT=$G(BQITMP(90505.01,IENS,3.4,"I"))
  1.  S IPCPL=$S($G(BQITMP(90505.01,IENS,2.1,"E"))="IPC Panel":"YES",1:"")
  1.  S PCAT=$$PCAT^BQIPLDF(OWNR,PLIEN)
  1.  S PLDATA="^"_OWNRNM_"^"_PLIEN_"^"_PLID_"^"_PLNME_"^"_PLDESC_"^"_PLRTS_"^"_PLCNT_"^"_PLDEFUPD_"^"
  1.  S PLDATA=PLDATA_$G(PLLSTPOP)_"^"_$G(PLLSTUPD)_"^"_PLAUTO_"^"_PLCRBY_"^"_PLSTAT_"^"_PLUPBY_"^"
  1.  S PLDATA=PLDATA_PLDFUPBY_"^"_PLPOPBY_"^"_AUTOSTAT_"^"_SRCTYP_"^"_IPCPL_"^"_PCAT_"^"
  1.  Q
  1.  ;
  1. DONE ;
  1.  S BQII=BQII+1,@DATA@(BQII)=$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(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1.  Q