BQIPLFL ;PRXM/HC/ALA-Set the Panel's Filter Parameters ; 16 Dec 2005 2:58 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
Q
;
RET(DATA,OWNR,PLIEN) ; EP -- BQI GET PANEL FILTERS
;
;Description - Retrieves the panel filter parameters for a specific panel
;
;Input
; OWNR = Owner of the panel internal entry number
; PLIEN = Panel internal entry number
;Output
; DATA = name of global (passed by reference) in which the data
; is stored
;Assumes
; DUZ = User who signed onto iCare
;
NEW UID,II,X,MASP,MM,MPARMS,MSN,N,NAME,NM,NN,PARMS,PM,PPIEN,PTYP,VM
NEW FILTER,FSOURCE,IENS,AN,ASN,ASPM,ATYP,DA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPLFL",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLFL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T03200FILTERS"_$C(30)
;
;NEW DA,IENS,FSOURCE,PPIEN,PTYP,N,NN,PARMS,MPARMS
S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
S FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
;
; Find definition
I FSOURCE="" G DONE
S PPIEN=$$PP^BQIDCDF(FSOURCE) I PPIEN=-1 S BMXSEC="Pre-defined panel type "_FSOURCE_" was not found" Q
;
S N=0,PARMS="",MPARMS=""
F S N=$O(^BQICARE(OWNR,1,PLIEN,15,N)) Q:'N D
. NEW DA,IENS
. S DA(2)=OWNR,DA(1)=PLIEN,DA=N,IENS=$$IENS^DILF(.DA)
. S NAME=$$GET1^DIQ(90505.115,IENS,.01,"E")
. S PTYP=$$PTYP^BQIDCDF(FSOURCE,NAME)
. S FILTER(N)=NAME
. I '$D(^BQICARE(OWNR,1,PLIEN,15,N,1)) D Q
.. NEW DA,IENS,NAME,VALUE
.. S DA(2)=OWNR,DA(1)=PLIEN,DA=N,IENS=$$IENS^DILF(.DA)
.. I PTYP="T" S VALUE=$$GET1^DIQ(90505.115,IENS,.03,"E")
.. I PTYP'="T" S VALUE=$$GET1^DIQ(90505.115,IENS,.02,"E")
.. I PTYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.. S FILTER(N,1)=VALUE
.. ; Check for associated parameters
.. S ASN=0
.. F S ASN=$O(^BQICARE(OWNR,1,PLIEN,15,N,2,ASN)) Q:'ASN D
... NEW DA,IENS,ASSOC,AVALUE,VALUE
... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=N,DA=ASN,IENS=$$IENS^DILF(.DA)
... S ASSOC=$$GET1^DIQ(90505.1152,IENS,.01,"E")
... S ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
... S FILTER(N,1,ASN)=ASSOC
... I '$D(^BQICARE(OWNR,1,PLIEN,15,N,2,ASN,1)) D Q
.... I ATYP="T" S VALUE=$$GET1^DIQ(90505.1152,IENS,.03,"E")
.... I ATYP'="T" S VALUE=$$GET1^DIQ(90505.1152,IENS,.02,"E")
.... I ATYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.... S FILTER(N,1,ASN,1)=VALUE
... S MSN=0
... F S MSN=$O(^BQICARE(OWNR,1,PLIEN,15,N,2,ASN,1,MSN)) Q:'MSN D
.... NEW DA,IENS,VALUE
.... S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=N,DA(1)=ASN,DA=MSN,IENS=$$IENS^DILF(.DA)
.... I ATYP="T" S VALUE=$$GET1^DIQ(90505.11521,IENS,.02,"E")
.... I ATYP'="T" S VALUE=$$GET1^DIQ(90505.11521,IENS,.01,"E")
.... I ATYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.... S FILTER(N,1,ASN,MSN)=VALUE
. ;
. S NN=0
. F S NN=$O(^BQICARE(OWNR,1,PLIEN,15,N,1,NN)) Q:'NN D
.. NEW DA,IENS,VALUE
.. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=N,DA=NN,IENS=$$IENS^DILF(.DA)
.. I PTYP="T" S VALUE=$$GET1^DIQ(90505.1151,IENS,.02,"E")
.. I PTYP'="T" S VALUE=$$GET1^DIQ(90505.1151,IENS,.01,"E")
.. I PTYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.. S FILTER(N,NN)=VALUE
.. ; Check for associated parameters
.. S ASN=0
.. F S ASN=$O(^BQICARE(OWNR,1,PLIEN,15,N,1,NN,2,ASN)) Q:'ASN D
... NEW DA,IENS,ASSOC,AVALUE,VALUE
... S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=N,DA(1)=NN,DA=ASN,IENS=$$IENS^DILF(.DA)
... S ASSOC=$$GET1^DIQ(90505.11512,IENS,.01,"E")
... S ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
... S FILTER(N,NN,ASN)=ASSOC
... I '$D(^BQICARE(OWNR,1,PLIEN,15,N,1,NN,2,ASN,1)) D Q
.... I ATYP="T" S VALUE=$$GET1^DIQ(90505.11512,IENS,.03,"E")
.... I ATYP'="T" S VALUE=$$GET1^DIQ(90505.11512,IENS,.02,"E")
.... I ATYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.... S FILTER(N,NN,ASN,1)=VALUE
... S MSN=0
... F S MSN=$O(^BQICARE(OWNR,1,PLIEN,15,N,1,NN,2,ASN,1,MSN)) Q:'MSN D
.... NEW DA,IENS,VALUE
.... S DA(5)=OWNR,DA(4)=PLIEN,DA(3)=N,DA(2)=NN,DA(1)=ASN,DA=MSN,IENS=$$IENS^DILF(.DA)
.... I ATYP="T" S VALUE=$$GET1^DIQ(90505.115121,IENS,.02,"E")
.... I ATYP'="T" S VALUE=$$GET1^DIQ(90505.115121,IENS,.01,"E")
.... I ATYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.... S FILTER(N,NN,ASN,MSN)=VALUE
;
; Build PARMS
S PM=""
F S PM=$O(FILTER(PM)) Q:PM="" D
. S NAME=FILTER(PM),PARMS=$G(PARMS)_NAME_"="
. S VM=""
. F S VM=$O(FILTER(PM,VM)) Q:VM="" D
.. S AN=""
.. F S AN=$O(FILTER(PM,VM,AN)) Q:AN="" D
... S MM="",MASP=""
... F S MM=$O(FILTER(PM,VM,AN,MM)) Q:MM="" D
.... S MASP=$G(MASP)_FILTER(PM,VM,AN,MM)_$C(24)
... S MASP=$$TKO^BQIUL1(MASP,$C(24))
... S ASPM=FILTER(PM,VM,AN)_"="_MASP
... S MPRM(VM)=$S(AN'<2:$$TKO^BQIUL1(MPRM(VM),$C(29)),1:FILTER(PM,VM))_$C(25)_ASPM_$C(29)
.. I '$D(MPRM(VM)) S MPRM(VM)=FILTER(PM,VM)_$C(29)
. S NM=""
. F S NM=$O(MPRM(NM)) Q:NM="" S PARMS=PARMS_MPRM(NM)
. S PARMS=$$TKO^BQIUL1(PARMS,$C(29))
. S PARMS=PARMS_$C(28)
. K MPRM
;
S II=II+1
S PARMS=$$TKO^BQIUL1(PARMS,$C(28))
;S PARMS=$$TKO^BQIUL1(PARMS,$C(29))
S @DATA@(II)=PARMS_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
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,OWNR,PLIEN,PARMS) ; EP -- BQI SET PANEL FILTERS
;
;Description
; Update or set the filter parameters
;Input
; OWNR = Owner of panel IEN
; PLIEN = Panel internal entry number
; PARMS = Filter parameters (if NULL, deletes ALL)
; if PARMS contain a $C(29), then that is
; a multiple value parameter
;
NEW UID,II,X,BN,FSOURCE,PPIEN,PTYP,BQ,BQIUPD,PDATA,MVAL,PDA,QFL,ACT
NEW ASDATA,ASNAME,ASV,AVAL,AVCT,BQQ,CT,MBQ,MVN,RESULT,VAL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPLFL",UID))
K @DATA
;
; Check if share and has write access
I '$$CKSHR^BQIPLSH(OWNR,PLIEN) S BMXSEC="You do not have write access" Q
;
CV ;EP
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLFL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S PARMS=$G(PARMS,""),RESULT=1
S @DATA@(II)="I00010RESULT^T00050MSG"_$C(30)
;
D DEL(.OWNR,.PLIEN)
;
NEW DA,IENS
S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
S FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
;
; Find definition panel
I FSOURCE="" G DONE
S PPIEN=$$PP^BQIDCDF(FSOURCE) I PPIEN=-1 S BMXSEC="Pre-defined panel type "_FSOURCE_" was not found" Q
;
S PARMS=$G(PARMS,"")
I PARMS="" D
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
. K LIST
;
K FILTER
S QFL=0
F BQ=1:1:$L(PARMS,$C(28)) I $P(PARMS,$C(28),BQ)'="" S FILTER(BQ)=$P(PARMS,$C(28),BQ)
F BQQ=1:1:BQ D
. S PDATA=$G(FILTER(BQQ)) Q:PDATA=""
. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
. S FDATA(BQQ)=NAME
. F II=1:1:$L(VALUE,$C(29)) D
.. S VAL=$P(VALUE,$C(29),II),ASSOC=$P(VAL,$C(25),2,99)
.. S FILTER(BQQ,II)=$P(VAL,$C(25),1)
.. I ASSOC'="" D
... F ASN=1:1:$L(ASSOC,$C(25)) D
.... S ASDATA=$P(ASSOC,$C(25),ASN)
.... S ASVAL=$P(ASDATA,"=",2,99),ASNAME=$P(ASDATA,"=",1)
.... S FILTER(BQQ,II,ASN)=ASNAME
.... I ASVAL'[$C(24) S FILTER(BQQ,II,ASN,1)=ASVAL Q
.... F ASV=1:1:$L(ASVAL,$C(24)) S FILTER(BQQ,II,ASN,ASV)=$P(ASVAL,$C(24),ASV)
F BQQ=1:1:BQ S FILTER(BQQ)=FDATA(BQQ)
K FDATA
;
; Store the filter data
S BQQ=""
F S BQQ=$O(FILTER(BQQ)) Q:BQQ="" D
. S NAME=FILTER(BQQ)
. S PTYP=$$PTYP^BQIDCDF(FSOURCE,NAME)
. ; Create parameter entry
. NEW DA,IENS,DIC,DLAYGO
. S DA(2)=OWNR,DA(1)=PLIEN,X=NAME
. S DLAYGO=90505.115,DIC(0)="L",DIC("P")=DLAYGO
. S DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",15,"
. I '$D(^BQICARE(DA(2),1,DA(1),15,0)) S ^BQICARE(DA(2),1,DA(1),15,0)="^90505.115^^"
. K DO,DD D FILE^DICN
. S PDA=+Y
. I PDA=-1 S RESULT=-1,QFL=1 Q
. ;
. S MBQ="",CT=1
. F S MBQ=$O(FILTER(BQQ,MBQ)) Q:MBQ="" D
.. ; If there are no multiple values, store and quit
.. S VALUE=FILTER(BQQ,MBQ)
.. I $O(FILTER(BQQ,MBQ))="",CT=1 D PMSV(OWNR,PLIEN,PDA,VALUE,PTYP) Q
.. D PMMV(OWNR,PLIEN,PDA,VALUE,PTYP)
.. S CT=CT+1
.. ;
;
S II=II+1,@DATA@(II)=RESULT_U_$C(30)
S II=II+1,@DATA@(II)=$C(31)
D DSC
Q
;
PMSV(BOWNR,BPLIEN,BDA,BVALUE,BTYP) ;EP Store singular parameter value
NEW DA,IENS
S DA(2)=BOWNR,DA(1)=BPLIEN,DA=BDA
S IENS=$$IENS^DILF(.DA)
I BTYP="D" S BVALUE=$$DATE^BQIUL1(BVALUE)
I BTYP="T" S BQIUPD(90505.115,IENS,.03)=BVALUE
I BTYP'="T" S BQIUPD(90505.115,IENS,.02)=BVALUE
D FILE^DIE("","BQIUPD","ERROR")
; Check if there are associated parameters
D CKAS
Q
;
PMMV(BOWNR,BPLIEN,BDA,BVAL,BTYP) ;EP
NEW DA,IENS,DIC,DLAYGO
S DA(3)=BOWNR,DA(2)=BPLIEN,DA(1)=BDA,X=BVAL
S DLAYGO=90505.1151,DIC(0)="L",DIC("P")=DLAYGO
S DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",15,"_DA(1)_",1,"
K DO,DD D FILE^DICN
S (DA,MDA)=+Y
I DA=-1 S RESULT=-1,QFL=1 Q
S IENS=$$IENS^DILF(.DA)
I BTYP="D" S BVAL=$$DATE^BQIUL1(BVAL)
I BTYP="T" S BQIUPD(90505.1151,IENS,.02)=BVAL
I BTYP'="T" S BQIUPD(90505.1151,IENS,.01)=BVAL
D FILE^DIE("","BQIUPD","ERROR")
; Check if there are associated parameters
D CKAM
Q
;
SASV(AOWNR,APLIEN,PDA,ADA,VALUE,PTYP) ;EP Single associated parameter
; Input
; AOWNR - Panel Owner
; APLIEN - Panel IEN
; PDA - Parameter record
; ADA - Associated parameter record
; VALUE - Value
; PTYP - Associate parameter type
NEW DA,IENS
S DA(3)=AOWNR,DA(2)=APLIEN,DA(1)=PDA,DA=ADA
S IENS=$$IENS^DILF(.DA)
I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
I PTYP="T" S BQIUPD(90505.1152,IENS,.03)=VALUE
I PTYP'="T" S BQIUPD(90505.1152,IENS,.02)=VALUE
D FILE^DIE("","BQIUPD","ERROR")
Q
;
MASV(AOWNR,APLIEN,ADA,ASDA,ASVAL,ASTYP) ;EP Multiple associated parameter values
NEW DA,IENS,DIC,DLAYGO
S DA(4)=AOWNR,DA(3)=APLIEN,DA(2)=ADA,DA(1)=ASDA,X=ASVAL
S DLAYGO=90505.11521,DIC(0)="L",DIC("P")=DLAYGO
S DIC="^BQICARE("_DA(4)_",1,"_DA(3)_",15,"_DA(2)_",2,"_DA(1)_",1,"
I '$D(^BQICARE(DA(4),1,DA(3),15,DA(2),2,DA(1),1,0)) S ^BQICARE(DA(4),1,DA(3),15,DA(2),2,DA(1),1,0)="^90505.11521^^"
K DO,DD D FILE^DICN
S DA=+Y
I DA=-1 S RESULT=-1,QFL=1 Q
S IENS=$$IENS^DILF(.DA)
I ASTYP="D" S ASVAL=$$DATE^BQIUL1(ASVAL)
I ASTYP="T" S BQIUPD(90505.11521,IENS,.02)=ASVAL
I ASTYP'="T" S BQIUPD(90505.11521,IENS,.01)=ASVAL
D FILE^DIE("","BQIUPD","ERROR")
Q
;
DSC ;EP Generate panel description to include any filters
NEW DA,IENS
S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
K DESC
D DESC^BQIPDSCM(OWNR,PLIEN,.DESC)
;D PEN^BQIPLDSC(OWNR,PLIEN,.DESC)
D WP^DIE(90505.01,IENS,5,"","DESC")
K DESC
Q
;
DEL(OWNR,PLIEN) ;EP - Remove the previous filter parameters
NEW DA,IENS,DIK
S DA(2)=OWNR,DA(1)=PLIEN,DA=0
S DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",15,"
F S DA=$O(^BQICARE(OWNR,1,PLIEN,15,DA)) Q:'DA D ^DIK
Q
;
CKAS ;EP Check for associated parameters for a single parameter
S ASN="",ACT=1
F S ASN=$O(FILTER(BQQ,MBQ,ASN)) Q:ASN="" D
. ; Check for multiple associated parameters
. S ASSOC=FILTER(BQQ,MBQ,ASN)
. NEW DA,DIC,DLAYGO
. S DA(3)=BOWNR,DA(2)=BPLIEN,DA(1)=BDA,X=ASSOC
. S ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
. S DLAYGO=90505.1152,DIC(0)="L",DIC("P")=DLAYGO
. S DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",15,"_DA(1)_",2,"
. I '$D(^BQICARE(DA(3),1,DA(2),15,DA(1),2,0)) S ^BQICARE(DA(3),1,DA(2),15,DA(1),2,0)="^90505.1152^^"
. K DO,DD D FILE^DICN
. S (DA,ADA)=+Y
. I DA=-1 S RESULT=-1,QFL=1 Q
. S MVN="",AVCT=1
. F S MVN=$O(FILTER(BQQ,MBQ,ASN,MVN)) Q:MVN="" D
.. S AVAL=FILTER(BQQ,MBQ,ASN,MVN)
.. ; If single associated parameter value
.. I $O(FILTER(BQQ,MBQ,ASN,MVN))="",AVCT=1 D SASV(BOWNR,BPLIEN,BDA,ADA,AVAL,ATYP) Q
.. ; If multiple associated parameter values
.. D MASV(BOWNR,BPLIEN,BDA,ADA,AVAL,ATYP)
.. S AVCT=AVCT+1
Q
;
CKAM ;EP
S ASN="",ACT=1
F S ASN=$O(FILTER(BQQ,MBQ,ASN)) Q:ASN="" D
. ; Check for multiple associated parameters
. S ASSOC=FILTER(BQQ,MBQ,ASN)
. NEW DA,DIC,DLAYGO
. S DA(4)=BOWNR,DA(3)=BPLIEN,DA(2)=BDA,DA(1)=MDA,X=ASSOC
. S ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
. S DLAYGO=90505.11512,DIC(0)="L",DIC("P")=DLAYGO
. S DIC="^BQICARE("_DA(4)_",1,"_DA(3)_",15,"_DA(2)_",1,"_DA(1)_",2,"
. I '$D(^BQICARE(DA(4),1,DA(3),15,DA(2),1,DA(1),2,0)) S ^BQICARE(DA(4),1,DA(3),15,DA(2),1,DA(1),2,0)="^90505.11512^^"
. K DO,DD D FILE^DICN
. S (DA,ADA)=+Y
. I DA=-1 S RESULT=-1,QFL=1 Q
. S MVN="",AVCT=1
. F S MVN=$O(FILTER(BQQ,MBQ,ASN,MVN)) Q:MVN="" D
.. S AVAL=FILTER(BQQ,MBQ,ASN,MVN)
.. ; If single associated parameter value
.. I $O(FILTER(BQQ,MBQ,ASN,MVN))="",AVCT=1 D MPSV(BOWNR,BPLIEN,BDA,MDA,ADA,AVAL,ATYP) Q
.. ; If multiple associated parameter values
.. D MPMV(BOWNR,BPLIEN,BDA,MDA,ADA,AVAL,ATYP)
.. S AVCT=AVCT+1
Q
;
MPSV(AOWNR,APLIEN,PDA,MPDA,ASDA,VALUE,PTYP) ;EP
NEW DA,IENS
S DA(4)=AOWNR,DA(3)=APLIEN,DA(2)=PDA,DA(1)=MPDA,DA=ASDA
S IENS=$$IENS^DILF(.DA)
I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
I PTYP="T" S BQIUPD(90505.11512,IENS,.03)=VALUE
I PTYP'="T" S BQIUPD(90505.11512,IENS,.02)=VALUE
D FILE^DIE("","BQIUPD","ERROR")
Q
;
MPMV(AOWNR,APLIEN,BDA,MDA,ADA,ASVAL,ATYP) ;EP
NEW DA,IENS,DIC,DLAYGO
S DA(5)=AOWNR,DA(4)=APLIEN,DA(3)=BDA,DA(2)=MDA,DA(1)=ADA,X=ASVAL
S DLAYGO=90505.115121,DIC(0)="L",DIC("P")=DLAYGO
S DIC="^BQICARE("_DA(5)_",1,"_DA(4)_",15,"_DA(3)_",1,"_DA(2)_",2,"_DA(1)_",1,"
I '$D(^BQICARE(DA(5),1,DA(4),15,DA(3),1,DA(2),2,DA(1),1,0)) S ^BQICARE(DA(5),1,DA(4),15,DA(3),1,DA(2),2,DA(1),1,0)="^90505.115121^^"
K DO,DD D FILE^DICN
S DA=+Y
I DA=-1 S RESULT=-1,QFL=1 Q
S IENS=$$IENS^DILF(.DA)
I ATYP="D" S ASVAL=$$DATE^BQIUL1(ASVAL)
I ATYP="T" S BQIUPD(90505.115121,IENS,.02)=ASVAL
I ATYP'="T" S BQIUPD(90505.115121,IENS,.01)=ASVAL
D FILE^DIE("","BQIUPD","ERROR")
Q
;
SAVL(BOWNR,BPLIEN,BDA,MDA,ASSOC,AVAL,ATYP) ;EP - Add an assoc parameter to a multiple API
NEW DA,DIC,DLAYGO
S DA(4)=BOWNR,DA(3)=BPLIEN,DA(2)=BDA,DA(1)=MDA,X=ASSOC
S DLAYGO=90505.11512,DIC(0)="L",DIC("P")=DLAYGO
S DIC="^BQICARE("_DA(4)_",1,"_DA(3)_",15,"_DA(2)_",1,"_DA(1)_",2,"
I '$D(^BQICARE(DA(4),1,DA(3),15,DA(2),1,DA(1),2,0)) S ^BQICARE(DA(4),1,DA(3),15,DA(2),1,DA(1),2,0)="^90505.11512^^"
K DO,DD D FILE^DICN
S (DA,ADA)=+Y
D MPSV(BOWNR,BPLIEN,BDA,MDA,ADA,AVAL,ATYP)
Q ADA
;
CON(DATA,OWNR,PLIEN,PARMS) ;EP - For 2.2 conversion
NEW UID,II,X,BN,FSOURCE,PPIEN,PTYP,BQ,BQIUPD,PDATA,MVAL,PDA,QFL,ACT
NEW ASDATA,ASNAME,ASV,AVAL,AVCT,BQQ,CT,MBQ,MVN,RESULT,VAL,FILTER
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPLFL",UID))
K @DATA
D CV
Q
BQIPLFL ;PRXM/HC/ALA-Set the Panel's Filter Parameters ; 16 Dec 2005 2:58 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
+3 QUIT
+4 ;
RET(DATA,OWNR,PLIEN) ; EP -- BQI GET PANEL FILTERS
+1 ;
+2 ;Description - Retrieves the panel filter parameters for a specific panel
+3 ;
+4 ;Input
+5 ; OWNR = Owner of the panel internal entry number
+6 ; PLIEN = Panel internal entry number
+7 ;Output
+8 ; DATA = name of global (passed by reference) in which the data
+9 ; is stored
+10 ;Assumes
+11 ; DUZ = User who signed onto iCare
+12 ;
+13 NEW UID,II,X,MASP,MM,MPARMS,MSN,N,NAME,NM,NN,PARMS,PM,PPIEN,PTYP,VM
+14 NEW FILTER,FSOURCE,IENS,AN,ASN,ASPM,ATYP,DA
+15 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+16 SET DATA=$NAME(^TMP("BQIPLFL",UID))
+17 KILL @DATA
+18 ;
+19 SET II=0
+20 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPLFL D UNWIND^%ZTER"
+21 ;
+22 SET @DATA@(II)="T03200FILTERS"_$CHAR(30)
+23 ;
+24 ;NEW DA,IENS,FSOURCE,PPIEN,PTYP,N,NN,PARMS,MPARMS
+25 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+26 SET FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
+27 ;
+28 ; Find definition
+29 IF FSOURCE=""
GOTO DONE
+30 SET PPIEN=$$PP^BQIDCDF(FSOURCE)
IF PPIEN=-1
SET BMXSEC="Pre-defined panel type "_FSOURCE_" was not found"
QUIT
+31 ;
+32 SET N=0
SET PARMS=""
SET MPARMS=""
+33 FOR
SET N=$ORDER(^BQICARE(OWNR,1,PLIEN,15,N))
IF 'N
QUIT
Begin DoDot:1
+34 NEW DA,IENS
+35 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=N
SET IENS=$$IENS^DILF(.DA)
+36 SET NAME=$$GET1^DIQ(90505.115,IENS,.01,"E")
+37 SET PTYP=$$PTYP^BQIDCDF(FSOURCE,NAME)
+38 SET FILTER(N)=NAME
+39 IF '$DATA(^BQICARE(OWNR,1,PLIEN,15,N,1))
Begin DoDot:2
+40 NEW DA,IENS,NAME,VALUE
+41 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=N
SET IENS=$$IENS^DILF(.DA)
+42 IF PTYP="T"
SET VALUE=$$GET1^DIQ(90505.115,IENS,.03,"E")
+43 IF PTYP'="T"
SET VALUE=$$GET1^DIQ(90505.115,IENS,.02,"E")
+44 IF PTYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+45 SET FILTER(N,1)=VALUE
+46 ; Check for associated parameters
+47 SET ASN=0
+48 FOR
SET ASN=$ORDER(^BQICARE(OWNR,1,PLIEN,15,N,2,ASN))
IF 'ASN
QUIT
Begin DoDot:3
+49 NEW DA,IENS,ASSOC,AVALUE,VALUE
+50 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=N
SET DA=ASN
SET IENS=$$IENS^DILF(.DA)
+51 SET ASSOC=$$GET1^DIQ(90505.1152,IENS,.01,"E")
+52 SET ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
+53 SET FILTER(N,1,ASN)=ASSOC
+54 IF '$DATA(^BQICARE(OWNR,1,PLIEN,15,N,2,ASN,1))
Begin DoDot:4
+55 IF ATYP="T"
SET VALUE=$$GET1^DIQ(90505.1152,IENS,.03,"E")
+56 IF ATYP'="T"
SET VALUE=$$GET1^DIQ(90505.1152,IENS,.02,"E")
+57 IF ATYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+58 SET FILTER(N,1,ASN,1)=VALUE
End DoDot:4
QUIT
+59 SET MSN=0
+60 FOR
SET MSN=$ORDER(^BQICARE(OWNR,1,PLIEN,15,N,2,ASN,1,MSN))
IF 'MSN
QUIT
Begin DoDot:4
+61 NEW DA,IENS,VALUE
+62 SET DA(4)=OWNR
SET DA(3)=PLIEN
SET DA(2)=N
SET DA(1)=ASN
SET DA=MSN
SET IENS=$$IENS^DILF(.DA)
+63 IF ATYP="T"
SET VALUE=$$GET1^DIQ(90505.11521,IENS,.02,"E")
+64 IF ATYP'="T"
SET VALUE=$$GET1^DIQ(90505.11521,IENS,.01,"E")
+65 IF ATYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+66 SET FILTER(N,1,ASN,MSN)=VALUE
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+67 ;
+68 SET NN=0
+69 FOR
SET NN=$ORDER(^BQICARE(OWNR,1,PLIEN,15,N,1,NN))
IF 'NN
QUIT
Begin DoDot:2
+70 NEW DA,IENS,VALUE
+71 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=N
SET DA=NN
SET IENS=$$IENS^DILF(.DA)
+72 IF PTYP="T"
SET VALUE=$$GET1^DIQ(90505.1151,IENS,.02,"E")
+73 IF PTYP'="T"
SET VALUE=$$GET1^DIQ(90505.1151,IENS,.01,"E")
+74 IF PTYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+75 SET FILTER(N,NN)=VALUE
+76 ; Check for associated parameters
+77 SET ASN=0
+78 FOR
SET ASN=$ORDER(^BQICARE(OWNR,1,PLIEN,15,N,1,NN,2,ASN))
IF 'ASN
QUIT
Begin DoDot:3
+79 NEW DA,IENS,ASSOC,AVALUE,VALUE
+80 SET DA(4)=OWNR
SET DA(3)=PLIEN
SET DA(2)=N
SET DA(1)=NN
SET DA=ASN
SET IENS=$$IENS^DILF(.DA)
+81 SET ASSOC=$$GET1^DIQ(90505.11512,IENS,.01,"E")
+82 SET ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
+83 SET FILTER(N,NN,ASN)=ASSOC
+84 IF '$DATA(^BQICARE(OWNR,1,PLIEN,15,N,1,NN,2,ASN,1))
Begin DoDot:4
+85 IF ATYP="T"
SET VALUE=$$GET1^DIQ(90505.11512,IENS,.03,"E")
+86 IF ATYP'="T"
SET VALUE=$$GET1^DIQ(90505.11512,IENS,.02,"E")
+87 IF ATYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+88 SET FILTER(N,NN,ASN,1)=VALUE
End DoDot:4
QUIT
+89 SET MSN=0
+90 FOR
SET MSN=$ORDER(^BQICARE(OWNR,1,PLIEN,15,N,1,NN,2,ASN,1,MSN))
IF 'MSN
QUIT
Begin DoDot:4
+91 NEW DA,IENS,VALUE
+92 SET DA(5)=OWNR
SET DA(4)=PLIEN
SET DA(3)=N
SET DA(2)=NN
SET DA(1)=ASN
SET DA=MSN
SET IENS=$$IENS^DILF(.DA)
+93 IF ATYP="T"
SET VALUE=$$GET1^DIQ(90505.115121,IENS,.02,"E")
+94 IF ATYP'="T"
SET VALUE=$$GET1^DIQ(90505.115121,IENS,.01,"E")
+95 IF ATYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+96 SET FILTER(N,NN,ASN,MSN)=VALUE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+97 ;
+98 ; Build PARMS
+99 SET PM=""
+100 FOR
SET PM=$ORDER(FILTER(PM))
IF PM=""
QUIT
Begin DoDot:1
+101 SET NAME=FILTER(PM)
SET PARMS=$GET(PARMS)_NAME_"="
+102 SET VM=""
+103 FOR
SET VM=$ORDER(FILTER(PM,VM))
IF VM=""
QUIT
Begin DoDot:2
+104 SET AN=""
+105 FOR
SET AN=$ORDER(FILTER(PM,VM,AN))
IF AN=""
QUIT
Begin DoDot:3
+106 SET MM=""
SET MASP=""
+107 FOR
SET MM=$ORDER(FILTER(PM,VM,AN,MM))
IF MM=""
QUIT
Begin DoDot:4
+108 SET MASP=$GET(MASP)_FILTER(PM,VM,AN,MM)_$CHAR(24)
End DoDot:4
+109 SET MASP=$$TKO^BQIUL1(MASP,$CHAR(24))
+110 SET ASPM=FILTER(PM,VM,AN)_"="_MASP
+111 SET MPRM(VM)=$SELECT(AN'<2:$$TKO^BQIUL1(MPRM(VM),$CHAR(29)),1:FILTER(PM,VM))_$CHAR(25)_ASPM_$CHAR(29)
End DoDot:3
+112 IF '$DATA(MPRM(VM))
SET MPRM(VM)=FILTER(PM,VM)_$CHAR(29)
End DoDot:2
+113 SET NM=""
+114 FOR
SET NM=$ORDER(MPRM(NM))
IF NM=""
QUIT
SET PARMS=PARMS_MPRM(NM)
+115 SET PARMS=$$TKO^BQIUL1(PARMS,$CHAR(29))
+116 SET PARMS=PARMS_$CHAR(28)
+117 KILL MPRM
End DoDot:1
+118 ;
+119 SET II=II+1
+120 SET PARMS=$$TKO^BQIUL1(PARMS,$CHAR(28))
+121 ;S PARMS=$$TKO^BQIUL1(PARMS,$C(29))
+122 SET @DATA@(II)=PARMS_$CHAR(30)
+123 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
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,OWNR,PLIEN,PARMS) ; EP -- BQI SET PANEL FILTERS
+1 ;
+2 ;Description
+3 ; Update or set the filter parameters
+4 ;Input
+5 ; OWNR = Owner of panel IEN
+6 ; PLIEN = Panel internal entry number
+7 ; PARMS = Filter parameters (if NULL, deletes ALL)
+8 ; if PARMS contain a $C(29), then that is
+9 ; a multiple value parameter
+10 ;
+11 NEW UID,II,X,BN,FSOURCE,PPIEN,PTYP,BQ,BQIUPD,PDATA,MVAL,PDA,QFL,ACT
+12 NEW ASDATA,ASNAME,ASV,AVAL,AVCT,BQQ,CT,MBQ,MVN,RESULT,VAL
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQIPLFL",UID))
+15 KILL @DATA
+16 ;
+17 ; Check if share and has write access
+18 IF '$$CKSHR^BQIPLSH(OWNR,PLIEN)
SET BMXSEC="You do not have write access"
QUIT
+19 ;
CV ;EP
+1 SET II=0
+2 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPLFL D UNWIND^%ZTER"
+3 ;
+4 SET PARMS=$GET(PARMS,"")
SET RESULT=1
+5 SET @DATA@(II)="I00010RESULT^T00050MSG"_$CHAR(30)
+6 ;
+7 DO DEL(.OWNR,.PLIEN)
+8 ;
+9 NEW DA,IENS
+10 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+11 SET FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
+12 ;
+13 ; Find definition panel
+14 IF FSOURCE=""
GOTO DONE
+15 SET PPIEN=$$PP^BQIDCDF(FSOURCE)
IF PPIEN=-1
SET BMXSEC="Pre-defined panel type "_FSOURCE_" was not found"
QUIT
+16 ;
+17 SET PARMS=$GET(PARMS,"")
+18 IF PARMS=""
Begin DoDot:1
+19 SET LIST=""
SET BN=""
+20 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+21 KILL PARMS
+22 SET PARMS=LIST
+23 KILL LIST
End DoDot:1
+24 ;
+25 KILL FILTER
+26 SET QFL=0
+27 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
IF $PIECE(PARMS,$CHAR(28),BQ)'=""
SET FILTER(BQ)=$PIECE(PARMS,$CHAR(28),BQ)
+28 FOR BQQ=1:1:BQ
Begin DoDot:1
+29 SET PDATA=$GET(FILTER(BQQ))
IF PDATA=""
QUIT
+30 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+31 SET FDATA(BQQ)=NAME
+32 FOR II=1:1:$LENGTH(VALUE,$CHAR(29))
Begin DoDot:2
+33 SET VAL=$PIECE(VALUE,$CHAR(29),II)
SET ASSOC=$PIECE(VAL,$CHAR(25),2,99)
+34 SET FILTER(BQQ,II)=$PIECE(VAL,$CHAR(25),1)
+35 IF ASSOC'=""
Begin DoDot:3
+36 FOR ASN=1:1:$LENGTH(ASSOC,$CHAR(25))
Begin DoDot:4
+37 SET ASDATA=$PIECE(ASSOC,$CHAR(25),ASN)
+38 SET ASVAL=$PIECE(ASDATA,"=",2,99)
SET ASNAME=$PIECE(ASDATA,"=",1)
+39 SET FILTER(BQQ,II,ASN)=ASNAME
+40 IF ASVAL'[$CHAR(24)
SET FILTER(BQQ,II,ASN,1)=ASVAL
QUIT
+41 FOR ASV=1:1:$LENGTH(ASVAL,$CHAR(24))
SET FILTER(BQQ,II,ASN,ASV)=$PIECE(ASVAL,$CHAR(24),ASV)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+42 FOR BQQ=1:1:BQ
SET FILTER(BQQ)=FDATA(BQQ)
+43 KILL FDATA
+44 ;
+45 ; Store the filter data
+46 SET BQQ=""
+47 FOR
SET BQQ=$ORDER(FILTER(BQQ))
IF BQQ=""
QUIT
Begin DoDot:1
+48 SET NAME=FILTER(BQQ)
+49 SET PTYP=$$PTYP^BQIDCDF(FSOURCE,NAME)
+50 ; Create parameter entry
+51 NEW DA,IENS,DIC,DLAYGO
+52 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET X=NAME
+53 SET DLAYGO=90505.115
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+54 SET DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",15,"
+55 IF '$DATA(^BQICARE(DA(2),1,DA(1),15,0))
SET ^BQICARE(DA(2),1,DA(1),15,0)="^90505.115^^"
+56 KILL DO,DD
DO FILE^DICN
+57 SET PDA=+Y
+58 IF PDA=-1
SET RESULT=-1
SET QFL=1
QUIT
+59 ;
+60 SET MBQ=""
SET CT=1
+61 FOR
SET MBQ=$ORDER(FILTER(BQQ,MBQ))
IF MBQ=""
QUIT
Begin DoDot:2
+62 ; If there are no multiple values, store and quit
+63 SET VALUE=FILTER(BQQ,MBQ)
+64 IF $ORDER(FILTER(BQQ,MBQ))=""
IF CT=1
DO PMSV(OWNR,PLIEN,PDA,VALUE,PTYP)
QUIT
+65 DO PMMV(OWNR,PLIEN,PDA,VALUE,PTYP)
+66 SET CT=CT+1
+67 ;
End DoDot:2
End DoDot:1
+68 ;
+69 SET II=II+1
SET @DATA@(II)=RESULT_U_$CHAR(30)
+70 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+71 DO DSC
+72 QUIT
+73 ;
PMSV(BOWNR,BPLIEN,BDA,BVALUE,BTYP) ;EP Store singular parameter value
+1 NEW DA,IENS
+2 SET DA(2)=BOWNR
SET DA(1)=BPLIEN
SET DA=BDA
+3 SET IENS=$$IENS^DILF(.DA)
+4 IF BTYP="D"
SET BVALUE=$$DATE^BQIUL1(BVALUE)
+5 IF BTYP="T"
SET BQIUPD(90505.115,IENS,.03)=BVALUE
+6 IF BTYP'="T"
SET BQIUPD(90505.115,IENS,.02)=BVALUE
+7 DO FILE^DIE("","BQIUPD","ERROR")
+8 ; Check if there are associated parameters
+9 DO CKAS
+10 QUIT
+11 ;
PMMV(BOWNR,BPLIEN,BDA,BVAL,BTYP) ;EP
+1 NEW DA,IENS,DIC,DLAYGO
+2 SET DA(3)=BOWNR
SET DA(2)=BPLIEN
SET DA(1)=BDA
SET X=BVAL
+3 SET DLAYGO=90505.1151
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+4 SET DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",15,"_DA(1)_",1,"
+5 KILL DO,DD
DO FILE^DICN
+6 SET (DA,MDA)=+Y
+7 IF DA=-1
SET RESULT=-1
SET QFL=1
QUIT
+8 SET IENS=$$IENS^DILF(.DA)
+9 IF BTYP="D"
SET BVAL=$$DATE^BQIUL1(BVAL)
+10 IF BTYP="T"
SET BQIUPD(90505.1151,IENS,.02)=BVAL
+11 IF BTYP'="T"
SET BQIUPD(90505.1151,IENS,.01)=BVAL
+12 DO FILE^DIE("","BQIUPD","ERROR")
+13 ; Check if there are associated parameters
+14 DO CKAM
+15 QUIT
+16 ;
SASV(AOWNR,APLIEN,PDA,ADA,VALUE,PTYP) ;EP Single associated parameter
+1 ; Input
+2 ; AOWNR - Panel Owner
+3 ; APLIEN - Panel IEN
+4 ; PDA - Parameter record
+5 ; ADA - Associated parameter record
+6 ; VALUE - Value
+7 ; PTYP - Associate parameter type
+8 NEW DA,IENS
+9 SET DA(3)=AOWNR
SET DA(2)=APLIEN
SET DA(1)=PDA
SET DA=ADA
+10 SET IENS=$$IENS^DILF(.DA)
+11 IF PTYP="D"
SET VALUE=$$DATE^BQIUL1(VALUE)
+12 IF PTYP="T"
SET BQIUPD(90505.1152,IENS,.03)=VALUE
+13 IF PTYP'="T"
SET BQIUPD(90505.1152,IENS,.02)=VALUE
+14 DO FILE^DIE("","BQIUPD","ERROR")
+15 QUIT
+16 ;
MASV(AOWNR,APLIEN,ADA,ASDA,ASVAL,ASTYP) ;EP Multiple associated parameter values
+1 NEW DA,IENS,DIC,DLAYGO
+2 SET DA(4)=AOWNR
SET DA(3)=APLIEN
SET DA(2)=ADA
SET DA(1)=ASDA
SET X=ASVAL
+3 SET DLAYGO=90505.11521
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+4 SET DIC="^BQICARE("_DA(4)_",1,"_DA(3)_",15,"_DA(2)_",2,"_DA(1)_",1,"
+5 IF '$DATA(^BQICARE(DA(4),1,DA(3),15,DA(2),2,DA(1),1,0))
SET ^BQICARE(DA(4),1,DA(3),15,DA(2),2,DA(1),1,0)="^90505.11521^^"
+6 KILL DO,DD
DO FILE^DICN
+7 SET DA=+Y
+8 IF DA=-1
SET RESULT=-1
SET QFL=1
QUIT
+9 SET IENS=$$IENS^DILF(.DA)
+10 IF ASTYP="D"
SET ASVAL=$$DATE^BQIUL1(ASVAL)
+11 IF ASTYP="T"
SET BQIUPD(90505.11521,IENS,.02)=ASVAL
+12 IF ASTYP'="T"
SET BQIUPD(90505.11521,IENS,.01)=ASVAL
+13 DO FILE^DIE("","BQIUPD","ERROR")
+14 QUIT
+15 ;
DSC ;EP Generate panel description to include any filters
+1 NEW DA,IENS
+2 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+3 KILL DESC
+4 DO DESC^BQIPDSCM(OWNR,PLIEN,.DESC)
+5 ;D PEN^BQIPLDSC(OWNR,PLIEN,.DESC)
+6 DO WP^DIE(90505.01,IENS,5,"","DESC")
+7 KILL DESC
+8 QUIT
+9 ;
DEL(OWNR,PLIEN) ;EP - Remove the previous filter parameters
+1 NEW DA,IENS,DIK
+2 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=0
+3 SET DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",15,"
+4 FOR
SET DA=$ORDER(^BQICARE(OWNR,1,PLIEN,15,DA))
IF 'DA
QUIT
DO ^DIK
+5 QUIT
+6 ;
CKAS ;EP Check for associated parameters for a single parameter
+1 SET ASN=""
SET ACT=1
+2 FOR
SET ASN=$ORDER(FILTER(BQQ,MBQ,ASN))
IF ASN=""
QUIT
Begin DoDot:1
+3 ; Check for multiple associated parameters
+4 SET ASSOC=FILTER(BQQ,MBQ,ASN)
+5 NEW DA,DIC,DLAYGO
+6 SET DA(3)=BOWNR
SET DA(2)=BPLIEN
SET DA(1)=BDA
SET X=ASSOC
+7 SET ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
+8 SET DLAYGO=90505.1152
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+9 SET DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",15,"_DA(1)_",2,"
+10 IF '$DATA(^BQICARE(DA(3),1,DA(2),15,DA(1),2,0))
SET ^BQICARE(DA(3),1,DA(2),15,DA(1),2,0)="^90505.1152^^"
+11 KILL DO,DD
DO FILE^DICN
+12 SET (DA,ADA)=+Y
+13 IF DA=-1
SET RESULT=-1
SET QFL=1
QUIT
+14 SET MVN=""
SET AVCT=1
+15 FOR
SET MVN=$ORDER(FILTER(BQQ,MBQ,ASN,MVN))
IF MVN=""
QUIT
Begin DoDot:2
+16 SET AVAL=FILTER(BQQ,MBQ,ASN,MVN)
+17 ; If single associated parameter value
+18 IF $ORDER(FILTER(BQQ,MBQ,ASN,MVN))=""
IF AVCT=1
DO SASV(BOWNR,BPLIEN,BDA,ADA,AVAL,ATYP)
QUIT
+19 ; If multiple associated parameter values
+20 DO MASV(BOWNR,BPLIEN,BDA,ADA,AVAL,ATYP)
+21 SET AVCT=AVCT+1
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
CKAM ;EP
+1 SET ASN=""
SET ACT=1
+2 FOR
SET ASN=$ORDER(FILTER(BQQ,MBQ,ASN))
IF ASN=""
QUIT
Begin DoDot:1
+3 ; Check for multiple associated parameters
+4 SET ASSOC=FILTER(BQQ,MBQ,ASN)
+5 NEW DA,DIC,DLAYGO
+6 SET DA(4)=BOWNR
SET DA(3)=BPLIEN
SET DA(2)=BDA
SET DA(1)=MDA
SET X=ASSOC
+7 SET ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
+8 SET DLAYGO=90505.11512
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+9 SET DIC="^BQICARE("_DA(4)_",1,"_DA(3)_",15,"_DA(2)_",1,"_DA(1)_",2,"
+10 IF '$DATA(^BQICARE(DA(4),1,DA(3),15,DA(2),1,DA(1),2,0))
SET ^BQICARE(DA(4),1,DA(3),15,DA(2),1,DA(1),2,0)="^90505.11512^^"
+11 KILL DO,DD
DO FILE^DICN
+12 SET (DA,ADA)=+Y
+13 IF DA=-1
SET RESULT=-1
SET QFL=1
QUIT
+14 SET MVN=""
SET AVCT=1
+15 FOR
SET MVN=$ORDER(FILTER(BQQ,MBQ,ASN,MVN))
IF MVN=""
QUIT
Begin DoDot:2
+16 SET AVAL=FILTER(BQQ,MBQ,ASN,MVN)
+17 ; If single associated parameter value
+18 IF $ORDER(FILTER(BQQ,MBQ,ASN,MVN))=""
IF AVCT=1
DO MPSV(BOWNR,BPLIEN,BDA,MDA,ADA,AVAL,ATYP)
QUIT
+19 ; If multiple associated parameter values
+20 DO MPMV(BOWNR,BPLIEN,BDA,MDA,ADA,AVAL,ATYP)
+21 SET AVCT=AVCT+1
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
MPSV(AOWNR,APLIEN,PDA,MPDA,ASDA,VALUE,PTYP) ;EP
+1 NEW DA,IENS
+2 SET DA(4)=AOWNR
SET DA(3)=APLIEN
SET DA(2)=PDA
SET DA(1)=MPDA
SET DA=ASDA
+3 SET IENS=$$IENS^DILF(.DA)
+4 IF PTYP="D"
SET VALUE=$$DATE^BQIUL1(VALUE)
+5 IF PTYP="T"
SET BQIUPD(90505.11512,IENS,.03)=VALUE
+6 IF PTYP'="T"
SET BQIUPD(90505.11512,IENS,.02)=VALUE
+7 DO FILE^DIE("","BQIUPD","ERROR")
+8 QUIT
+9 ;
MPMV(AOWNR,APLIEN,BDA,MDA,ADA,ASVAL,ATYP) ;EP
+1 NEW DA,IENS,DIC,DLAYGO
+2 SET DA(5)=AOWNR
SET DA(4)=APLIEN
SET DA(3)=BDA
SET DA(2)=MDA
SET DA(1)=ADA
SET X=ASVAL
+3 SET DLAYGO=90505.115121
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+4 SET DIC="^BQICARE("_DA(5)_",1,"_DA(4)_",15,"_DA(3)_",1,"_DA(2)_",2,"_DA(1)_",1,"
+5 IF '$DATA(^BQICARE(DA(5),1,DA(4),15,DA(3),1,DA(2),2,DA(1),1,0))
SET ^BQICARE(DA(5),1,DA(4),15,DA(3),1,DA(2),2,DA(1),1,0)="^90505.115121^^"
+6 KILL DO,DD
DO FILE^DICN
+7 SET DA=+Y
+8 IF DA=-1
SET RESULT=-1
SET QFL=1
QUIT
+9 SET IENS=$$IENS^DILF(.DA)
+10 IF ATYP="D"
SET ASVAL=$$DATE^BQIUL1(ASVAL)
+11 IF ATYP="T"
SET BQIUPD(90505.115121,IENS,.02)=ASVAL
+12 IF ATYP'="T"
SET BQIUPD(90505.115121,IENS,.01)=ASVAL
+13 DO FILE^DIE("","BQIUPD","ERROR")
+14 QUIT
+15 ;
SAVL(BOWNR,BPLIEN,BDA,MDA,ASSOC,AVAL,ATYP) ;EP - Add an assoc parameter to a multiple API
+1 NEW DA,DIC,DLAYGO
+2 SET DA(4)=BOWNR
SET DA(3)=BPLIEN
SET DA(2)=BDA
SET DA(1)=MDA
SET X=ASSOC
+3 SET DLAYGO=90505.11512
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+4 SET DIC="^BQICARE("_DA(4)_",1,"_DA(3)_",15,"_DA(2)_",1,"_DA(1)_",2,"
+5 IF '$DATA(^BQICARE(DA(4),1,DA(3),15,DA(2),1,DA(1),2,0))
SET ^BQICARE(DA(4),1,DA(3),15,DA(2),1,DA(1),2,0)="^90505.11512^^"
+6 KILL DO,DD
DO FILE^DICN
+7 SET (DA,ADA)=+Y
+8 DO MPSV(BOWNR,BPLIEN,BDA,MDA,ADA,AVAL,ATYP)
+9 QUIT ADA
+10 ;
CON(DATA,OWNR,PLIEN,PARMS) ;EP - For 2.2 conversion
+1 NEW UID,II,X,BN,FSOURCE,PPIEN,PTYP,BQ,BQIUPD,PDATA,MVAL,PDA,QFL,ACT
+2 NEW ASDATA,ASNAME,ASV,AVAL,AVCT,BQQ,CT,MBQ,MVN,RESULT,VAL,FILTER
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIPLFL",UID))
+5 KILL @DATA
+6 DO CV
+7 QUIT
