BQIIPTVW ;VNGT/HS/ALA-IPC Tabs View ; 10 Aug 2011 10:52 AM
;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
;
;
RET(DATA,TYPE) ; EP -- BQI GET IPC PREFS
;Description
; Retrieve the IPC Preferences for an owner
;
;Input
; TYPE (Optional) - (PD-Patient Detail/DP-Provider Detail)
;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,MIEN,DZ
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIIPTVW",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPTVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T00001TYPE^T03200PARMS"_$C(30)
;
S TYPE=$G(TYPE,""),DZ=DUZ
;
;Return Patient Detail
;
S MIEN=0,PARMS=""
I TYPE=""!(TYPE="PD") D
. S TYP="PD"
. S MIEN=$O(^BQICARE(DZ,8,"B",TYP,""))
. ;No preferences on file - 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)
;
;Return Provider Detail
;
S MIEN=0,PARMS=""
I TYPE=""!(TYPE="DP") D
. S TYP="DP"
. S MIEN=$O(^BQICARE(DZ,8,"B",TYP,""))
. ;No preferences on file - 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)
;
;Return Team Aggregated
S MIEN=0,PARMS=""
I TYPE=""!(TYPE="TA") D
. S TYP="TA"
. S MIEN=$O(^BQICARE(DZ,8,"B",TYP,""))
. ;No preferences on file - use default
. I MIEN="" D Q
.. S PARMS=$$DAGG(PARMS)
.. S II=II+1,@DATA@(II)=TYP_"^"_PARMS_$C(30)
. ;Preferences defined - pull values
. I MIEN'="" D GET(TYP,MIEN)
;
;Return Provider Aggregated
S MIEN=0,PARMS=""
I TYPE=""!(TYPE="PA") D
. S TYP="PA"
. S MIEN=$O(^BQICARE(DZ,8,"B",TYP,""))
. ;No preferences on file - use default
. I MIEN="" D Q
.. S PARMS=$$DAGG(PARMS)
.. S II=II+1,@DATA@(II)=TYP_"^"_PARMS_$C(30)
. ;Preferences defined - pull values
. I MIEN'="" D GET(TYP,MIEN)
;
; Return Facility Aggregated
S MIEN=0,PARMS=""
I TYPE=""!(TYPE="FA") D
. S TYP="FA"
. S MIEN=$O(^BQICARE(DZ,8,"B",TYP,""))
. ;No preferences on file - use default
. I MIEN="" D Q
.. S PARMS=$$DAGG(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(DZ,8,MIEN,1,PIEN)) Q:'PIEN D
. NEW DA,IENS,NAME,VALUE
. S DA(2)=DZ,DA(1)=MIEN,DA=PIEN,IENS=$$IENS^DILF(.DA)
. S NAME=$$GET1^DIQ(90505.171,IENS,.01,"E")
. ;
. ;Try pulling an individual value first
. S VALUE=$$GET1^DIQ(90505.171,IENS,.03,"E")
. I VALUE="" S VALUE=$$GET1^DIQ(90505.171,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(DZ,8,MIEN,1,PIEN,1,PMIEN)) Q:'PMIEN D
.. NEW DA,IENS
.. S DA(3)=DZ,DA(2)=MIEN,DA(1)=PIEN,DA=PMIEN,IENS=$$IENS^DILF(.DA)
.. S VALUE=$$GET1^DIQ(90505.1711,IENS,.02,"E")
.. I VALUE="" S VALUE=$$GET1^DIQ(90505.1711,IENS,.01,"E")
.. S VALSTR=VALSTR_$S(VALSTR]"":$C(29),1:"")_VALUE
. ;
. ; Tack on Multiple Values
. S PARMS=PARMS_VALSTR
. K VALSTR
;
I TYPE="PD"!(TYPE="DP") S PARMS=$$DCAT(PARMS) ;Add CAT values, if needed
E S PARMS=$$DAGG(PARMS)
;
S PARMS=$$TKO^BQIUL1(PARMS,$C(28))
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,PNRESET,PARMS) ; EP -- BQI SET IPC PREFS
;
;Input
; TYPE - PD - Patient Detail, DP - Panel Detail
; PNRESET - Set to 'Y' if previous panel values should be cleared
; PARMS - Parameters
;Assumes
; DUZ - User who signed onto iCare
;
NEW UID,II,TYPN,QFL,BQ,ERROR,DZ
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIIPTVW",UID))
K @DATA
;
S II=0,TYPE=$G(TYPE,""),PNRESET=$G(PNRESET,""),DZ=DUZ
;
I TYPE="" S BMXSEC="RPC Failed: No 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
;
;PARMS ISN'T ALWAYS POPULATED
;I PARMS="" S BMXSEC="RPC Failed: No parameters passed in" Q
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPTVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="I00010RESULT"_$C(30)
;
S TYPN=$O(^BQICARE(DZ,8,"B",TYPE,""))
;
;Clean out all the previous parameters
I TYPN'="" D DEL(TYPN,PNRESET)
;
;If no previous, add new entry
I TYPN="" D
. NEW DA,DIC,DLAYGO,X,Y
. S DA(1)=DZ,X=$S(TYPE="PD":"Patient Detail",TYPE="DP":"Panel Detail",TYPE="TA":"Team Aggregated",TYPE="PA":"Provider Aggregated",TYPE="FA":"Facility Aggregated",1:"IPC")
. S DIC(0)="LNZ",DLAYGO=90505.17
. I $G(^BQICARE(DZ,8,0))="" S ^BQICARE(DZ,8,0)="^90505.17S^^"
. S DIC="^BQICARE("_DA(1)_",8,"
. 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,.DZ) I QFL Q
. I $G(DZ)="" S DZ=DUZ
. S DA(2)=DZ,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),8,DA(1),1,PDA,1,0)) S ^BQICARE(DA(2),8,DA(1),1,PDA,1,0)="^90505.1711^^"
.. 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,PNRESET) ; EP - Delete the previous User preferences for the Type
;
I $G(DZ)="" S DZ=DUZ
I PNRESET="Y" D Q
. NEW DA,DIK
. S DA(2)=DZ,DA(1)=TYPN,DA=0,DIK="^BQICARE("_DA(2)_",8,"_DA(1)_",1,"
. F S DA=$O(^BQICARE(DZ,8,TYPN,1,DA)) Q:'DA D ^DIK
;
;Delete all but panel
NEW PARM
S PARM=0 F S PARM=$O(^BQICARE(DZ,8,TYPN,1,PARM)) Q:'PARM D
. NEW IEN,DA,DIK,PRM
. S DA(2)=DZ,DA(1)=TYPN,DA=PARM,IEN=$$IENS^DILF(.DA)
. S PRM=$$GET1^DIQ(90505.171,IEN,".01","I") Q:PRM="PANEL"
. S DA(2)=DZ,DA(1)=TYPN,DA=PARM,DIK="^BQICARE("_DA(2)_",8,"_DA(1)_",1,"
. D ^DIK
Q
;
NPM(TYPN,NAME,PDA,DZ) ;EP - Add new parameter
NEW DA,IENS,DIC,DLAYGO,X,DLAYGO
I $G(DZ)="" S DZ=DUZ
S DA(2)=DZ,DA(1)=TYPN,X=NAME,DIC="^BQICARE("_DA(2)_",8,"_DA(1)_",1,"
I '$D(^BQICARE(DA(2),8,DA(1),1,0)) S ^BQICARE(DA(2),8,DA(1),1,0)="^90505.171^^"
S DLAYGO=90505.171,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.171,IENS,.03)=VALUE
I VALUE'?.N S BQIUPD(90505.171,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
I $G(DZ)="" S DZ=DUZ
S DA(3)=DZ,DA(2)=TYPN,DA(1)=PDA,X=MVAL
S DLAYGO=90505.1711,DIC(0)="L",DIC("P")=DLAYGO
S DIC="^BQICARE("_DA(3)_",8,"_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.1711,IENS,.02)=MVAL
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
Q
;
DCAT(PARM) ; Add all categories if not present in return parameters
;
NEW IEN,VALUE,CAT,CRIPC
;
S PARM=$G(PARM,"")
;
;Get the list of codes - Now pulling from 90506.8
S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
I PARM'["VERSION" S PARM=PARM_$S(PARM="":"",1:$C(28))_"VERSION="_CRIPC
I PARM'["CAT" D
. S VALUE="",CAT=0 F S CAT=$O(^BQI(90506.8,CAT)) Q:'CAT D
.. I $P(^BQI(90506.8,CAT,0),U,2)=1 Q
.. I $P(^BQI(90506.8,CAT,0),U,5)'=CRIPC Q
.. S VALUE=VALUE_$S(VALUE="":"",1:$C(29))_CAT
. S PARM=PARM_$S(PARM="":"",1:$C(28))_"CAT="_VALUE
;
XDCAT Q PARM
;
DAGG(PARM) ; Add default
S PARM=$G(PARM,"")
S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
I PARM'["VERSION" S PARM=PARM_$S(PARM="":"",1:$C(28))_"VERSION="_CRIPC
I PARM'["VIEW" S PARM=PARM_$S(PARM="":"",1:$C(28))_"VIEW=MONTHLY"
I PARM'["TMFRAME" S PARM=PARM_$S(PARM="":"",1:$C(28))_"TMFRAME=This Calendar Year"
;
XDAGG Q PARM
BQIIPTVW ;VNGT/HS/ALA-IPC Tabs View ; 10 Aug 2011 10:52 AM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
+2 ;
+3 ;
RET(DATA,TYPE) ; EP -- BQI GET IPC PREFS
+1 ;Description
+2 ; Retrieve the IPC Preferences for an owner
+3 ;
+4 ;Input
+5 ; TYPE (Optional) - (PD-Patient Detail/DP-Provider Detail)
+6 ;Output
+7 ; DATA - name of global (passed by reference) in which the data
+8 ; is stored
+9 ;Assumes
+10 ; DUZ - User who signed onto iCare
+11 ;
+12 NEW UID,II,PARMS,TYP,MIEN,DZ
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQIIPTVW",UID))
+15 KILL @DATA
+16 ;
+17 SET II=0
+18 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIIPTVW D UNWIND^%ZTER"
+19 ;
+20 SET @DATA@(II)="T00001TYPE^T03200PARMS"_$CHAR(30)
+21 ;
+22 SET TYPE=$GET(TYPE,"")
SET DZ=DUZ
+23 ;
+24 ;Return Patient Detail
+25 ;
+26 SET MIEN=0
SET PARMS=""
+27 IF TYPE=""!(TYPE="PD")
Begin DoDot:1
+28 SET TYP="PD"
+29 SET MIEN=$ORDER(^BQICARE(DZ,8,"B",TYP,""))
+30 ;No preferences on file - use default
+31 IF MIEN=""
Begin DoDot:2
+32 SET PARMS=$$DCAT(PARMS)
+33 SET II=II+1
SET @DATA@(II)=TYP_"^"_PARMS_$CHAR(30)
End DoDot:2
QUIT
+34 ;Preferences defined - pull values
+35 IF MIEN'=""
DO GET(TYP,MIEN)
End DoDot:1
+36 ;
+37 ;Return Provider Detail
+38 ;
+39 SET MIEN=0
SET PARMS=""
+40 IF TYPE=""!(TYPE="DP")
Begin DoDot:1
+41 SET TYP="DP"
+42 SET MIEN=$ORDER(^BQICARE(DZ,8,"B",TYP,""))
+43 ;No preferences on file - use default
+44 IF MIEN=""
Begin DoDot:2
+45 SET PARMS=$$DCAT(PARMS)
+46 SET II=II+1
SET @DATA@(II)=TYP_"^"_PARMS_$CHAR(30)
End DoDot:2
QUIT
+47 ;Preferences defined - pull values
+48 IF MIEN'=""
DO GET(TYP,MIEN)
End DoDot:1
+49 ;
+50 ;Return Team Aggregated
+51 SET MIEN=0
SET PARMS=""
+52 IF TYPE=""!(TYPE="TA")
Begin DoDot:1
+53 SET TYP="TA"
+54 SET MIEN=$ORDER(^BQICARE(DZ,8,"B",TYP,""))
+55 ;No preferences on file - use default
+56 IF MIEN=""
Begin DoDot:2
+57 SET PARMS=$$DAGG(PARMS)
+58 SET II=II+1
SET @DATA@(II)=TYP_"^"_PARMS_$CHAR(30)
End DoDot:2
QUIT
+59 ;Preferences defined - pull values
+60 IF MIEN'=""
DO GET(TYP,MIEN)
End DoDot:1
+61 ;
+62 ;Return Provider Aggregated
+63 SET MIEN=0
SET PARMS=""
+64 IF TYPE=""!(TYPE="PA")
Begin DoDot:1
+65 SET TYP="PA"
+66 SET MIEN=$ORDER(^BQICARE(DZ,8,"B",TYP,""))
+67 ;No preferences on file - use default
+68 IF MIEN=""
Begin DoDot:2
+69 SET PARMS=$$DAGG(PARMS)
+70 SET II=II+1
SET @DATA@(II)=TYP_"^"_PARMS_$CHAR(30)
End DoDot:2
QUIT
+71 ;Preferences defined - pull values
+72 IF MIEN'=""
DO GET(TYP,MIEN)
End DoDot:1
+73 ;
+74 ; Return Facility Aggregated
+75 SET MIEN=0
SET PARMS=""
+76 IF TYPE=""!(TYPE="FA")
Begin DoDot:1
+77 SET TYP="FA"
+78 SET MIEN=$ORDER(^BQICARE(DZ,8,"B",TYP,""))
+79 ;No preferences on file - use default
+80 IF MIEN=""
Begin DoDot:2
+81 SET PARMS=$$DAGG(PARMS)
+82 SET II=II+1
SET @DATA@(II)=TYP_"^"_PARMS_$CHAR(30)
End DoDot:2
QUIT
+83 ;Preferences defined - pull values
+84 IF MIEN'=""
DO GET(TYP,MIEN)
End DoDot:1
+85 ;
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(DZ,8,MIEN,1,PIEN))
IF 'PIEN
QUIT
Begin DoDot:1
+5 NEW DA,IENS,NAME,VALUE
+6 SET DA(2)=DZ
SET DA(1)=MIEN
SET DA=PIEN
SET IENS=$$IENS^DILF(.DA)
+7 SET NAME=$$GET1^DIQ(90505.171,IENS,.01,"E")
+8 ;
+9 ;Try pulling an individual value first
+10 SET VALUE=$$GET1^DIQ(90505.171,IENS,.03,"E")
+11 IF VALUE=""
SET VALUE=$$GET1^DIQ(90505.171,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(DZ,8,MIEN,1,PIEN,1,PMIEN))
IF 'PMIEN
QUIT
Begin DoDot:2
+19 NEW DA,IENS
+20 SET DA(3)=DZ
SET DA(2)=MIEN
SET DA(1)=PIEN
SET DA=PMIEN
SET IENS=$$IENS^DILF(.DA)
+21 SET VALUE=$$GET1^DIQ(90505.1711,IENS,.02,"E")
+22 IF VALUE=""
SET VALUE=$$GET1^DIQ(90505.1711,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
IF TYPE="PD"!(TYPE="DP")
SET PARMS=$$DCAT(PARMS)
+30 IF '$TEST
SET PARMS=$$DAGG(PARMS)
+31 ;
+32 SET PARMS=$$TKO^BQIUL1(PARMS,$CHAR(28))
+33 SET II=II+1
SET @DATA@(II)=TYPE_"^"_PARMS_$CHAR(30)
+34 QUIT
+35 ;
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,PNRESET,PARMS) ; EP -- BQI SET IPC PREFS
+1 ;
+2 ;Input
+3 ; TYPE - PD - Patient Detail, DP - Panel Detail
+4 ; PNRESET - Set to 'Y' if previous panel values should be cleared
+5 ; PARMS - Parameters
+6 ;Assumes
+7 ; DUZ - User who signed onto iCare
+8 ;
+9 NEW UID,II,TYPN,QFL,BQ,ERROR,DZ
+10 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+11 SET DATA=$NAME(^TMP("BQIIPTVW",UID))
+12 KILL @DATA
+13 ;
+14 SET II=0
SET TYPE=$GET(TYPE,"")
SET PNRESET=$GET(PNRESET,"")
SET DZ=DUZ
+15 ;
+16 IF TYPE=""
SET BMXSEC="RPC Failed: No Type of Preferences passed in"
QUIT
+17 ;
+18 IF $DATA(PARMS)>10
Begin DoDot:1
+19 NEW LIST,BN,QFL,BQ
+20 SET LIST=""
SET BN=""
+21 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
Begin DoDot:2
+22 SET LIST=LIST_PARMS(BN)
End DoDot:2
+23 KILL PARMS
SET PARMS=LIST
End DoDot:1
+24 ;
+25 ;PARMS ISN'T ALWAYS POPULATED
+26 ;I PARMS="" S BMXSEC="RPC Failed: No parameters passed in" Q
+27 ;
+28 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIIPTVW D UNWIND^%ZTER"
+29 ;
+30 SET @DATA@(II)="I00010RESULT"_$CHAR(30)
+31 ;
+32 SET TYPN=$ORDER(^BQICARE(DZ,8,"B",TYPE,""))
+33 ;
+34 ;Clean out all the previous parameters
+35 IF TYPN'=""
DO DEL(TYPN,PNRESET)
+36 ;
+37 ;If no previous, add new entry
+38 IF TYPN=""
Begin DoDot:1
+39 NEW DA,DIC,DLAYGO,X,Y
+40 SET DA(1)=DZ
SET X=$SELECT(TYPE="PD":"Patient Detail",TYPE="DP":"Panel Detail",TYPE="TA":"Team Aggregated",TYPE="PA":"Provider Aggregated",TYPE="FA":"Facility Aggregated",1:"IPC")
+41 SET DIC(0)="LNZ"
SET DLAYGO=90505.17
+42 IF $GET(^BQICARE(DZ,8,0))=""
SET ^BQICARE(DZ,8,0)="^90505.17S^^"
+43 SET DIC="^BQICARE("_DA(1)_",8,"
+44 DO ^DIC
SET TYPN=+Y
IF TYPN=-1
KILL DO,DD
DO FILE^DICN
SET TYPN=+Y
End DoDot:1
+45 ;
+46 SET QFL=0
+47 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+48 ;
+49 NEW PDATA,NAME,VALUE,PDA,DA,IENS
+50 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+51 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+52 DO NPM(TYPN,NAME,.PDA,.DZ)
IF QFL
QUIT
+53 IF $GET(DZ)=""
SET DZ=DUZ
+54 SET DA(2)=DZ
SET DA(1)=TYPN
SET DA=PDA
+55 SET IENS=$$IENS^DILF(.DA)
+56 ;
+57 ;Single value
+58 IF VALUE'[$CHAR(29)
DO NRC(IENS,VALUE,.ERROR)
QUIT
+59 ;
+60 ;Multiple values
+61 IF VALUE[$CHAR(29)
Begin DoDot:2
+62 NEW BQII,MVAL
+63 IF '$DATA(^BQICARE(DA(2),8,DA(1),1,PDA,1,0))
SET ^BQICARE(DA(2),8,DA(1),1,PDA,1,0)="^90505.1711^^"
+64 FOR BQII=1:1:$LENGTH(VALUE,$CHAR(29))
Begin DoDot:3
+65 SET MVAL=$PIECE(VALUE,$CHAR(29),BQII)
+66 DO NML(TYPN,PDA,MVAL,.ERROR)
End DoDot:3
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
GOTO DONE
+67 ;
+68 SET II=II+1
+69 IF $DATA(ERROR)
SET @DATA@(II)="-1"_$CHAR(30)
+70 IF '$TEST
SET @DATA@(II)="1"_$CHAR(30)
+71 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+72 QUIT
+73 ;
DEL(TYPN,PNRESET) ; EP - Delete the previous User preferences for the Type
+1 ;
+2 IF $GET(DZ)=""
SET DZ=DUZ
+3 IF PNRESET="Y"
Begin DoDot:1
+4 NEW DA,DIK
+5 SET DA(2)=DZ
SET DA(1)=TYPN
SET DA=0
SET DIK="^BQICARE("_DA(2)_",8,"_DA(1)_",1,"
+6 FOR
SET DA=$ORDER(^BQICARE(DZ,8,TYPN,1,DA))
IF 'DA
QUIT
DO ^DIK
End DoDot:1
QUIT
+7 ;
+8 ;Delete all but panel
+9 NEW PARM
+10 SET PARM=0
FOR
SET PARM=$ORDER(^BQICARE(DZ,8,TYPN,1,PARM))
IF 'PARM
QUIT
Begin DoDot:1
+11 NEW IEN,DA,DIK,PRM
+12 SET DA(2)=DZ
SET DA(1)=TYPN
SET DA=PARM
SET IEN=$$IENS^DILF(.DA)
+13 SET PRM=$$GET1^DIQ(90505.171,IEN,".01","I")
IF PRM="PANEL"
QUIT
+14 SET DA(2)=DZ
SET DA(1)=TYPN
SET DA=PARM
SET DIK="^BQICARE("_DA(2)_",8,"_DA(1)_",1,"
+15 DO ^DIK
End DoDot:1
+16 QUIT
+17 ;
NPM(TYPN,NAME,PDA,DZ) ;EP - Add new parameter
+1 NEW DA,IENS,DIC,DLAYGO,X,DLAYGO
+2 IF $GET(DZ)=""
SET DZ=DUZ
+3 SET DA(2)=DZ
SET DA(1)=TYPN
SET X=NAME
SET DIC="^BQICARE("_DA(2)_",8,"_DA(1)_",1,"
+4 IF '$DATA(^BQICARE(DA(2),8,DA(1),1,0))
SET ^BQICARE(DA(2),8,DA(1),1,0)="^90505.171^^"
+5 SET DLAYGO=90505.171
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+6 KILL DO,DD
DO FILE^DICN
+7 SET (DA,PDA)=+Y
+8 IF DA=-1
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
SET QFL=1
+9 QUIT
+10 ;
NRC(IENS,VALUE,ERROR) ;EP - New single record
+1 NEW BQIUPD
+2 IF VALUE?.N
SET BQIUPD(90505.171,IENS,.03)=VALUE
+3 IF VALUE'?.N
SET BQIUPD(90505.171,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 IF $GET(DZ)=""
SET DZ=DUZ
+3 SET DA(3)=DZ
SET DA(2)=TYPN
SET DA(1)=PDA
SET X=MVAL
+4 SET DLAYGO=90505.1711
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+5 SET DIC="^BQICARE("_DA(3)_",8,"_DA(2)_",1,"_DA(1)_",1,"
+6 KILL DO,DD
DO FILE^DICN
+7 SET DA=+Y
+8 IF DA=-1
SET II=II+1
SET @DATA@(II)="-1"_$CHAR(30)
SET QFL=1
QUIT
+9 SET IENS=$$IENS^DILF(.DA)
+10 IF MVAL?.N
SET BQIUPD(90505.1711,IENS,.02)=MVAL
+11 DO FILE^DIE("","BQIUPD","ERROR")
+12 KILL BQIUPD
+13 QUIT
+14 ;
DCAT(PARM) ; Add all categories if not present in return parameters
+1 ;
+2 NEW IEN,VALUE,CAT,CRIPC
+3 ;
+4 SET PARM=$GET(PARM,"")
+5 ;
+6 ;Get the list of codes - Now pulling from 90506.8
+7 SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)
+8 IF PARM'["VERSION"
SET PARM=PARM_$SELECT(PARM="":"",1:$CHAR(28))_"VERSION="_CRIPC
+9 IF PARM'["CAT"
Begin DoDot:1
+10 SET VALUE=""
SET CAT=0
FOR
SET CAT=$ORDER(^BQI(90506.8,CAT))
IF 'CAT
QUIT
Begin DoDot:2
+11 IF $PIECE(^BQI(90506.8,CAT,0),U,2)=1
QUIT
+12 IF $PIECE(^BQI(90506.8,CAT,0),U,5)'=CRIPC
QUIT
+13 SET VALUE=VALUE_$SELECT(VALUE="":"",1:$CHAR(29))_CAT
End DoDot:2
+14 SET PARM=PARM_$SELECT(PARM="":"",1:$CHAR(28))_"CAT="_VALUE
End DoDot:1
+15 ;
XDCAT QUIT PARM
+1 ;
DAGG(PARM) ; Add default
+1 SET PARM=$GET(PARM,"")
+2 SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)
+3 IF PARM'["VERSION"
SET PARM=PARM_$SELECT(PARM="":"",1:$CHAR(28))_"VERSION="_CRIPC
+4 IF PARM'["VIEW"
SET PARM=PARM_$SELECT(PARM="":"",1:$CHAR(28))_"VIEW=MONTHLY"
+5 IF PARM'["TMFRAME"
SET PARM=PARM_$SELECT(PARM="":"",1:$CHAR(28))_"TMFRAME=This Calendar Year"
+6 ;
XDAGG QUIT PARM
