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

BQIPLFLG.m

Go to the documentation of this file. 
  1. BQIPLFLG ;PRXM/HC/ALA-Get "Flags" Definition ; 09 Dec 2005  5:18 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  Q
  1.  ;
  1. RET(DATA,FAKE) ; EP - BQI GET FLAG PREFS
  1.  ;
  1.  ;Description
  1.  ;  Retrieve all the defined "flags" definitions for an owner
  1.  ;  
  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.  ;Assumes
  1.  ;  DUZ - User who signed onto iCare
  1.  ;
  1.  NEW UID,II,X,MIEN,SOURCE,PARMS,PIEN,NAME,PTYP,VALUE,PMIEN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPLFLG",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLFLG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="T00030SOURCE_NAME^T03200PARMS"_$C(30)
  1.  ;
  1.  S MIEN=0
  1.  F  S MIEN=$O(^BQICARE(DUZ,10,MIEN)) Q:'MIEN  D
  1.  . NEW DA,IENS
  1.  . S DA(1)=DUZ,DA=MIEN,IENS=$$IENS^DILF(.DA)
  1.  . S SOURCE=$$GET1^DIQ(90505.09,IENS,.01,"E")
  1.  . S II=II+1,@DATA@(II)=SOURCE
  1.  . S PIEN=0,PARMS=""
  1.  . F  S PIEN=$O(^BQICARE(DUZ,10,MIEN,1,PIEN)) Q:'PIEN  D
  1.  .. NEW DA,IENS
  1.  .. S DA(2)=DUZ,DA(1)=MIEN,DA=PIEN,IENS=$$IENS^DILF(.DA)
  1.  .. S NAME=$$GET1^DIQ(90505.1,IENS,.01,"E")
  1.  .. S PTYP=$$PTYP^BQIDCDF(SOURCE,NAME)
  1.  .. I PTYP="T" S VALUE=$$GET1^DIQ(90505.1,IENS,.03,"E")
  1.  .. I PTYP'="T" S VALUE=$$GET1^DIQ(90505.1,IENS,.02,"E")
  1.  .. ;  if the parameter type is a date, convert to non FileMan date format
  1.  .. I PTYP="D" S VALUE=$$FMTMDY^BQIUL1(VALUE)
  1.  .. S PARMS=PARMS_NAME_"="
  1.  .. ;
  1.  .. ;  Check for values
  1.  .. S PMIEN=0
  1.  .. F  S PMIEN=$O(^BQICARE(DUZ,10,MIEN,1,PIEN,1,PMIEN)) Q:'PMIEN  D
  1.  ... NEW DA,IENS
  1.  ... S DA(3)=DUZ,DA(2)=MIEN,DA(1)=PIEN,DA=PMIEN,IENS=$$IENS^DILF(.DA)
  1.  ... I PTYP="T" S VALUE=$$GET1^DIQ(90505.11,IENS,.02,"E")
  1.  ... I PTYP'="T" S VALUE=$$GET1^DIQ(90505.11,IENS,.01,"E")
  1.  ... ;  if the parameter type is a date, convert to non FileMan date format
  1.  ... I PTYP="D" S VALUE=$$FMTMDY^BQIUL1(VALUE)
  1.  ... S PARMS=PARMS_VALUE_$C(29)
  1.  .. ; Remove trailing $C(29)
  1.  .. S PARMS=$$TKO^BQIUL1(PARMS,$C(29))
  1.  .. S PARMS=PARMS_VALUE_$C(28)
  1.  . ; Remove trailing $C(28)
  1.  . S PARMS=$$TKO^BQIUL1(PARMS,$C(28))
  1.  . S $P(@DATA@(II),"^",2)=PARMS_$C(30)
  1.  ;
  1. DONE 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. UPD(DATA,SRCNM,PARMS) ;  EP - BQI SET FLAG PREFS
  1.  ;
  1.  ;Input
  1.  ;  SRCNM - Source Name of the flag
  1.  ;  PARMS - Parameters for the source
  1.  ;Assumes
  1.  ;  DUZ - User who signed onto iCare
  1.  ;
  1.  NEW UID,II,X,MIEN,PIEN,PMIEN,VALUE,PDATA,ALDA,QFL,BQ,NAME,MVAL,BQII,PPIEN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPLFLG",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0,PARMS=$G(PARMS,"")
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLFLG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S PPIEN=$$PP^BQIDCDF(SRCNM) I PPIEN=-1 S BMXSEC="Source not found." Q
  1.  S @DATA@(II)="I00010RESULT"_$C(30)
  1.  ;
  1.  NEW DA,DIC,DLAYGO
  1.  S DA(1)=DUZ,X=SRCNM
  1.  S DLAYGO=90505.09,DIC(0)="LNXZ"
  1.  S DIC="^BQICARE("_DA(1)_",10,"
  1.  I '$D(^BQICARE(DA(1),10,0)) S ^BQICARE(DA(1),10,0)="^90505.09P^^"
  1.  ;K DO,DD D FILE^DICN
  1.  D ^DIC
  1.  S ALDA=+Y
  1.  I ALDA=-1 S II=II+1,@DATA@(II)="-1"_$C(30) G DONE
  1.  ;
  1.  ;  Clean out all the previous parameters
  1.  NEW DA,DIK,PN,PDA
  1.  S DA(2)=DUZ,DA(1)=ALDA,DIK="^BQICARE("_DA(2)_",10,"_DA(1)_",1,",PN=0
  1.  F  S PN=$O(^BQICARE(DA(2),10,DA(1),1,PN)) Q:'PN  S DA=PN D ^DIK
  1.  ;
  1.  S QFL=0
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  G DONE:QFL
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . S PTYP=$$PTYP^BQIDCDF(SRCNM,NAME)
  1.  . NEW DA,IENS,DIC
  1.  . S DA(2)=DUZ,DA(1)=ALDA,X=NAME
  1.  . S DLAYGO=90505.1,DIC(0)="L",DIC("P")=DLAYGO
  1.  . S DIC="^BQICARE("_DA(2)_",10,"_DA(1)_",1,"
  1.  . I '$D(^BQICARE(DA(2),10,DA(1),1,0)) S ^BQICARE(DA(2),10,DA(1),1,0)="^90505.1^^"
  1.  . K DO,DD D FILE^DICN
  1.  . S (DA,PDA)=+Y
  1.  . I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1 Q
  1.  . ;
  1.  . NEW DA,IENS
  1.  . S DA(2)=DUZ,DA(1)=ALDA,DA=PDA
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . I VALUE'[$C(29) D  Q
  1.  .. ;  if the parameter type is a date, convert to FileMan date format
  1.  .. I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
  1.  .. I PTYP="T" S BQIUPD(90505.1,IENS,.03)=VALUE
  1.  .. I PTYP'="T" S BQIUPD(90505.1,IENS,.02)=VALUE
  1.  .. D FILE^DIE("","BQIUPD","ERROR")
  1.  .. K BQIUPD
  1.  . ;
  1.  . I VALUE[$C(29) D  Q:QFL
  1.  .. I '$D(^BQICARE(DA(2),10,DA(1),1,DA,1,0)) S ^BQICARE(DA(2),10,DA(1),1,DA,1,0)="^90505.11^^"
  1.  .. F BQII=1:1:$L(VALUE,$C(29)) D
  1.  ... S MVAL=$P(VALUE,$C(29),BQII)
  1.  ... NEW DA,IENS
  1.  ... S DA(3)=DUZ,DA(2)=ALDA,DA(1)=PDA,X=MVAL
  1.  ... S DLAYGO=90505.11,DIC(0)="L",DIC("P")=DLAYGO
  1.  ... S DIC="^BQICARE("_DA(3)_",10,"_DA(2)_",1,"_DA(1)_",1,"
  1.  ... K DO,DD D FILE^DICN
  1.  ... S DA=+Y
  1.  ... I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1 Q
  1.  ... ;  if the parameter type is a date, convert to FileMan date format
  1.  ... I PTYP="D" S MVAL=$$DATE^BQIUL1(MVAL)
  1.  ... S IENS=$$IENS^DILF(.DA)
  1.  ... I PTYP="T" S BQIUPD(90505.11,IENS,.02)=MVAL
  1.  ... D FILE^DIE("","BQIUPD","ERROR")
  1.  ... K BQIUPD
  1.  ;
  1.  S II=II+1,@DATA@(II)="1"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DELA(DATA) ;  Delete all flag definitions
  1.  NEW UID,II,DA,DIK
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPLFLG",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLFLG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT"_$C(30)
  1.  S DA(1)=DUZ,DA=0,DIK="^BQICARE("_DA(1)_",10,"
  1.  F  S DA=$O(^BQICARE(DUZ,10,DA)) Q:'DA  D ^DIK
  1.  S II=II+1,@DATA@(II)="1"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DEL ;  Delete the previous flag definitions
  1.  NEW DA,DIK
  1.  S DA(1)=DUZ,DA=0,DIK="^BQICARE("_DA(1)_",10,"
  1.  F  S DA=$O(^BQICARE(DUZ,10,DA)) Q:'DA  D ^DIK
  1.  Q
  1.  ;
  1. GPARMS(USR,ADSC,PARMS,MPARMS) ;EP - Get parameters for a user's flag preference
  1.  ;
  1.  ;Input
  1.  ;  USR  = User/Owner internal entry number
  1.  ;  ADSC = Flag description
  1.  ;
  1.  NEW DA,IENS,DIC,AIEN,SOURCE,PIEN,PTYP,VALUE,PMIEN
  1.  S DA(1)=USR,X=ADSC,DIC(0)="XZ",DIC="^BQICARE("_DA(1)_",10,"
  1.  D ^DIC
  1.  I +Y<1 Q
  1.  S (DA,AIEN)=+Y,IENS=$$IENS^DILF(.DA)
  1.  S SOURCE=$$GET1^DIQ(90505.09,IENS,.01,"E")
  1.  S PIEN=0,PARMS=""
  1.  F  S PIEN=$O(^BQICARE(USR,10,AIEN,1,PIEN)) Q:'PIEN  D
  1.  . NEW DA,IENS
  1.  . S DA(2)=USR,DA(1)=AIEN,DA=PIEN,IENS=$$IENS^DILF(.DA)
  1.  . S NAME=$$GET1^DIQ(90505.1,IENS,.01,"E")
  1.  . S PTYP=$$PTYP^BQIDCDF(SOURCE,NAME)
  1.  . ;  if the parameter type is a table, use the pointer (IEN) value
  1.  . I PTYP="T" S VALUE=$$GET1^DIQ(90505.1,IENS,.03,"E")
  1.  . ;  if the parameter type is not a table, use the free text value
  1.  . I PTYP'="T" S VALUE=$$GET1^DIQ(90505.1,IENS,.02,"E")
  1.  . ;  if the parameter type is a date, convert to FileMan date format
  1.  . I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . S PARMS(NAME)=VALUE
  1.  . ;
  1.  . ;  Check for values
  1.  . S PMIEN=0
  1.  . F  S PMIEN=$O(^BQICARE(USR,10,AIEN,1,PIEN,1,PMIEN)) Q:'PMIEN  D
  1.  .. NEW DA,IENS
  1.  .. S DA(3)=USR,DA(2)=AIEN,DA(1)=PIEN,DA=PMIEN,IENS=$$IENS^DILF(.DA)
  1.  .. ;
  1.  .. ;  if the parameter type is a table, use the pointer (IEN) value
  1.  .. I PTYP="T" S VALUE=$$GET1^DIQ(90505.11,IENS,.02,"E")
  1.  .. ;  if the parameter type is not a table, use the free text value
  1.  .. I PTYP'="T" S VALUE=$$GET1^DIQ(90505.11,IENS,.01,"E")
  1.  .. S MPARMS(NAME,VALUE)=""
  1.  Q