BQIMUUSR ;VNGT/HS/BEE-MU User Prefs ; 10 Aug 2011 10:52 AM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
RET(DATA,TYPE) ; EP -- BQI GET MU PREFS
;Description
; Retrieve the MU Preferences for an owner
;
;Input
; TYPE - Type to return (P-Providers, H-Hospitals, HCQ - Hospitals CQ, PCQ - Providers CQ,
; ACD-CQ by Division, APD-Performance by Division)
; (If no type, return all)
;Output
; DATA - name of global (passed by reference) in which the data
; is stored
;Assumes
; DUZ - User who signed onto iCare
;
NEW UID,II,PARMS,TYP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMUUSR",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUUSR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00001TYPE^T03200PARMS"_$C(30)
;
;Return Individual type
S TYPE=$G(TYPE,"")
I TYPE]"" S TYPE(TYPE)=""
;
;Return All Types
I TYPE="" F TYPE="P","H","HCQ","PCQ","ACD","APD" S TYPE(TYPE)=""
;
;Create the records
S TYP="" F S TYP=$O(TYPE(TYP)) Q:TYP="" D
. NEW MIEN
. S PARMS=""
. S MIEN=$O(^BQICARE(DUZ,12,"B",TYP,""))
. ;
. ;No preferences on file for type - use default
. I MIEN="" D Q
.. S PARMS=$$DCAT(PARMS)
.. S II=II+1,@DATA@(II)=TYP_"^"_PARMS_$C(30)
. ;
. ;Preferences defined - pull values
. I MIEN'="" D GET(TYP,MIEN)
;
DONE S II=II+1,@DATA@(II)=$C(31)
Q
;
GET(TYPE,MIEN) ;EP - Pull the individual definition
;
NEW PIEN,PARMS
S PIEN=0,PARMS=""
F S PIEN=$O(^BQICARE(DUZ,12,MIEN,1,PIEN)) Q:'PIEN D
. NEW DA,IENS,NAME,VALUE
. S DA(2)=DUZ,DA(1)=MIEN,DA=PIEN,IENS=$$IENS^DILF(.DA)
. S NAME=$$GET1^DIQ(90505.022,IENS,.01,"E")
. ;
. ;Try pulling an individual value first
. S VALUE=$$GET1^DIQ(90505.022,IENS,.03,"E")
. I VALUE="" S VALUE=$$GET1^DIQ(90505.022,IENS,.02,"E")
. S PARMS=PARMS_$S(PARMS]"":$C(28),1:"")_NAME_"="
. I VALUE'="" S PARMS=PARMS_VALUE Q
. ;
. ;If no individual definition, check for multiple values
. NEW PMIEN,VALSTR
. S PMIEN=0,VALSTR=""
. F S PMIEN=$O(^BQICARE(DUZ,12,MIEN,1,PIEN,1,PMIEN)) Q:'PMIEN D
.. NEW DA,IENS
.. S DA(3)=DUZ,DA(2)=MIEN,DA(1)=PIEN,DA=PMIEN,IENS=$$IENS^DILF(.DA)
.. S VALUE=$$GET1^DIQ(90505.221,IENS,.02,"E")
.. I VALUE="" S VALUE=$$GET1^DIQ(90505.221,IENS,.01,"E")
.. S VALSTR=VALSTR_$S(VALSTR]"":$C(29),1:"")_VALUE
. ;
. ; Tack on Multiple Values
. S PARMS=PARMS_VALSTR
. K VALSTR
;
S PARMS=$$DCAT(PARMS) ;Add CAT values, if needed
;
S II=II+1,@DATA@(II)=TYPE_"^"_PARMS_$C(30)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
UPD(DATA,TYPE,PARMS) ; EP -- BQI SET MU PREFS
;
;Input
; TYPE - Type to return (P-Providers, H-Hospitals, HCQ - Hospitals CQ, PCQ - Providers CQ,
; ACD-CQ by Division, APD-Performance by Division)
; (If no type, return all)
; PARMS - Parameters
;Assumes
; DUZ - User who signed onto iCare
;
NEW UID,II,TYPN,QFL,BQ,ERROR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMUUSR",UID))
K @DATA
;
S II=0,TYPE=$G(TYPE,"")
;
I TYPE="" S BMXSEC="RPC Failed: No Type of Preferences passed in" Q
I TYPE'="P",TYPE'="H",TYPE'="HCQ",TYPE'="PCQ",TYPE'="ACD",TYPE'="APD" S BMXSEC="RPC Failed: Invalid Type of Preferences passed in" Q
;
I $D(PARMS)>10 D
. NEW LIST,BN,QFL,BQ
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" D
.. S LIST=LIST_PARMS(BN)
. K PARMS S PARMS=LIST
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUUSR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010RESULT"_$C(30)
;
S TYPN=$O(^BQICARE(DUZ,12,"B",TYPE,""))
;
;Clean out all the previous parameters
I TYPN'="" D DEL(TYPN)
;
;If no previous, add new entry
I TYPN="" D
. NEW DA,DIC,DLAYGO,X,Y
. S DA(1)=DUZ,X=TYPE
. S DIC(0)="XLNZ",DLAYGO=90505.012
. I $G(^BQICARE(DUZ,12,0))="" S ^BQICARE(DUZ,12,0)="^90505.012S^^"
. S DIC="^BQICARE("_DA(1)_",12,"
. D ^DIC S TYPN=+Y I TYPN=-1 K DO,DD D FILE^DICN S TYPN=+Y
;
S QFL=0
F BQ=1:1:$L(PARMS,$C(28)) D G DONE:QFL
. ;
. N PDATA,NAME,VALUE,PDA,DA,IENS
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
. D NPM(TYPN,NAME,.PDA) I QFL Q
. ;
. S DA(2)=DUZ,DA(1)=TYPN,DA=PDA
. S IENS=$$IENS^DILF(.DA)
. ;
. ;Single value
. I VALUE'[$C(29) D NRC(IENS,VALUE,.ERROR) Q
. ;
. ;Multiple values
. I VALUE[$C(29) D Q:QFL
.. N BQII,MVAL
.. 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^^"
.. F BQII=1:1:$L(VALUE,$C(29)) D
... S MVAL=$P(VALUE,$C(29),BQII)
... D NML(TYPN,PDA,MVAL,.ERROR)
;
S II=II+1
I $D(ERROR) S @DATA@(II)="-1"_$C(30)
E S @DATA@(II)="1"_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
DEL(TYPN) ; EP - Delete the previous User preferences for the Type
;
NEW DA,DIK
S DA(2)=DUZ,DA(1)=TYPN,DA=0,DIK="^BQICARE("_DA(2)_",12,"_DA(1)_",1,"
F S DA=$O(^BQICARE(DUZ,12,TYPN,1,DA)) Q:'DA D ^DIK
;
Q
;
NPM(TYPN,NAME,PDA) ;EP - Add new parameter
NEW DA,IENS,DIC,DLAYGO,X,DLAYGO
S DA(2)=DUZ,DA(1)=TYPN,X=NAME,DIC="^BQICARE("_DA(2)_",12,"_DA(1)_",1,"
I '$D(^BQICARE(DA(2),12,DA(1),1,0)) S ^BQICARE(DA(2),12,DA(1),1,0)="^90505.022^^"
S DLAYGO=90505.022,DIC(0)="L",DIC("P")=DLAYGO
K DO,DD D FILE^DICN
S (DA,PDA)=+Y
I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1
Q
;
NRC(IENS,VALUE,ERROR) ;EP - New single record
N BQIUPD
I VALUE?.N S BQIUPD(90505.022,IENS,.03)=VALUE
I VALUE'?.N S BQIUPD(90505.022,IENS,.02)=VALUE
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
Q
;
NML(TYPN,PDA,MVAL,ERROR) ; EP - New multiple record
NEW DA,IENS,DLAYGO,DIC,Y,IENS,BQIUPD,ERROR
S DA(3)=DUZ,DA(2)=TYPN,DA(1)=PDA,X=MVAL
S DLAYGO=90505.221,DIC(0)="L",DIC("P")=DLAYGO
S DIC="^BQICARE("_DA(3)_",12,"_DA(2)_",1,"_DA(1)_",1,"
K DO,DD D FILE^DICN
S DA=+Y
I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1 Q
S IENS=$$IENS^DILF(.DA)
I MVAL?.N S BQIUPD(90505.221,IENS,.02)=MVAL
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
Q
;
DCAT(PARMS) ; Set up default return list
;
N IEN,VALUE
;
S PARMS=$G(PARMS,"")
I PARMS]"" G XDCAT
;
S PARMS="PREV=Y"_$C(28)_"MENUSET=Y"_$C(28)_"CORE=Y"_$C(28)_"ALT=N"
S PARMS=PARMS_$C(28)_"MSM=N"_$C(28)_"MEASURE=N"
I TYPE="P"!(TYPE="H")!(TYPE="APD") S PARMS=PARMS_$C(28)_"REPORT="_$$CURREP^BQIMUTAB()
;
XDCAT Q PARMS
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
+2 ;
RET(DATA,TYPE) ; EP -- BQI GET MU PREFS
+1 ;Description
+2 ; Retrieve the MU Preferences for an owner
+3 ;
+4 ;Input
+5 ; TYPE - Type to return (P-Providers, H-Hospitals, HCQ - Hospitals CQ, PCQ - Providers CQ,
+6 ; ACD-CQ by Division, APD-Performance by Division)
+7 ; (If no type, return all)
+8 ;Output
+9 ; DATA - name of global (passed by reference) in which the data
+10 ; is stored
+11 ;Assumes
+12 ; DUZ - User who signed onto iCare
+13 ;
+14 NEW UID,II,PARMS,TYP
+15 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+16 SET DATA=$NAME(^TMP("BQIMUUSR",UID))
+17 KILL @DATA
+18 ;
+19 SET II=0
+20 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMUUSR D UNWIND^%ZTER"
+21 ;
+22 SET @DATA@(II)="T00001TYPE^T03200PARMS"_$CHAR(30)
+23 ;
+24 ;Return Individual type
+25 SET TYPE=$GET(TYPE,"")
+26 IF TYPE]""
SET TYPE(TYPE)=""
+27 ;
+28 ;Return All Types
+29 IF TYPE=""
FOR TYPE="P","H","HCQ","PCQ","ACD","APD"
SET TYPE(TYPE)=""
+30 ;
+31 ;Create the records
+32 SET TYP=""
FOR
SET TYP=$ORDER(TYPE(TYP))
IF TYP=""
QUIT
Begin DoDot:1
+33 NEW MIEN
+34 SET PARMS=""
+35 SET MIEN=$ORDER(^BQICARE(DUZ,12,"B",TYP,""))
+36 ;
+37 ;No preferences on file for type - use default
+38 IF MIEN=""
Begin DoDot:2
+39 SET PARMS=$$DCAT(PARMS)
+40 SET II=II+1
SET @DATA@(II)=TYP_"^"_PARMS_$CHAR(30)
End DoDot:2
QUIT
+41 ;
+42 ;Preferences defined - pull values
+43 IF MIEN'=""
DO GET(TYP,MIEN)
End DoDot:1
+44 ;
DONE SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
GET(TYPE,MIEN) ;EP - Pull the individual definition
+1 ;
+2 NEW PIEN,PARMS
+3 SET PIEN=0
SET PARMS=""
+4 FOR
SET PIEN=$ORDER(^BQICARE(DUZ,12,MIEN,1,PIEN))
IF 'PIEN
QUIT
Begin DoDot:1
+5 NEW DA,IENS,NAME,VALUE
+6 SET DA(2)=DUZ
SET DA(1)=MIEN
SET DA=PIEN
SET IENS=$$IENS^DILF(.DA)
+7 SET NAME=$$GET1^DIQ(90505.022,IENS,.01,"E")
+8 ;
+9 ;Try pulling an individual value first
+10 SET VALUE=$$GET1^DIQ(90505.022,IENS,.03,"E")
+11 IF VALUE=""
SET VALUE=$$GET1^DIQ(90505.022,IENS,.02,"E")
+12 SET PARMS=PARMS_$SELECT(PARMS]"":$CHAR(28),1:"")_NAME_"="
+13 IF VALUE'=""
SET PARMS=PARMS_VALUE
QUIT
+14 ;
+15 ;If no individual definition, check for multiple values
+16 NEW PMIEN,VALSTR
+17 SET PMIEN=0
SET VALSTR=""
+18 FOR
SET PMIEN=$ORDER(^BQICARE(DUZ,12,MIEN,1,PIEN,1,PMIEN))
IF 'PMIEN
QUIT
Begin DoDot:2
+19 NEW DA,IENS
+20 SET DA(3)=DUZ
SET DA(2)=MIEN
SET DA(1)=PIEN
SET DA=PMIEN
SET IENS=$$IENS^DILF(.DA)
+21 SET VALUE=$$GET1^DIQ(90505.221,IENS,.02,"E")
+22 IF VALUE=""
SET VALUE=$$GET1^DIQ(90505.221,IENS,.01,"E")
+23 SET VALSTR=VALSTR_$SELECT(VALSTR]"":$CHAR(29),1:"")_VALUE
End DoDot:2
+24 ;
+25 ; Tack on Multiple Values
+26 SET PARMS=PARMS_VALSTR
+27 KILL VALSTR
End DoDot:1
+28 ;
+29 ;Add CAT values, if needed
SET PARMS=$$DCAT(PARMS)
+30 ;
+31 SET II=II+1
SET @DATA@(II)=TYPE_"^"_PARMS_$CHAR(30)
+32 QUIT
+33 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
UPD(DATA,TYPE,PARMS) ; EP -- BQI SET MU PREFS
+1 ;
+2 ;Input
+3 ; TYPE - Type to return (P-Providers, H-Hospitals, HCQ - Hospitals CQ, PCQ - Providers CQ,
+4 ; ACD-CQ by Division, APD-Performance by Division)
+5 ; (If no type, return all)
+6 ; PARMS - Parameters
+7 ;Assumes
+8 ; DUZ - User who signed onto iCare
+9 ;
+10 NEW UID,II,TYPN,QFL,BQ,ERROR
+11 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+12 SET DATA=$NAME(^TMP("BQIMUUSR",UID))
+13 KILL @DATA
+14 ;
+15 SET II=0
SET TYPE=$GET(TYPE,"")
+16 ;
+17 IF TYPE=""
SET BMXSEC="RPC Failed: No Type of Preferences passed in"
QUIT
+18 IF TYPE'="P"
IF TYPE'="H"
IF TYPE'="HCQ"
IF TYPE'="PCQ"
IF TYPE'="ACD"
IF TYPE'="APD"
SET BMXSEC="RPC Failed: Invalid Type of Preferences passed in"
QUIT
+19 ;
+20 IF $DATA(PARMS)>10
Begin DoDot:1
+21 NEW LIST,BN,QFL,BQ
+22 SET LIST=""
SET BN=""
+23 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
Begin DoDot:2
+24 SET LIST=LIST_PARMS(BN)
End DoDot:2
+25 KILL PARMS
SET PARMS=LIST
End DoDot:1
+26 ;
+27 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMUUSR D UNWIND^%ZTER"
+28 ;
+29 SET @DATA@(II)="I00010RESULT"_$CHAR(30)
+30 ;
+31 SET TYPN=$ORDER(^BQICARE(DUZ,12,"B",TYPE,""))
+32 ;
+33 ;Clean out all the previous parameters
+34 IF TYPN'=""
DO DEL(TYPN)
+35 ;
+36 ;If no previous, add new entry
+37 IF TYPN=""
Begin DoDot:1
+38 NEW DA,DIC,DLAYGO,X,Y
+39 SET DA(1)=DUZ
SET X=TYPE
+40 SET DIC(0)="XLNZ"
SET DLAYGO=90505.012
+41 IF $GET(^BQICARE(DUZ,12,0))=""
SET ^BQICARE(DUZ,12,0)="^90505.012S^^"
+42 SET DIC="^BQICARE("_DA(1)_",12,"
+43 DO ^DIC
SET TYPN=+Y
IF TYPN=-1
KILL DO,DD
DO FILE^DICN
SET TYPN=+Y
End DoDot:1
+44 ;
+45 SET QFL=0
+46 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+47 ;
+48 NEW PDATA,NAME,VALUE,PDA,DA,IENS
+49 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+50 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+51 DO NPM(TYPN,NAME,.PDA)
IF QFL
QUIT
+52 ;
+53 SET DA(2)=DUZ
SET DA(1)=TYPN
SET DA=PDA
+54 SET IENS=$$IENS^DILF(.DA)
+55 ;
+56 ;Single value
+57 IF VALUE'[$CHAR(29)
DO NRC(IENS,VALUE,.ERROR)
QUIT
+58 ;
+59 ;Multiple values
+60 IF VALUE[$CHAR(29)
Begin DoDot:2
+61 NEW BQII,MVAL
+62 IF '$DATA(^BQICARE(DA(2),12,DA(1),1,PDA,1,0))
SET ^BQICARE(DA(2),12,DA(1),1,PDA,1,0)="^90505.221^^"
+63 FOR BQII=1:1:$LENGTH(VALUE,$CHAR(29))
Begin DoDot:3
+64 SET MVAL=$PIECE(VALUE,$CHAR(29),BQII)
+65 DO NML(TYPN,PDA,MVAL,.ERROR)
End DoDot:3
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
GOTO DONE
+66 ;
+67 SET II=II+1
+68 IF $DATA(ERROR)
SET @DATA@(II)="-1"_$CHAR(30)
+69 IF '$TEST
SET @DATA@(II)="1"_$CHAR(30)
+70 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+71 QUIT
+72 ;
DEL(TYPN) ; EP - Delete the previous User preferences for the Type
+1 ;
+2 NEW DA,DIK
+3 SET DA(2)=DUZ
SET DA(1)=TYPN
SET DA=0
SET DIK="^BQICARE("_DA(2)_",12,"_DA(1)_",1,"
+4 FOR
SET DA=$ORDER(^BQICARE(DUZ,12,TYPN,1,DA))
IF 'DA
QUIT
DO ^DIK
+5 ;
+6 QUIT
+7 ;
NPM(TYPN,NAME,PDA) ;EP - Add new parameter
+1 NEW DA,IENS,DIC,DLAYGO,X,DLAYGO
+2 SET DA(2)=DUZ
SET DA(1)=TYPN
SET X=NAME
SET DIC="^BQICARE("_DA(2)_",12,"_DA(1)_",1,"
+3 IF '$DATA(^BQICARE(DA(2),12,DA(1),1,0))
SET ^BQICARE(DA(2),12,DA(1),1,0)="^90505.022^^"
+4 SET DLAYGO=90505.022
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+5 KILL DO,DD
DO FILE^DICN
+6 SET (DA,PDA)=+Y
+7 IF DA=-1
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
SET QFL=1
+8 QUIT
+9 ;
NRC(IENS,VALUE,ERROR) ;EP - New single record
+1 NEW BQIUPD
+2 IF VALUE?.N
SET BQIUPD(90505.022,IENS,.03)=VALUE
+3 IF VALUE'?.N
SET BQIUPD(90505.022,IENS,.02)=VALUE
+4 DO FILE^DIE("","BQIUPD","ERROR")
+5 KILL BQIUPD
+6 QUIT
+7 ;
NML(TYPN,PDA,MVAL,ERROR) ; EP - New multiple record
+1 NEW DA,IENS,DLAYGO,DIC,Y,IENS,BQIUPD,ERROR
+2 SET DA(3)=DUZ
SET DA(2)=TYPN
SET DA(1)=PDA
SET X=MVAL
+3 SET DLAYGO=90505.221
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+4 SET DIC="^BQICARE("_DA(3)_",12,"_DA(2)_",1,"_DA(1)_",1,"
+5 KILL DO,DD
DO FILE^DICN
+6 SET DA=+Y
+7 IF DA=-1
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
SET QFL=1
QUIT
+8 SET IENS=$$IENS^DILF(.DA)
+9 IF MVAL?.N
SET BQIUPD(90505.221,IENS,.02)=MVAL
+10 DO FILE^DIE("","BQIUPD","ERROR")
+11 KILL BQIUPD
+12 QUIT
+13 ;
DCAT(PARMS) ; Set up default return list
+1 ;
+2 NEW IEN,VALUE
+3 ;
+4 SET PARMS=$GET(PARMS,"")
+5 IF PARMS]""
GOTO XDCAT
+6 ;
+7 SET PARMS="PREV=Y"_$CHAR(28)_"MENUSET=Y"_$CHAR(28)_"CORE=Y"_$CHAR(28)_"ALT=N"
+8 SET PARMS=PARMS_$CHAR(28)_"MSM=N"_$CHAR(28)_"MEASURE=N"
+9 IF TYPE="P"!(TYPE="H")!(TYPE="APD")
SET PARMS=PARMS_$CHAR(28)_"REPORT="_$$CURREP^BQIMUTAB()
+10 ;
XDCAT QUIT PARMS
