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

BQIMUUSR.m

Go to the documentation of this file. 
  1. BQIMUUSR ;VNGT/HS/BEE-MU User Prefs ; 10 Aug 2011  10:52 AM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
  1.  ;
  1. RET(DATA,TYPE) ; EP -- BQI GET MU PREFS
  1.  ;Description
  1.  ;  Retrieve the MU Preferences for an owner
  1.  ;  
  1.  ;Input
  1.  ;  TYPE - Type to return (P-Providers, H-Hospitals, HCQ - Hospitals CQ, PCQ - Providers CQ,
  1.  ;                         ACD-CQ by Division, APD-Performance by Division)
  1.  ;                        (If no type, return all)
  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,PARMS,TYP
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMUUSR",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUUSR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="T00001TYPE^T03200PARMS"_$C(30)
  1.  ;
  1.  ;Return Individual type
  1.  S TYPE=$G(TYPE,"")
  1.  I TYPE]"" S TYPE(TYPE)=""
  1.  ;
  1.  ;Return All Types
  1.  I TYPE="" F TYPE="P","H","HCQ","PCQ","ACD","APD" S TYPE(TYPE)=""
  1.  ;
  1.  ;Create the records
  1.  S TYP="" F  S TYP=$O(TYPE(TYP)) Q:TYP=""  D
  1.  . NEW MIEN
  1.  . S PARMS=""
  1.  . S MIEN=$O(^BQICARE(DUZ,12,"B",TYP,""))
  1.  . ;
  1.  . ;No preferences on file for type - use default
  1.  . I MIEN="" D  Q
  1.  .. S PARMS=$$DCAT(PARMS)
  1.  .. S II=II+1,@DATA@(II)=TYP_"^"_PARMS_$C(30)
  1.  . ;
  1.  . ;Preferences defined - pull values
  1.  . I MIEN'="" D GET(TYP,MIEN)
  1.  ;
  1. DONE S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. GET(TYPE,MIEN) ;EP - Pull the individual definition
  1.  ;
  1.  NEW PIEN,PARMS
  1.  S PIEN=0,PARMS=""
  1.  F  S PIEN=$O(^BQICARE(DUZ,12,MIEN,1,PIEN)) Q:'PIEN  D
  1.  . NEW DA,IENS,NAME,VALUE
  1.  . S DA(2)=DUZ,DA(1)=MIEN,DA=PIEN,IENS=$$IENS^DILF(.DA)
  1.  . S NAME=$$GET1^DIQ(90505.022,IENS,.01,"E")
  1.  . ;
  1.  . ;Try pulling an individual value first
  1.  . S VALUE=$$GET1^DIQ(90505.022,IENS,.03,"E")
  1.  . I VALUE="" S VALUE=$$GET1^DIQ(90505.022,IENS,.02,"E")
  1.  . S PARMS=PARMS_$S(PARMS]"":$C(28),1:"")_NAME_"="
  1.  . I VALUE'="" S PARMS=PARMS_VALUE Q
  1.  . ;
  1.  . ;If no individual definition, check for multiple values
  1.  . NEW PMIEN,VALSTR
  1.  . S PMIEN=0,VALSTR=""
  1.  . F  S PMIEN=$O(^BQICARE(DUZ,12,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.  .. S VALUE=$$GET1^DIQ(90505.221,IENS,.02,"E")
  1.  .. I VALUE="" S VALUE=$$GET1^DIQ(90505.221,IENS,.01,"E")
  1.  .. S VALSTR=VALSTR_$S(VALSTR]"":$C(29),1:"")_VALUE
  1.  . ;
  1.  . ; Tack on Multiple Values
  1.  . S PARMS=PARMS_VALSTR
  1.  . K VALSTR
  1.  ;
  1.  S PARMS=$$DCAT(PARMS)  ;Add CAT values, if needed
  1.  ;
  1.  S II=II+1,@DATA@(II)=TYPE_"^"_PARMS_$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. UPD(DATA,TYPE,PARMS) ;  EP -- BQI SET MU PREFS
  1.  ;
  1.  ;Input
  1.  ;  TYPE - Type to return (P-Providers, H-Hospitals, HCQ - Hospitals CQ, PCQ - Providers CQ,
  1.  ;                         ACD-CQ by Division, APD-Performance by Division)
  1.  ;                        (If no type, return all)
  1.  ;  PARMS   - Parameters
  1.  ;Assumes
  1.  ;  DUZ - User who signed onto iCare
  1.  ;
  1.  NEW UID,II,TYPN,QFL,BQ,ERROR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMUUSR",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0,TYPE=$G(TYPE,"")
  1.  ;
  1.  I TYPE="" S BMXSEC="RPC Failed: No Type of Preferences passed in" Q
  1.  I TYPE'="P",TYPE'="H",TYPE'="HCQ",TYPE'="PCQ",TYPE'="ACD",TYPE'="APD" S BMXSEC="RPC Failed: Invalid Type of Preferences passed in" Q
  1.  ;
  1.  I $D(PARMS)>10 D
  1.  . NEW LIST,BN,QFL,BQ
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PARMS(BN)) Q:BN=""  D
  1.  .. S LIST=LIST_PARMS(BN)
  1.  . K PARMS S PARMS=LIST
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUUSR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010RESULT"_$C(30)
  1.  ;
  1.  S TYPN=$O(^BQICARE(DUZ,12,"B",TYPE,""))
  1.  ;
  1.  ;Clean out all the previous parameters
  1.  I TYPN'="" D DEL(TYPN)
  1.  ;
  1.  ;If no previous, add new entry
  1.  I TYPN="" D
  1.  . NEW DA,DIC,DLAYGO,X,Y
  1.  . S DA(1)=DUZ,X=TYPE
  1.  . S DIC(0)="XLNZ",DLAYGO=90505.012
  1.  . I $G(^BQICARE(DUZ,12,0))="" S ^BQICARE(DUZ,12,0)="^90505.012S^^"
  1.  . S DIC="^BQICARE("_DA(1)_",12,"
  1.  . D ^DIC S TYPN=+Y I TYPN=-1 K DO,DD D FILE^DICN S TYPN=+Y
  1.  ;
  1.  S QFL=0
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  G DONE:QFL
  1.  . ;
  1.  . N PDATA,NAME,VALUE,PDA,DA,IENS
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . D NPM(TYPN,NAME,.PDA) I QFL Q
  1.  . ;
  1.  . S DA(2)=DUZ,DA(1)=TYPN,DA=PDA
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . ;
  1.  . ;Single value
  1.  . I VALUE'[$C(29) D NRC(IENS,VALUE,.ERROR) Q
  1.  . ;
  1.  . ;Multiple values
  1.  . I VALUE[$C(29) D  Q:QFL
  1.  .. N BQII,MVAL
  1.  .. I '$D(^BQICARE(DA(2),12,DA(1),1,PDA,1,0)) S ^BQICARE(DA(2),12,DA(1),1,PDA,1,0)="^90505.221^^"
  1.  .. F BQII=1:1:$L(VALUE,$C(29)) D
  1.  ... S MVAL=$P(VALUE,$C(29),BQII)
  1.  ... D NML(TYPN,PDA,MVAL,.ERROR)
  1.  ;
  1.  S II=II+1
  1.  I $D(ERROR) S @DATA@(II)="-1"_$C(30)
  1.  E  S @DATA@(II)="1"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DEL(TYPN) ; EP - Delete the previous User preferences for the Type
  1.  ;
  1.  NEW DA,DIK
  1.  S DA(2)=DUZ,DA(1)=TYPN,DA=0,DIK="^BQICARE("_DA(2)_",12,"_DA(1)_",1,"
  1.  F  S DA=$O(^BQICARE(DUZ,12,TYPN,1,DA)) Q:'DA  D ^DIK
  1.  ;
  1.  Q
  1.  ;
  1. NPM(TYPN,NAME,PDA) ;EP - Add new parameter
  1.  NEW DA,IENS,DIC,DLAYGO,X,DLAYGO
  1.  S DA(2)=DUZ,DA(1)=TYPN,X=NAME,DIC="^BQICARE("_DA(2)_",12,"_DA(1)_",1,"
  1.  I '$D(^BQICARE(DA(2),12,DA(1),1,0)) S ^BQICARE(DA(2),12,DA(1),1,0)="^90505.022^^"
  1.  S DLAYGO=90505.022,DIC(0)="L",DIC("P")=DLAYGO
  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
  1.  Q
  1.  ;
  1. NRC(IENS,VALUE,ERROR) ;EP - New single record
  1.  N BQIUPD
  1.  I VALUE?.N S BQIUPD(90505.022,IENS,.03)=VALUE
  1.  I VALUE'?.N S BQIUPD(90505.022,IENS,.02)=VALUE
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  Q
  1.  ;
  1. NML(TYPN,PDA,MVAL,ERROR) ; EP - New multiple record
  1.  NEW DA,IENS,DLAYGO,DIC,Y,IENS,BQIUPD,ERROR
  1.  S DA(3)=DUZ,DA(2)=TYPN,DA(1)=PDA,X=MVAL
  1.  S DLAYGO=90505.221,DIC(0)="L",DIC("P")=DLAYGO
  1.  S DIC="^BQICARE("_DA(3)_",12,"_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.  S IENS=$$IENS^DILF(.DA)
  1.  I MVAL?.N S BQIUPD(90505.221,IENS,.02)=MVAL
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  Q
  1.  ;
  1. DCAT(PARMS) ; Set up default return list
  1.  ;
  1.  N IEN,VALUE
  1.  ;
  1.  S PARMS=$G(PARMS,"")
  1.  I PARMS]"" G XDCAT
  1.  ;
  1.  S PARMS="PREV=Y"_$C(28)_"MENUSET=Y"_$C(28)_"CORE=Y"_$C(28)_"ALT=N"
  1.  S PARMS=PARMS_$C(28)_"MSM=N"_$C(28)_"MEASURE=N"
  1.  I TYPE="P"!(TYPE="H")!(TYPE="APD") S PARMS=PARMS_$C(28)_"REPORT="_$$CURREP^BQIMUTAB()
  1.  ;
  1. XDCAT Q PARMS