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

BQIUSPRF.m

Go to the documentation of this file. 
  1. BQIUSPRF ;GDHD/HS/ALA-User GUI Preferences ; 26 Sep 2007  1:53 PM
  1.  ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
  1.  ;
  1.  Q
  1.  ;
  1. GTAB(DATA,FAKE) ;EP - BQI GET USER GUI TABS
  1.  ;
  1.  ;Description
  1.  ;  Get the user's preferences
  1.  ;Input
  1.  ;  FAKE - extra 'blank' parameter required by BMXNET async 'feature'
  1.  ;Output
  1.  ;  DATA  - name of global (passed by reference) in which the data
  1.  ;          is stored
  1.  ;Expects
  1.  ;  DUZ - the internal entry number of the person signed on
  1.  NEW UID,II,IEN,TEXT,BN,TYP
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIGTAB",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUSPRF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010IEN^T00001STATUS^T00010TYPE"_$C(30)
  1.  I $O(^BQICARE(DUZ,13,0))="" D DEF G DONE
  1.  S BN=0
  1.  F  S BN=$O(^BQICARE(DUZ,13,BN)) Q:'BN  D
  1.  . S IEN=$P(^BQICARE(DUZ,13,BN,0),U,1)
  1.  . ;S TEXT=$P(^BQI(90506.4,IEN,0),U,1),STAT=$P(^(0),U,2)
  1.  . S STAT=$P(^BQICARE(DUZ,13,BN,0),U,2)
  1.  . S TYP=$$GET1^DIQ(90506.4,IEN_",",.03,"E")
  1.  . S II=II+1,@DATA@(II)=IEN_U_STAT_U_TYP_$C(30)
  1.  ;
  1.  ;Check for new tabs
  1.  S IEN=0 F  S IEN=$O(^BQI(90506.4,IEN)) Q:'IEN  D
  1.  . I '$D(^BQICARE(DUZ,13,"B",IEN)) D
  1.  .. S TYP=$$GET1^DIQ(90506.4,IEN_",",.03,"E")
  1.  .. S II=II+1,@DATA@(II)=IEN_U_"S"_U_TYP_$C(30)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DEF ;
  1.  S IEN=0
  1.  F  S IEN=$O(^BQI(90506.4,IEN)) Q:'IEN  D
  1.  . S TEXT=$P(^BQI(90506.4,IEN,0),U,1),DEF=""
  1.  . ;I TEXT="Cover Sheet"!(TEXT="Patient List") S DEF="D"
  1.  . S TYP=$$GET1^DIQ(90506.4,IEN_",",.03,"E")
  1.  . S II=II+1,@DATA@(II)=IEN_U_"S"_U_TYP_$C(30)
  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. UTAB(DATA,TYP,TABS) ;EP - BQI SET USER GUI TABS
  1.  ; Input
  1.  ;   Assumes DUZ
  1.  ;   TABS - list of tab IENs separated by $C(29)
  1.  NEW UID,II,ERROR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIUTAB",UID))
  1.  K @DATA
  1.  S II=0
  1.  S @DATA@(II)="I00010RESULT"_$C(30)
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIUSPRF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S ^ALTST($$NOW^XLFDT())=$G(TABS)
  1.  ; Clean up previous list of GUI tabs
  1.  NEW DA,DIK,TBS
  1.  S DA(1)=DUZ,DIK="^BQICARE("_DA(1)_",13,",DA=""
  1.  F  S DA=$O(^BQICARE(DUZ,13,"AC",TYP,DA)) Q:'DA  D ^DIK
  1.  ;
  1.  F BI=1:1:$L(TABS,$C(29)) S TBS=$P(TABS,$C(29),BI) Q:TBS=""  D
  1.  . NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS
  1.  . ;Get IEN and Status
  1.  . S TIEN=$P(TBS,$C(28),1),STAT=$P(TBS,$C(28),2)
  1.  . S DA(1)=DUZ
  1.  . S DIC="^BQICARE("_DA(1)_",13,",DIE=DIC
  1.  . S DLAYGO=90505.013,DIC(0)="L",DIC("P")=DLAYGO
  1.  . S X=TIEN
  1.  . I '$D(^BQICARE(DA(1),13,0)) S ^BQICARE(DA(1),13,0)="^90505.013P^^"
  1.  . ;K DO,DD D ^DIC
  1.  . D ^DIC i Y=-1 K DO,DD D FILE^DICN
  1.  . I +Y<1 S RESULT=-1 Q
  1.  . S DA=+Y,IENS=$$IENS^DILF(.DA)
  1.  . S BQIUPD(90505.013,IENS,.02)=STAT,BQIUPD(90505.013,IENS,.03)=TYP
  1.  . S RESULT=1
  1.  ;
  1.  I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR") I $D(ERROR) S RESULT=-1
  1.  ;
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q