BQIPDSCM ;VNGT/HS/BEE-Panel Description Utility ; 7 Apr 2008 4:28 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
Q
;
DESC(OWNR,PLIEN,DESC) ;EP - Format Panel Generated Description
;
; Input:
; OWNR - The panel owner
; PLIEN - The panel IEN
;
; Output:
; DESC - Array containing the generated panel description
;
NEW DA,IENS,TYPE,SOURCE,MPARMS,PARMS,FILTER,FSOURCE,FPARMS,TDESC,IPC,PCAT
;
S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
S TYPE=$$GET1^DIQ(90505.01,IENS,.03,"I")
S SOURCE=$$GET1^DIQ(90505.01,IENS,.11,"I")
S FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
;
;Set Up Parameter Section
;
;Manual Patients
I TYPE="M" S DESC(1,0)="The patients who were selected manually"
;
;QMAN Template
I TYPE="Q" S DESC(1,0)="Search Template "_$P($G(^DIBT(SOURCE,0)),U,1)
;
;My Panel - User preferences Definition
I TYPE="Y" D
. NEW MPIEN,PFLD,SOURCE,TDESC,PMAP
. S MPIEN=0 F S MPIEN=$O(^BQICARE(OWNR,7,MPIEN)) Q:'MPIEN D
.. S SOURCE=$G(^BQICARE(OWNR,7,MPIEN,0))
.. S PFLD=0 F S PFLD=$O(^BQICARE(OWNR,7,MPIEN,10,PFLD)) Q:'PFLD D
... ;
... NEW DA,IENS,PNAM,PTYP,VALUE,FILE,PEXE,MUL,OPNAM
... S DA(2)=OWNR,DA(1)=MPIEN,DA=PFLD,IENS=$$IENS^DILF(.DA)
... ;
... ;Pull parameter information
... S (OPNAM,PNAM)=$$GET1^DIQ(90505.08,IENS,".01","E") Q:PNAM=""
... S PTYP=$$PTYP^BQIDCDF(SOURCE,PNAM)
... I PTYP="T" D
.... S VALUE=$$GET1^DIQ(90505.08,IENS,.03,"E")
.... S FILE=$$FILN^BQIDCDF(SOURCE,PNAM) Q:FILE=""
.... S VALUE=$$GET1^DIQ(FILE,VALUE,.01,"E")
... I PTYP'="T" S VALUE=$$GET1^DIQ(90505.08,IENS,.02,"E")
... S PMAP=$$PMAP^BQIDCDF(SOURCE,PNAM) I PMAP]"" D MAP(SOURCE,PMAP,.VALUE,.PNAM)
... S PEXE=$$PEXE^BQIDCDF(SOURCE,PNAM) I VALUE]"",PEXE]"" X PEXE
... ;
... ;Single value save
... I VALUE]"" S PARMS(PNAM,$$TRUNC(VALUE))="" Q
... ;
... ;Multiple value save
... S MUL=0 F S MUL=$O(^BQICARE(OWNR,7,MPIEN,10,PFLD,1,MUL)) Q:'MUL D
.... NEW DA,IENS,VALUE
.... S DA(3)=OWNR,DA(2)=MPIEN,DA(1)=PFLD,DA=MUL,IENS=$$IENS^DILF(.DA)
.... S PNAM=OPNAM
.... I PTYP="T" D
..... S VALUE=$$GET1^DIQ(90505.81,IENS,.01,"E")
..... S FILE=$$FILN^BQIDCDF(SOURCE,PNAM) Q:FILE=""
..... S VALUE=$$GET1^DIQ(FILE,VALUE,.01,"E")
.... I PTYP'="T" S VALUE=$$GET1^DIQ(90505.81,IENS,.01,"E")
.... I VALUE]"",PMAP]"" D MAP(SOURCE,PMAP,.VALUE,.PNAM)
.... I VALUE]"",PEXE]"" X PEXE
.... I VALUE]"" S PARMS(PNAM,$$TRUNC(VALUE))=""
. ;
. ;Assemble parameter description
. D PDESC(TYPE,"MY PATIENTS-DESCRIPTION",.TDESC,.PARMS)
. S DESC(1,0)=$G(TDESC)
. Q
;
;Other Panel Types
I ".M.Q.Y."'[TYPE D
. ;
. I SOURCE="" Q
. ;
. NEW PPIEN,PMIEN
. S PPIEN=$$PP^BQIDCDF(SOURCE) I PPIEN=-1 Q
. ;
. ; Get parameters from panel definition
. S PMIEN=0 F S PMIEN=$O(^BQICARE(OWNR,1,PLIEN,10,PMIEN)) Q:'PMIEN D
.. ;
.. NEW DA,PNAM,PTYP,VALUE,FILE,MUL,PEXE,OPNAM,PMAP
.. S DA(2)=OWNR,DA(1)=PLIEN,DA=PMIEN,IENS=$$IENS^DILF(.DA)
.. S (OPNAM,PNAM)=$$GET1^DIQ(90505.02,IENS,.01,"E")
.. S PTYP=$$PTYP^BQIDCDF(SOURCE,PNAM)
.. I PTYP="T" D
... S VALUE=$$GET1^DIQ(90505.02,IENS,.03,"E")
... S FILE=$$FILN^BQIDCDF(SOURCE,PNAM) Q:FILE=""
... S VALUE=$$GET1^DIQ(FILE,VALUE,.01,"E")
.. I PTYP'="T" S VALUE=$$GET1^DIQ(90505.02,IENS,.02,"E")
.. I PTYP="D" S VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1))
.. I PTYP="R" D
... I VALUE["T" S VALUE=$$DATE^BQIUL1(VALUE),VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1)) Q
... D RANGE^BQIDCAH1(VALUE,PPIEN,PNAM) D
.... S VALUE=VALUE_" ("_$$FMTE^BQIUL1(RFROM)_"-"_$$FMTE^BQIUL1(RTHRU)_")"
... ;
.. S PMAP=$$PMAP^BQIDCDF(SOURCE,PNAM) I VALUE]"",PMAP]"" D MAP(SOURCE,PMAP,.VALUE,.PNAM)
.. S PEXE=$$PEXE^BQIDCDF(SOURCE,PNAM) I VALUE]"",PEXE]"" X PEXE
.. ;
.. ;Single value save
.. I VALUE]"" S PARMS(PNAM,$$TRUNC(VALUE))="" Q
.. ;
.. ;Multiple value save
.. S MUL=0 F S MUL=$O(^BQICARE(OWNR,1,PLIEN,10,PMIEN,1,MUL)) Q:'MUL D
... NEW DA,IENS,VALUE
... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=PMIEN,DA=MUL,IENS=$$IENS^DILF(.DA)
... S PNAM=OPNAM
... I PTYP="T" D
.... S VALUE=$$GET1^DIQ(90505.21,IENS,.01,"E")
.... S FILE=$$FILN^BQIDCDF(SOURCE,PNAM) Q:FILE=""
.... S VALUE=$$GET1^DIQ(FILE,VALUE,.01,"E")
... I PTYP'="T" S VALUE=$$GET1^DIQ(90505.21,IENS,.01,"E")
... I PTYP="D" S VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1))
... I PTYP="R" D
.... I VALUE["T" S VALUE=$$DATE^BQIUL1(VALUE),VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1)) Q
.... ;S VALUE=$$DATE^BQIUL1(VALUE)
.... ;S VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1))
... I VALUE]"",PMAP]"" D MAP(SOURCE,PMAP,.VALUE,.PNAM)
... I VALUE]"",PEXE]"" X PEXE
... I VALUE]"" S PARMS(PNAM,$$TRUNC(VALUE))=""
.. Q
. ;Assemble parameter description
. D PDESC(TYPE,SOURCE,.TDESC,.PARMS)
. I $L(TDESC)<70 S DESC(1,0)=$G(TDESC) Q
. D WP(TDESC,.DESC)
;
;Retrieve filter information
D FILTER^BQIPDSCF(OWNR,PLIEN,.FPARMS)
;
;Assemble filter description
I $D(FPARMS) D
. I SOURCE["AD HOC",FSOURCE="FILTER" K X,DESC
. D FDESC(.DESC,.FPARMS)
;
;Pull category and IPC Flag
D CATIPC(OWNR,PLIEN,.DESC)
;
Q
;
TRUNC(VAL) ;EP - Truncate value to 255
;
Q:$L(VAL)<256 VAL
Q $E(VAL,1,252)_"..."
;
WP(TEXT,DESC) ;EP - update description text
NEW DIWL,DIWR,BQN
K ^UTILITY($J,"W")
S DIWL=1,DIWR=45
I '$D(DESC) D
. S X=TEXT
. D ^DIWP
. S BQN=""
. F S BQN=$O(^UTILITY($J,"W",1,BQN)) Q:BQN="" S DESC(BQN,0)=^UTILITY($J,"W",1,BQN,0)
Q
;
CNT(PARM) ;EP - Return number of entries for specific parameter
I PARM="" Q 0
I $G(PARMS(PARM))="" Q 0
Q $L(PARMS(PARM),",")
;
FCNT(FPRM) ;EP - Return if filter is defined for panel
;
N PORD
I FPRM="" Q 0
I $D(FPARMS("VAL",FPRM)) Q $L(FPARMS("VAL",FPRM),", ")
Q 0
;
PCNT(PRM) ;EP - Return if parameter is defined for panel
I PRM="" Q 0
I $D(PARMS(PRM)) Q $L(PARMS(PRM),", ")
Q 0
;
CATIPC(OWNR,PLIEN,DESC) ;EP - Add in category and IPC status
NEW PCAT,PIPC,DA,IENS,DII
;
S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
S PCAT=$$PCAT^BQIPLDF(OWNR,PLIEN) ;$$GET1^DIQ(90505.01,IENS,2.2,"I")
S PIPC=$$GET1^DIQ(90505.01,IENS,2.1,"I")
;
S DA(1)=DUZ,DA=PCAT,IENS=$$IENS^DILF(.DA)
S:PCAT]"" PCAT=$$GET1^DIQ(90505.017,IENS,.01,"I")
S:PCAT="" PCAT="N/A"
S PIPC=$S(PIPC="1":"Yes",1:"No")
S DII=$O(DESC(""),"-1") S DII=$G(DII)+1
S DESC(DII,0)="Panel Category: "_PCAT_" IPC Panel: "_PIPC_"; "
;
Q
;
MAP(SOURCE,PMAP,VALUE,PNAM) ;EP - Map one value to another
;
NEW PDEF,FIEN,MAP,I,PC,FND
;
S PDEF=$$PP^BQIDCDF(SOURCE) Q:PDEF=""
;
S FIEN=$O(^BQI(90506,PDEF,3,"B",PMAP,"")) Q:FIEN=""
;
S FND=""
S MAP="" F S MAP=$O(^BQI(90506,PDEF,3,FIEN,3,"AC",MAP)) Q:MAP="" D Q:FND
. F I=1:1:$L(MAP,"~") S PC=$P(MAP,"~",I) I PC]"" D Q:FND
.. NEW VAR,VAL,CIEN,DA,IEN
.. S VAR=$P(PC,"=") Q:VAR=""
.. S VAL=$P(PC,"=",2) Q:VAL=""
.. Q:VAR'=PNAM
.. Q:VAL'=VALUE
.. S CIEN=$O(^BQI(90506,PDEF,3,FIEN,3,"AC",MAP,"")) Q:CIEN=""
.. S DA(2)=PDEF,DA(1)=FIEN,DA=CIEN,IEN=$$IENS^DILF(.DA)
.. S VALUE=$$GET1^DIQ(90506.33,IEN,.01,"E"),PNAM=PMAP,FND=1
;
Q
;
PVST(TYPE) ;EP - Assemble primary secondary visit description section
;
I TYPE="PRIM",$D(PARMS("PVISITS")) D PSVST("PRIM",PARMS("PVISITS"),$G(PARMS("PTMFRAME")),.PARMS)
I TYPE="PRSC",$D(PARMS("PSVISITS")) D PSVST("PRSC",PARMS("PSVISITS"),$G(PARMS("PSTMFRAM")),.PARMS)
Q
;
PSVST(BQITYPE,BQIVST,BQITIME,BQIMPRM) ;EP - Assemble Primary/Secondary Provider Visit Checks
;
;Description: This tag receives primary or secondary visit check information and moves it into
; the multiple field "TYPE" node so it will be included with the other specialties.
;
;Parameters:
;BQITYPE = "PRIM" - Primary or "PRSC" - Primary/Secondary
;BQIVST = # of visits parameter
;BQITIME = Date Range
;BQIMPRM = Passed in MPARMS array. Gets updated with visit check description
;
;
N STR
I BQITYPE=""!(BQIVST="")!(BQITIME="") Q
;
;Assemble Visit Check Description
S STR=BQIVST
S STR=STR_" "_$S(BQITYPE="PRIM":"Primary Visit Provider",1:"Primary/Secondary Visit Provider")
S STR=STR_" "_$S(BQIVST>1:"visits",1:"visit")
;Now added in executable string
;I $G(BQITIME)]"" S STR=STR_" in "_$S(BQITIME="T-24M":"2 years",BQITIME="T-12M":"1 year",1:$P(BQITIME,"T-",2))
S BE=$G(BE)+1,BE(BE)=BQITYPE_U_BQITIME
;
;Save New Entry With Visit Check Description
S BQIMPRM(BQITYPE)=STR
Q
;
EHPL ;EP - Format EHR Personal List
NEW EHPLIEN,EHVAL,PC
S EHVAL=""
F PC=1:1:$L(PARMS("EHRPLIEN"),", ") S EHPLIEN=$P(PARMS("EHRPLIEN"),", ",PC) D
. NEW EHPL
. S EHPL=$$GETNAME^BEHOPTP2(EHPLIEN)
. S EHVAL=$G(EHVAL)_EHPL_","
S EHVAL=$$TKO^BQIUL1(EHVAL,",")
S:EHVAL]"" PARMS("EHRPLIEN")=EHVAL
Q
;
REG ;EP - Format RPMS Register Panel Information
N REGIEN,REGNMSP
I '$D(PARMS("REG")) Q
S REGIEN=$O(^BQI(90507,"B",PARMS("REG"),""))
I REGIEN="" Q
S REGNMSP=$$GET1^DIQ(90507,REGIEN_",",.13,"E")
I REGNMSP'="" S PARMS("NMSP")=REGNMSP
I $G(PARMS("SUBREG"))'="" D
. N SBIEN,SBREG
. S SBIEN=0 F S SBIEN=$O(^BQI(90507,SBIEN)) Q:'SBIEN D
.. S SBREG=$P($G(^BQI(90507,SBIEN,0)),U,9)
.. I SBREG=PARMS("SUBREG") D
... S REGNMSP=$$GET1^DIQ(90507,SBIEN_",",.13,"E")
... I REGNMSP'="" S PARMS("NMSP")=REGNMSP
Q
;
PRS(TDESC) ;EP - Parse description
S TDESC=$P(TDESC,"|",1)_$G(PARMS($P(TDESC,"|",2)))_$P(TDESC,"|",3,99)
Q
;
MPRS(TDESC) ;EP - Parse filter description
S TDESC=$P(TDESC,"|",1)_$G(FPARMS("VAL",$P(TDESC,"|",2)))_$P(TDESC,"|",3,99)
Q
;
PDESC(TYPE,SOURCE,TDESC,PARMS) ;EP - Assemble parameter description
N PPIEN,DSCEXE,DSC,PORD,PFIEN,PSORD
;
;Convert multiple values into single value
D MPARMS(.PARMS,"")
;
;Pull first part of description
S PPIEN=$$PP^BQIDCDF(SOURCE) I PPIEN=-1 Q
S DSC=""
S DSCEXE=$$GET1^DIQ(90506,PPIEN,6) I DSCEXE]"" X DSCEXE
S TDESC=DSC
;
;Loop through parameters for source and assemble description
S PORD="" F S PORD=$O(^BQI(90506,PPIEN,3,"C",PORD)) Q:PORD="" D
. S PFIEN=$O(^BQI(90506,PPIEN,3,"C",PORD,"")) Q:PFIEN=""
. ;
. ;Get description framework for parameter
. S DSC=""
. S PSORD="" F S PSORD=$O(^BQI(90506,PPIEN,3,PFIEN,5,"B",PSORD)) Q:PSORD="" D I DSC]"" Q
.. NEW PSIEN,PREXE
.. S PSIEN=$O(^BQI(90506,PPIEN,3,PFIEN,5,"B",PSORD,"")) Q:PSIEN=""
.. S PREXE=$G(^BQI(90506,PPIEN,3,PFIEN,5,PSIEN,1))
.. I PREXE]"" X PREXE
. S:DSC]"" TDESC=$G(TDESC)_DSC
;
;Populate values
F Q:'$F(TDESC,"|") D PRS(.TDESC)
;
Q
;
FDESC(PARMS,FPARMS) ;EP - Assemble filter description
NEW PPIEN,DSC,DSCEXE,TDESC,PORD,FPC,VAL,DII,PSORD,PFIEN,FNAME
;
;Convert multiple values into single value
D FPARMS(.FPARMS)
;
;Pull first part of description
S PPIEN=$$PP^BQIDCDF(FSOURCE) I PPIEN=-1 Q
S DSC=""
S DSCEXE=$$GET1^DIQ(90506,PPIEN,6) I DSCEXE]"" X DSCEXE
S TDESC=DSC
;
;Loop through parameters for source and assemble description
S PORD="" F S PORD=$O(FPARMS(PORD)) Q:'PORD D
. S FNAME="" F S FNAME=$O(FPARMS(PORD,FNAME)) Q:FNAME="" D
.. ;
.. S PFIEN=$O(^BQI(90506,PPIEN,3,"B",FNAME,"")) Q:PFIEN=""
.. ;
.. ;Get description framework for parameter
.. S DSC=""
.. S FPARMS("VAL",FNAME)=$G(FPARMS(PORD,FNAME))
.. K FPARMS(PORD,FNAME)
.. ;
.. S PSORD="" F S PSORD=$O(^BQI(90506,PPIEN,3,PFIEN,5,"B",PSORD)) Q:PSORD="" D I DSC]"" Q
... NEW PSIEN,PREXE
... S PSIEN=$O(^BQI(90506,PPIEN,3,PFIEN,5,"B",PSORD,"")) Q:PSIEN=""
... S PREXE=$G(^BQI(90506,PPIEN,3,PFIEN,5,PSIEN,1))
... I PREXE]"" X PREXE
.. S:DSC]"" TDESC=$G(TDESC)_DSC_"; "
S TDESC=$$TKO^BQIUL1(TDESC,"; ")
;
;Populate values
NEW FPC,DII
F Q:'$F(TDESC,"|") D MPRS(.TDESC)
F FPC=1:1:$L(TDESC,"; ") D
. NEW VAL
. S VAL=$P(TDESC,"; ",FPC) Q:FPC=""
. S DII=$O(DESC(""),"-1") S DII=$G(DII)+1
. S DESC(DII,0)=VAL_"; "
;
D WP(TDESC,.DESC)
Q
;
MPARMS(PARMS,DEL) ;EP - Convert multiple values into single value
;
; Input:
; PARMS - Array of current fields with their values
; DEL - Delimiter to put between entries
;
; Output:
; PARMS - Updated array which includes multiple values
; combined into single entries
;
NEW NAME
S DEL=$G(DEL,"") S:DEL="" DEL=", "
S NAME="" F S NAME=$O(PARMS(NAME)) Q:NAME="" D
. NEW VAL,VALS
. S VAL="",VALS=""
. F S VAL=$O(PARMS(NAME,VAL)) Q:VAL="" S VALS=VALS_VAL_$S($G(PARMS(NAME,VAL))]"":PARMS(NAME,VAL),1:DEL) K PARMS(NAME,VAL)
. S VALS=$$TKO^BQIUL1(VALS,DEL)
. S PARMS(NAME)=VALS
;
Q
;
FPARMS(FPARMS) ;EP - Convert multiple filter values into single value
;
; Input:
; FPARMS - Array of current fields with their values
;
; Output:
; FPARMS - Updated array which includes multiple values
; combined into single entries
;
NEW NAME,PORD
S PORD="" F S PORD=$O(FPARMS(PORD)) Q:PORD="" D
. S NAME="" F S NAME=$O(FPARMS(PORD,NAME)) Q:NAME="" D
.. NEW VAL,VALS,DLM,APOS
.. S VAL="",VALS="",APOS="'"
.. ;
.. ;Determine whether to add an apostrophe
.. S VAL=$O(FPARMS(PORD,NAME,VAL)) S:VAL="" APOS=""
.. S VAL=$O(FPARMS(PORD,NAME,VAL)) S:VAL="" APOS=""
.. S VAL="" F S VAL=$O(FPARMS(PORD,NAME,VAL)) Q:VAL="" D
... I NAME="DEC" S VALS=VALS_APOS_VAL_APOS_$S($G(FPARMS(PORD,NAME,VAL))]"":FPARMS(PORD,NAME,VAL),1:", ") K FPARMS(PORD,NAME,VAL) Q
... S VALS=VALS_APOS_VAL_APOS_$S($G(FPARMS(PORD,NAME,VAL))]"":FPARMS(PORD,NAME,VAL),1:" OR ") K FPARMS(PORD,NAME,VAL)
.. F DLM=", "," AND "," OR " S VALS=$$TKO^BQIUL1(VALS,DLM)
.. S FPARMS(PORD,NAME)=VALS
;
Q
BQIPDSCM ;VNGT/HS/BEE-Panel Description Utility ; 7 Apr 2008 4:28 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
+3 QUIT
+4 ;
DESC(OWNR,PLIEN,DESC) ;EP - Format Panel Generated Description
+1 ;
+2 ; Input:
+3 ; OWNR - The panel owner
+4 ; PLIEN - The panel IEN
+5 ;
+6 ; Output:
+7 ; DESC - Array containing the generated panel description
+8 ;
+9 NEW DA,IENS,TYPE,SOURCE,MPARMS,PARMS,FILTER,FSOURCE,FPARMS,TDESC,IPC,PCAT
+10 ;
+11 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+12 SET TYPE=$$GET1^DIQ(90505.01,IENS,.03,"I")
+13 SET SOURCE=$$GET1^DIQ(90505.01,IENS,.11,"I")
+14 SET FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
+15 ;
+16 ;Set Up Parameter Section
+17 ;
+18 ;Manual Patients
+19 IF TYPE="M"
SET DESC(1,0)="The patients who were selected manually"
+20 ;
+21 ;QMAN Template
+22 IF TYPE="Q"
SET DESC(1,0)="Search Template "_$PIECE($GET(^DIBT(SOURCE,0)),U,1)
+23 ;
+24 ;My Panel - User preferences Definition
+25 IF TYPE="Y"
Begin DoDot:1
+26 NEW MPIEN,PFLD,SOURCE,TDESC,PMAP
+27 SET MPIEN=0
FOR
SET MPIEN=$ORDER(^BQICARE(OWNR,7,MPIEN))
IF 'MPIEN
QUIT
Begin DoDot:2
+28 SET SOURCE=$GET(^BQICARE(OWNR,7,MPIEN,0))
+29 SET PFLD=0
FOR
SET PFLD=$ORDER(^BQICARE(OWNR,7,MPIEN,10,PFLD))
IF 'PFLD
QUIT
Begin DoDot:3
+30 ;
+31 NEW DA,IENS,PNAM,PTYP,VALUE,FILE,PEXE,MUL,OPNAM
+32 SET DA(2)=OWNR
SET DA(1)=MPIEN
SET DA=PFLD
SET IENS=$$IENS^DILF(.DA)
+33 ;
+34 ;Pull parameter information
+35 SET (OPNAM,PNAM)=$$GET1^DIQ(90505.08,IENS,".01","E")
IF PNAM=""
QUIT
+36 SET PTYP=$$PTYP^BQIDCDF(SOURCE,PNAM)
+37 IF PTYP="T"
Begin DoDot:4
+38 SET VALUE=$$GET1^DIQ(90505.08,IENS,.03,"E")
+39 SET FILE=$$FILN^BQIDCDF(SOURCE,PNAM)
IF FILE=""
QUIT
+40 SET VALUE=$$GET1^DIQ(FILE,VALUE,.01,"E")
End DoDot:4
+41 IF PTYP'="T"
SET VALUE=$$GET1^DIQ(90505.08,IENS,.02,"E")
+42 SET PMAP=$$PMAP^BQIDCDF(SOURCE,PNAM)
IF PMAP]""
DO MAP(SOURCE,PMAP,.VALUE,.PNAM)
+43 SET PEXE=$$PEXE^BQIDCDF(SOURCE,PNAM)
IF VALUE]""
IF PEXE]""
XECUTE PEXE
+44 ;
+45 ;Single value save
+46 IF VALUE]""
SET PARMS(PNAM,$$TRUNC(VALUE))=""
QUIT
+47 ;
+48 ;Multiple value save
+49 SET MUL=0
FOR
SET MUL=$ORDER(^BQICARE(OWNR,7,MPIEN,10,PFLD,1,MUL))
IF 'MUL
QUIT
Begin DoDot:4
+50 NEW DA,IENS,VALUE
+51 SET DA(3)=OWNR
SET DA(2)=MPIEN
SET DA(1)=PFLD
SET DA=MUL
SET IENS=$$IENS^DILF(.DA)
+52 SET PNAM=OPNAM
+53 IF PTYP="T"
Begin DoDot:5
+54 SET VALUE=$$GET1^DIQ(90505.81,IENS,.01,"E")
+55 SET FILE=$$FILN^BQIDCDF(SOURCE,PNAM)
IF FILE=""
QUIT
+56 SET VALUE=$$GET1^DIQ(FILE,VALUE,.01,"E")
End DoDot:5
+57 IF PTYP'="T"
SET VALUE=$$GET1^DIQ(90505.81,IENS,.01,"E")
+58 IF VALUE]""
IF PMAP]""
DO MAP(SOURCE,PMAP,.VALUE,.PNAM)
+59 IF VALUE]""
IF PEXE]""
XECUTE PEXE
+60 IF VALUE]""
SET PARMS(PNAM,$$TRUNC(VALUE))=""
End DoDot:4
End DoDot:3
End DoDot:2
+61 ;
+62 ;Assemble parameter description
+63 DO PDESC(TYPE,"MY PATIENTS-DESCRIPTION",.TDESC,.PARMS)
+64 SET DESC(1,0)=$GET(TDESC)
+65 QUIT
End DoDot:1
+66 ;
+67 ;Other Panel Types
+68 IF ".M.Q.Y."'[TYPE
Begin DoDot:1
+69 ;
+70 IF SOURCE=""
QUIT
+71 ;
+72 NEW PPIEN,PMIEN
+73 SET PPIEN=$$PP^BQIDCDF(SOURCE)
IF PPIEN=-1
QUIT
+74 ;
+75 ; Get parameters from panel definition
+76 SET PMIEN=0
FOR
SET PMIEN=$ORDER(^BQICARE(OWNR,1,PLIEN,10,PMIEN))
IF 'PMIEN
QUIT
Begin DoDot:2
+77 ;
+78 NEW DA,PNAM,PTYP,VALUE,FILE,MUL,PEXE,OPNAM,PMAP
+79 SET DA(2)=OWNR
SET DA(1)=PLIEN
SET DA=PMIEN
SET IENS=$$IENS^DILF(.DA)
+80 SET (OPNAM,PNAM)=$$GET1^DIQ(90505.02,IENS,.01,"E")
+81 SET PTYP=$$PTYP^BQIDCDF(SOURCE,PNAM)
+82 IF PTYP="T"
Begin DoDot:3
+83 SET VALUE=$$GET1^DIQ(90505.02,IENS,.03,"E")
+84 SET FILE=$$FILN^BQIDCDF(SOURCE,PNAM)
IF FILE=""
QUIT
+85 SET VALUE=$$GET1^DIQ(FILE,VALUE,.01,"E")
End DoDot:3
+86 IF PTYP'="T"
SET VALUE=$$GET1^DIQ(90505.02,IENS,.02,"E")
+87 IF PTYP="D"
SET VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1))
+88 IF PTYP="R"
Begin DoDot:3
+89 IF VALUE["T"
SET VALUE=$$DATE^BQIUL1(VALUE)
SET VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1))
QUIT
+90 DO RANGE^BQIDCAH1(VALUE,PPIEN,PNAM)
Begin DoDot:4
+91 SET VALUE=VALUE_" ("_$$FMTE^BQIUL1(RFROM)_"-"_$$FMTE^BQIUL1(RTHRU)_")"
End DoDot:4
+92 ;
End DoDot:3
+93 SET PMAP=$$PMAP^BQIDCDF(SOURCE,PNAM)
IF VALUE]""
IF PMAP]""
DO MAP(SOURCE,PMAP,.VALUE,.PNAM)
+94 SET PEXE=$$PEXE^BQIDCDF(SOURCE,PNAM)
IF VALUE]""
IF PEXE]""
XECUTE PEXE
+95 ;
+96 ;Single value save
+97 IF VALUE]""
SET PARMS(PNAM,$$TRUNC(VALUE))=""
QUIT
+98 ;
+99 ;Multiple value save
+100 SET MUL=0
FOR
SET MUL=$ORDER(^BQICARE(OWNR,1,PLIEN,10,PMIEN,1,MUL))
IF 'MUL
QUIT
Begin DoDot:3
+101 NEW DA,IENS,VALUE
+102 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=PMIEN
SET DA=MUL
SET IENS=$$IENS^DILF(.DA)
+103 SET PNAM=OPNAM
+104 IF PTYP="T"
Begin DoDot:4
+105 SET VALUE=$$GET1^DIQ(90505.21,IENS,.01,"E")
+106 SET FILE=$$FILN^BQIDCDF(SOURCE,PNAM)
IF FILE=""
QUIT
+107 SET VALUE=$$GET1^DIQ(FILE,VALUE,.01,"E")
End DoDot:4
+108 IF PTYP'="T"
SET VALUE=$$GET1^DIQ(90505.21,IENS,.01,"E")
+109 IF PTYP="D"
SET VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1))
+110 IF PTYP="R"
Begin DoDot:4
+111 IF VALUE["T"
SET VALUE=$$DATE^BQIUL1(VALUE)
SET VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1))
QUIT
+112 ;S VALUE=$$DATE^BQIUL1(VALUE)
+113 ;S VALUE=$$UP^XLFSTR($$FMTE^XLFDT(VALUE,1))
End DoDot:4
+114 IF VALUE]""
IF PMAP]""
DO MAP(SOURCE,PMAP,.VALUE,.PNAM)
+115 IF VALUE]""
IF PEXE]""
XECUTE PEXE
+116 IF VALUE]""
SET PARMS(PNAM,$$TRUNC(VALUE))=""
End DoDot:3
+117 QUIT
End DoDot:2
+118 ;Assemble parameter description
+119 DO PDESC(TYPE,SOURCE,.TDESC,.PARMS)
+120 IF $LENGTH(TDESC)<70
SET DESC(1,0)=$GET(TDESC)
QUIT
+121 DO WP(TDESC,.DESC)
End DoDot:1
+122 ;
+123 ;Retrieve filter information
+124 DO FILTER^BQIPDSCF(OWNR,PLIEN,.FPARMS)
+125 ;
+126 ;Assemble filter description
+127 IF $DATA(FPARMS)
Begin DoDot:1
+128 IF SOURCE["AD HOC"
IF FSOURCE="FILTER"
KILL X,DESC
+129 DO FDESC(.DESC,.FPARMS)
End DoDot:1
+130 ;
+131 ;Pull category and IPC Flag
+132 DO CATIPC(OWNR,PLIEN,.DESC)
+133 ;
+134 QUIT
+135 ;
TRUNC(VAL) ;EP - Truncate value to 255
+1 ;
+2 IF $LENGTH(VAL)<256
QUIT VAL
+3 QUIT $EXTRACT(VAL,1,252)_"..."
+4 ;
WP(TEXT,DESC) ;EP - update description text
+1 NEW DIWL,DIWR,BQN
+2 KILL ^UTILITY($JOB,"W")
+3 SET DIWL=1
SET DIWR=45
+4 IF '$DATA(DESC)
Begin DoDot:1
+5 SET X=TEXT
+6 DO ^DIWP
+7 SET BQN=""
+8 FOR
SET BQN=$ORDER(^UTILITY($JOB,"W",1,BQN))
IF BQN=""
QUIT
SET DESC(BQN,0)=^UTILITY($JOB,"W",1,BQN,0)
End DoDot:1
+9 QUIT
+10 ;
CNT(PARM) ;EP - Return number of entries for specific parameter
+1 IF PARM=""
QUIT 0
+2 IF $GET(PARMS(PARM))=""
QUIT 0
+3 QUIT $LENGTH(PARMS(PARM),",")
+4 ;
FCNT(FPRM) ;EP - Return if filter is defined for panel
+1 ;
+2 NEW PORD
+3 IF FPRM=""
QUIT 0
+4 IF $DATA(FPARMS("VAL",FPRM))
QUIT $LENGTH(FPARMS("VAL",FPRM),", ")
+5 QUIT 0
+6 ;
PCNT(PRM) ;EP - Return if parameter is defined for panel
+1 IF PRM=""
QUIT 0
+2 IF $DATA(PARMS(PRM))
QUIT $LENGTH(PARMS(PRM),", ")
+3 QUIT 0
+4 ;
CATIPC(OWNR,PLIEN,DESC) ;EP - Add in category and IPC status
+1 NEW PCAT,PIPC,DA,IENS,DII
+2 ;
+3 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+4 ;$$GET1^DIQ(90505.01,IENS,2.2,"I")
SET PCAT=$$PCAT^BQIPLDF(OWNR,PLIEN)
+5 SET PIPC=$$GET1^DIQ(90505.01,IENS,2.1,"I")
+6 ;
+7 SET DA(1)=DUZ
SET DA=PCAT
SET IENS=$$IENS^DILF(.DA)
+8 IF PCAT]""
SET PCAT=$$GET1^DIQ(90505.017,IENS,.01,"I")
+9 IF PCAT=""
SET PCAT="N/A"
+10 SET PIPC=$SELECT(PIPC="1":"Yes",1:"No")
+11 SET DII=$ORDER(DESC(""),"-1")
SET DII=$GET(DII)+1
+12 SET DESC(DII,0)="Panel Category: "_PCAT_" IPC Panel: "_PIPC_"; "
+13 ;
+14 QUIT
+15 ;
MAP(SOURCE,PMAP,VALUE,PNAM) ;EP - Map one value to another
+1 ;
+2 NEW PDEF,FIEN,MAP,I,PC,FND
+3 ;
+4 SET PDEF=$$PP^BQIDCDF(SOURCE)
IF PDEF=""
QUIT
+5 ;
+6 SET FIEN=$ORDER(^BQI(90506,PDEF,3,"B",PMAP,""))
IF FIEN=""
QUIT
+7 ;
+8 SET FND=""
+9 SET MAP=""
FOR
SET MAP=$ORDER(^BQI(90506,PDEF,3,FIEN,3,"AC",MAP))
IF MAP=""
QUIT
Begin DoDot:1
+10 FOR I=1:1:$LENGTH(MAP,"~")
SET PC=$PIECE(MAP,"~",I)
IF PC]""
Begin DoDot:2
+11 NEW VAR,VAL,CIEN,DA,IEN
+12 SET VAR=$PIECE(PC,"=")
IF VAR=""
QUIT
+13 SET VAL=$PIECE(PC,"=",2)
IF VAL=""
QUIT
+14 IF VAR'=PNAM
QUIT
+15 IF VAL'=VALUE
QUIT
+16 SET CIEN=$ORDER(^BQI(90506,PDEF,3,FIEN,3,"AC",MAP,""))
IF CIEN=""
QUIT
+17 SET DA(2)=PDEF
SET DA(1)=FIEN
SET DA=CIEN
SET IEN=$$IENS^DILF(.DA)
+18 SET VALUE=$$GET1^DIQ(90506.33,IEN,.01,"E")
SET PNAM=PMAP
SET FND=1
End DoDot:2
IF FND
QUIT
End DoDot:1
IF FND
QUIT
+19 ;
+20 QUIT
+21 ;
PVST(TYPE) ;EP - Assemble primary secondary visit description section
+1 ;
+2 IF TYPE="PRIM"
IF $DATA(PARMS("PVISITS"))
DO PSVST("PRIM",PARMS("PVISITS"),$GET(PARMS("PTMFRAME")),.PARMS)
+3 IF TYPE="PRSC"
IF $DATA(PARMS("PSVISITS"))
DO PSVST("PRSC",PARMS("PSVISITS"),$GET(PARMS("PSTMFRAM")),.PARMS)
+4 QUIT
+5 ;
PSVST(BQITYPE,BQIVST,BQITIME,BQIMPRM) ;EP - Assemble Primary/Secondary Provider Visit Checks
+1 ;
+2 ;Description: This tag receives primary or secondary visit check information and moves it into
+3 ; the multiple field "TYPE" node so it will be included with the other specialties.
+4 ;
+5 ;Parameters:
+6 ;BQITYPE = "PRIM" - Primary or "PRSC" - Primary/Secondary
+7 ;BQIVST = # of visits parameter
+8 ;BQITIME = Date Range
+9 ;BQIMPRM = Passed in MPARMS array. Gets updated with visit check description
+10 ;
+11 ;
+12 NEW STR
+13 IF BQITYPE=""!(BQIVST="")!(BQITIME="")
QUIT
+14 ;
+15 ;Assemble Visit Check Description
+16 SET STR=BQIVST
+17 SET STR=STR_" "_$SELECT(BQITYPE="PRIM":"Primary Visit Provider",1:"Primary/Secondary Visit Provider")
+18 SET STR=STR_" "_$SELECT(BQIVST>1:"visits",1:"visit")
+19 ;Now added in executable string
+20 ;I $G(BQITIME)]"" S STR=STR_" in "_$S(BQITIME="T-24M":"2 years",BQITIME="T-12M":"1 year",1:$P(BQITIME,"T-",2))
+21 SET BE=$GET(BE)+1
SET BE(BE)=BQITYPE_U_BQITIME
+22 ;
+23 ;Save New Entry With Visit Check Description
+24 SET BQIMPRM(BQITYPE)=STR
+25 QUIT
+26 ;
EHPL ;EP - Format EHR Personal List
+1 NEW EHPLIEN,EHVAL,PC
+2 SET EHVAL=""
+3 FOR PC=1:1:$LENGTH(PARMS("EHRPLIEN"),", ")
SET EHPLIEN=$PIECE(PARMS("EHRPLIEN"),", ",PC)
Begin DoDot:1
+4 NEW EHPL
+5 SET EHPL=$$GETNAME^BEHOPTP2(EHPLIEN)
+6 SET EHVAL=$GET(EHVAL)_EHPL_","
End DoDot:1
+7 SET EHVAL=$$TKO^BQIUL1(EHVAL,",")
+8 IF EHVAL]""
SET PARMS("EHRPLIEN")=EHVAL
+9 QUIT
+10 ;
REG ;EP - Format RPMS Register Panel Information
+1 NEW REGIEN,REGNMSP
+2 IF '$DATA(PARMS("REG"))
QUIT
+3 SET REGIEN=$ORDER(^BQI(90507,"B",PARMS("REG"),""))
+4 IF REGIEN=""
QUIT
+5 SET REGNMSP=$$GET1^DIQ(90507,REGIEN_",",.13,"E")
+6 IF REGNMSP'=""
SET PARMS("NMSP")=REGNMSP
+7 IF $GET(PARMS("SUBREG"))'=""
Begin DoDot:1
+8 NEW SBIEN,SBREG
+9 SET SBIEN=0
FOR
SET SBIEN=$ORDER(^BQI(90507,SBIEN))
IF 'SBIEN
QUIT
Begin DoDot:2
+10 SET SBREG=$PIECE($GET(^BQI(90507,SBIEN,0)),U,9)
+11 IF SBREG=PARMS("SUBREG")
Begin DoDot:3
+12 SET REGNMSP=$$GET1^DIQ(90507,SBIEN_",",.13,"E")
+13 IF REGNMSP'=""
SET PARMS("NMSP")=REGNMSP
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
PRS(TDESC) ;EP - Parse description
+1 SET TDESC=$PIECE(TDESC,"|",1)_$GET(PARMS($PIECE(TDESC,"|",2)))_$PIECE(TDESC,"|",3,99)
+2 QUIT
+3 ;
MPRS(TDESC) ;EP - Parse filter description
+1 SET TDESC=$PIECE(TDESC,"|",1)_$GET(FPARMS("VAL",$PIECE(TDESC,"|",2)))_$PIECE(TDESC,"|",3,99)
+2 QUIT
+3 ;
PDESC(TYPE,SOURCE,TDESC,PARMS) ;EP - Assemble parameter description
+1 NEW PPIEN,DSCEXE,DSC,PORD,PFIEN,PSORD
+2 ;
+3 ;Convert multiple values into single value
+4 DO MPARMS(.PARMS,"")
+5 ;
+6 ;Pull first part of description
+7 SET PPIEN=$$PP^BQIDCDF(SOURCE)
IF PPIEN=-1
QUIT
+8 SET DSC=""
+9 SET DSCEXE=$$GET1^DIQ(90506,PPIEN,6)
IF DSCEXE]""
XECUTE DSCEXE
+10 SET TDESC=DSC
+11 ;
+12 ;Loop through parameters for source and assemble description
+13 SET PORD=""
FOR
SET PORD=$ORDER(^BQI(90506,PPIEN,3,"C",PORD))
IF PORD=""
QUIT
Begin DoDot:1
+14 SET PFIEN=$ORDER(^BQI(90506,PPIEN,3,"C",PORD,""))
IF PFIEN=""
QUIT
+15 ;
+16 ;Get description framework for parameter
+17 SET DSC=""
+18 SET PSORD=""
FOR
SET PSORD=$ORDER(^BQI(90506,PPIEN,3,PFIEN,5,"B",PSORD))
IF PSORD=""
QUIT
Begin DoDot:2
+19 NEW PSIEN,PREXE
+20 SET PSIEN=$ORDER(^BQI(90506,PPIEN,3,PFIEN,5,"B",PSORD,""))
IF PSIEN=""
QUIT
+21 SET PREXE=$GET(^BQI(90506,PPIEN,3,PFIEN,5,PSIEN,1))
+22 IF PREXE]""
XECUTE PREXE
End DoDot:2
IF DSC]""
QUIT
+23 IF DSC]""
SET TDESC=$GET(TDESC)_DSC
End DoDot:1
+24 ;
+25 ;Populate values
+26 FOR
IF '$FIND(TDESC,"|")
QUIT
DO PRS(.TDESC)
+27 ;
+28 QUIT
+29 ;
FDESC(PARMS,FPARMS) ;EP - Assemble filter description
+1 NEW PPIEN,DSC,DSCEXE,TDESC,PORD,FPC,VAL,DII,PSORD,PFIEN,FNAME
+2 ;
+3 ;Convert multiple values into single value
+4 DO FPARMS(.FPARMS)
+5 ;
+6 ;Pull first part of description
+7 SET PPIEN=$$PP^BQIDCDF(FSOURCE)
IF PPIEN=-1
QUIT
+8 SET DSC=""
+9 SET DSCEXE=$$GET1^DIQ(90506,PPIEN,6)
IF DSCEXE]""
XECUTE DSCEXE
+10 SET TDESC=DSC
+11 ;
+12 ;Loop through parameters for source and assemble description
+13 SET PORD=""
FOR
SET PORD=$ORDER(FPARMS(PORD))
IF 'PORD
QUIT
Begin DoDot:1
+14 SET FNAME=""
FOR
SET FNAME=$ORDER(FPARMS(PORD,FNAME))
IF FNAME=""
QUIT
Begin DoDot:2
+15 ;
+16 SET PFIEN=$ORDER(^BQI(90506,PPIEN,3,"B",FNAME,""))
IF PFIEN=""
QUIT
+17 ;
+18 ;Get description framework for parameter
+19 SET DSC=""
+20 SET FPARMS("VAL",FNAME)=$GET(FPARMS(PORD,FNAME))
+21 KILL FPARMS(PORD,FNAME)
+22 ;
+23 SET PSORD=""
FOR
SET PSORD=$ORDER(^BQI(90506,PPIEN,3,PFIEN,5,"B",PSORD))
IF PSORD=""
QUIT
Begin DoDot:3
+24 NEW PSIEN,PREXE
+25 SET PSIEN=$ORDER(^BQI(90506,PPIEN,3,PFIEN,5,"B",PSORD,""))
IF PSIEN=""
QUIT
+26 SET PREXE=$GET(^BQI(90506,PPIEN,3,PFIEN,5,PSIEN,1))
+27 IF PREXE]""
XECUTE PREXE
End DoDot:3
IF DSC]""
QUIT
+28 IF DSC]""
SET TDESC=$GET(TDESC)_DSC_"; "
End DoDot:2
End DoDot:1
+29 SET TDESC=$$TKO^BQIUL1(TDESC,"; ")
+30 ;
+31 ;Populate values
+32 NEW FPC,DII
+33 FOR
IF '$FIND(TDESC,"|")
QUIT
DO MPRS(.TDESC)
+34 FOR FPC=1:1:$LENGTH(TDESC,"; ")
Begin DoDot:1
+35 NEW VAL
+36 SET VAL=$PIECE(TDESC,"; ",FPC)
IF FPC=""
QUIT
+37 SET DII=$ORDER(DESC(""),"-1")
SET DII=$GET(DII)+1
+38 SET DESC(DII,0)=VAL_"; "
End DoDot:1
+39 ;
+40 DO WP(TDESC,.DESC)
+41 QUIT
+42 ;
MPARMS(PARMS,DEL) ;EP - Convert multiple values into single value
+1 ;
+2 ; Input:
+3 ; PARMS - Array of current fields with their values
+4 ; DEL - Delimiter to put between entries
+5 ;
+6 ; Output:
+7 ; PARMS - Updated array which includes multiple values
+8 ; combined into single entries
+9 ;
+10 NEW NAME
+11 SET DEL=$GET(DEL,"")
IF DEL=""
SET DEL=", "
+12 SET NAME=""
FOR
SET NAME=$ORDER(PARMS(NAME))
IF NAME=""
QUIT
Begin DoDot:1
+13 NEW VAL,VALS
+14 SET VAL=""
SET VALS=""
+15 FOR
SET VAL=$ORDER(PARMS(NAME,VAL))
IF VAL=""
QUIT
SET VALS=VALS_VAL_$SELECT($GET(PARMS(NAME,VAL))]"":PARMS(NAME,VAL),1:DEL)
KILL PARMS(NAME,VAL)
+16 SET VALS=$$TKO^BQIUL1(VALS,DEL)
+17 SET PARMS(NAME)=VALS
End DoDot:1
+18 ;
+19 QUIT
+20 ;
FPARMS(FPARMS) ;EP - Convert multiple filter values into single value
+1 ;
+2 ; Input:
+3 ; FPARMS - Array of current fields with their values
+4 ;
+5 ; Output:
+6 ; FPARMS - Updated array which includes multiple values
+7 ; combined into single entries
+8 ;
+9 NEW NAME,PORD
+10 SET PORD=""
FOR
SET PORD=$ORDER(FPARMS(PORD))
IF PORD=""
QUIT
Begin DoDot:1
+11 SET NAME=""
FOR
SET NAME=$ORDER(FPARMS(PORD,NAME))
IF NAME=""
QUIT
Begin DoDot:2
+12 NEW VAL,VALS,DLM,APOS
+13 SET VAL=""
SET VALS=""
SET APOS="'"
+14 ;
+15 ;Determine whether to add an apostrophe
+16 SET VAL=$ORDER(FPARMS(PORD,NAME,VAL))
IF VAL=""
SET APOS=""
+17 SET VAL=$ORDER(FPARMS(PORD,NAME,VAL))
IF VAL=""
SET APOS=""
+18 SET VAL=""
FOR
SET VAL=$ORDER(FPARMS(PORD,NAME,VAL))
IF VAL=""
QUIT
Begin DoDot:3
+19 IF NAME="DEC"
SET VALS=VALS_APOS_VAL_APOS_$SELECT($GET(FPARMS(PORD,NAME,VAL))]"":FPARMS(PORD,NAME,VAL),1:", ")
KILL FPARMS(PORD,NAME,VAL)
QUIT
+20 SET VALS=VALS_APOS_VAL_APOS_$SELECT($GET(FPARMS(PORD,NAME,VAL))]"":FPARMS(PORD,NAME,VAL),1:" OR ")
KILL FPARMS(PORD,NAME,VAL)
End DoDot:3
+21 FOR DLM=", "," AND "," OR "
SET VALS=$$TKO^BQIUL1(VALS,DLM)
+22 SET FPARMS(PORD,NAME)=VALS
End DoDot:2
End DoDot:1
+23 ;
+24 QUIT
