BQIPDSCL ;GDHD/HCS/ALA-Panel Filter Description continued ; 13 Feb 2017 12:09 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
ASPARM(FN) ;EP - Retrieve associated parameters from single value field
NEW AP,APRM,ASTR
;First look for single value parameter
S AP=0
F S AP=$O(^BQICARE(OWNR,1,PLIEN,15,FN,2,AP)) Q:'AP D
. NEW DA,IENS,APNAME,AVALUE,APTYP
. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=FN,DA=AP,IENS=$$IENS^DILF(.DA)
. S APNAME=$$GET1^DIQ(90505.1152,IENS,.01,"E") Q:APNAME=""
. S APTYP=$$PTYP^BQIDCDF(FSOURCE,APNAME)
. S AVALUE=$$GVAL^BQIPDSCF(APTYP,90505.1152,IENS,FSOURCE,APNAME)
. I AVALUE'="" S APRM(APNAME)=AVALUE
. ;
. ;Now try looking for multi value parameter
. I AVALUE="" D
.. NEW MAP
.. S MAP=0
.. F S MAP=$O(^BQICARE(OWNR,1,PLIEN,15,FN,2,AP,1,MAP)) Q:'MAP D
... NEW DA,IENS,AVAL
... S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=FN,DA(1)=AP,DA=MAP,IENS=$$IENS^DILF(.DA)
... S AVAL=$$GET1^DIQ(90505.11521,IENS,.01,"E")
... S AVAL=$$GMVAL^BQIPDSCF(APTYP,90505.11521,IENS,FSOURCE,APNAME)
... I AVAL'="" S AVALUE=AVALUE_$S(AVALUE="":"",1:$C(29))_AVAL
.. S:AVALUE]"" APRM(APNAME)=AVALUE
S ASTR=""
S APRM="" F S APRM=$O(APRM(APRM)) Q:APRM="" D
. ;
. ;Form associate string
. S ASTR=ASTR_$S(ASTR="":"",1:$C(26))_APRM_$C(28)_APRM(APRM)
Q ASTR
;
ASMPARM(MN) ;EP - Retrieve associated parameters from multiple value field
NEW AP,APRM,ASTR
;First look for single value parameter
S AP=0
F S AP=$O(^BQICARE(OWNR,1,PLIEN,15,FN,1,MN,2,AP)) Q:'AP D
. NEW DA,IENS,APNAME,AVALUE,APTYP
. S DA(4)=OWNR,DA(3)=PLIEN,DA(2)=FN,DA(1)=MN,DA=AP,IENS=$$IENS^DILF(.DA)
. S APNAME=$$GET1^DIQ(90505.11512,IENS,.01,"E") Q:APNAME=""
. S APTYP=$$PTYP^BQIDCDF(FSOURCE,APNAME)
. S AVALUE=$$GVAL^BQIPDSCF(APTYP,90505.11512,IENS,FSOURCE,APNAME)
. I AVALUE'="" S APRM(APNAME)=AVALUE
. ;Now try looking for multi value parameter
. I AVALUE="" D
.. NEW MAP
.. S MAP=0
.. F S MAP=$O(^BQICARE(OWNR,1,PLIEN,15,FN,1,MN,2,AP,1,MAP)) Q:'MAP D
... NEW DA,IENS,AVAL
... S DA(5)=OWNR,DA(4)=PLIEN,DA(3)=FN,DA(2)=MN,DA(1)=AP,DA=MAP,IENS=$$IENS^DILF(.DA)
... S AVAL=$$GET1^DIQ(90505.115121,IENS,.01,"E")
... S AVAL=$$GMVAL^BQIPDSCF(APTYP,90505.115121,IENS,FSOURCE,APNAME)
... I AVAL'="" S AVALUE=AVALUE_$S(AVALUE="":"",1:$C(29))_AVAL
.. S:AVALUE]"" APRM(APNAME)=AVALUE
S ASTR=""
S APRM="" F S APRM=$O(APRM(APRM)) Q:APRM="" D
. ;Form associate string
. S ASTR=ASTR_$S(ASTR="":"",1:$C(26))_APRM_$C(28)_APRM(APRM)
Q ASTR
;
NVIS(PORD,VALUE,ASTR) ;EP - Assemble number of visits
NEW I,CLIN,PROV,STR,N1,N2,FND,V,VAL
S ASTR=$G(ASTR,"")
S (CLIN,PROV)=""
F I=1:1:$L($G(ASTR),$C(26)) D
. NEW FINFO,FNAME,FVAL,NVAL,PC
. S FINFO=$P(ASTR,$C(26),I)
. S FNAME=$P(FINFO,$C(28)) Q:FNAME=""
. S FVAL=$P(FINFO,$C(28),2) Q:FVAL=""
. S NVAL=""
. F PC=1:1:$L(FVAL,$C(29)) D
.. S VAL=$P(FVAL,$C(29),PC) S:VAL]"" NVAL=NVAL_$S(NVAL]"":", ",1:"")_VAL
. I FNAME]"",NVAL]"" S @FNAME=NVAL
;
;Get visit number(s)
S (N1,FND)="" F I=1:1:$L(VALUE) Q:(FND=1&($E(VALUE,I)'?1N)) I $E(VALUE,I)?1N S N1=N1_$E(VALUE,I),FND=1
Q:N1=""
S (N2,FND)="" I I<$L(VALUE) F I=I:1:$L(VALUE) Q:(FND=1&($E(VALUE,I)'?1N)) I $E(VALUE,I)?1N S N2=N2_$E(VALUE,I),FND=1
;
S STR="# of Visits"
I CLIN]"" S STR=STR_" in clinic "_CLIN
I PROV]"" S STR=STR_" for provider "_PROV
;
S V=VALUE
I V["~",V["'" S STR=STR_" in range (inclusive) "_N1_" thru "_N2
E I V["~" S STR=STR_" out of range (exclusive) less than "_N1_" or greater than "_N2
E I V["'<" S STR=STR_" greater than or equal to "_N1
E I V["'>" S STR=STR_" less than or equal to "_N1
E I V["<" S STR=STR_" less than "_N1
E I V[">" S STR=STR_" greater than "_N1
E S STR=STR_" equal to "_N1
S VALUE=STR
Q
BQIPDSCL ;GDHD/HCS/ALA-Panel Filter Description continued ; 13 Feb 2017 12:09 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
ASPARM(FN) ;EP - Retrieve associated parameters from single value field
+1 NEW AP,APRM,ASTR
+2 ;First look for single value parameter
+3 SET AP=0
+4 FOR
SET AP=$ORDER(^BQICARE(OWNR,1,PLIEN,15,FN,2,AP))
IF 'AP
QUIT
Begin DoDot:1
+5 NEW DA,IENS,APNAME,AVALUE,APTYP
+6 SET DA(3)=OWNR
SET DA(2)=PLIEN
SET DA(1)=FN
SET DA=AP
SET IENS=$$IENS^DILF(.DA)
+7 SET APNAME=$$GET1^DIQ(90505.1152,IENS,.01,"E")
IF APNAME=""
QUIT
+8 SET APTYP=$$PTYP^BQIDCDF(FSOURCE,APNAME)
+9 SET AVALUE=$$GVAL^BQIPDSCF(APTYP,90505.1152,IENS,FSOURCE,APNAME)
+10 IF AVALUE'=""
SET APRM(APNAME)=AVALUE
+11 ;
+12 ;Now try looking for multi value parameter
+13 IF AVALUE=""
Begin DoDot:2
+14 NEW MAP
+15 SET MAP=0
+16 FOR
SET MAP=$ORDER(^BQICARE(OWNR,1,PLIEN,15,FN,2,AP,1,MAP))
IF 'MAP
QUIT
Begin DoDot:3
+17 NEW DA,IENS,AVAL
+18 SET DA(4)=OWNR
SET DA(3)=PLIEN
SET DA(2)=FN
SET DA(1)=AP
SET DA=MAP
SET IENS=$$IENS^DILF(.DA)
+19 SET AVAL=$$GET1^DIQ(90505.11521,IENS,.01,"E")
+20 SET AVAL=$$GMVAL^BQIPDSCF(APTYP,90505.11521,IENS,FSOURCE,APNAME)
+21 IF AVAL'=""
SET AVALUE=AVALUE_$SELECT(AVALUE="":"",1:$CHAR(29))_AVAL
End DoDot:3
+22 IF AVALUE]""
SET APRM(APNAME)=AVALUE
End DoDot:2
End DoDot:1
+23 SET ASTR=""
+24 SET APRM=""
FOR
SET APRM=$ORDER(APRM(APRM))
IF APRM=""
QUIT
Begin DoDot:1
+25 ;
+26 ;Form associate string
+27 SET ASTR=ASTR_$SELECT(ASTR="":"",1:$CHAR(26))_APRM_$CHAR(28)_APRM(APRM)
End DoDot:1
+28 QUIT ASTR
+29 ;
ASMPARM(MN) ;EP - Retrieve associated parameters from multiple value field
+1 NEW AP,APRM,ASTR
+2 ;First look for single value parameter
+3 SET AP=0
+4 FOR
SET AP=$ORDER(^BQICARE(OWNR,1,PLIEN,15,FN,1,MN,2,AP))
IF 'AP
QUIT
Begin DoDot:1
+5 NEW DA,IENS,APNAME,AVALUE,APTYP
+6 SET DA(4)=OWNR
SET DA(3)=PLIEN
SET DA(2)=FN
SET DA(1)=MN
SET DA=AP
SET IENS=$$IENS^DILF(.DA)
+7 SET APNAME=$$GET1^DIQ(90505.11512,IENS,.01,"E")
IF APNAME=""
QUIT
+8 SET APTYP=$$PTYP^BQIDCDF(FSOURCE,APNAME)
+9 SET AVALUE=$$GVAL^BQIPDSCF(APTYP,90505.11512,IENS,FSOURCE,APNAME)
+10 IF AVALUE'=""
SET APRM(APNAME)=AVALUE
+11 ;Now try looking for multi value parameter
+12 IF AVALUE=""
Begin DoDot:2
+13 NEW MAP
+14 SET MAP=0
+15 FOR
SET MAP=$ORDER(^BQICARE(OWNR,1,PLIEN,15,FN,1,MN,2,AP,1,MAP))
IF 'MAP
QUIT
Begin DoDot:3
+16 NEW DA,IENS,AVAL
+17 SET DA(5)=OWNR
SET DA(4)=PLIEN
SET DA(3)=FN
SET DA(2)=MN
SET DA(1)=AP
SET DA=MAP
SET IENS=$$IENS^DILF(.DA)
+18 SET AVAL=$$GET1^DIQ(90505.115121,IENS,.01,"E")
+19 SET AVAL=$$GMVAL^BQIPDSCF(APTYP,90505.115121,IENS,FSOURCE,APNAME)
+20 IF AVAL'=""
SET AVALUE=AVALUE_$SELECT(AVALUE="":"",1:$CHAR(29))_AVAL
End DoDot:3
+21 IF AVALUE]""
SET APRM(APNAME)=AVALUE
End DoDot:2
End DoDot:1
+22 SET ASTR=""
+23 SET APRM=""
FOR
SET APRM=$ORDER(APRM(APRM))
IF APRM=""
QUIT
Begin DoDot:1
+24 ;Form associate string
+25 SET ASTR=ASTR_$SELECT(ASTR="":"",1:$CHAR(26))_APRM_$CHAR(28)_APRM(APRM)
End DoDot:1
+26 QUIT ASTR
+27 ;
NVIS(PORD,VALUE,ASTR) ;EP - Assemble number of visits
+1 NEW I,CLIN,PROV,STR,N1,N2,FND,V,VAL
+2 SET ASTR=$GET(ASTR,"")
+3 SET (CLIN,PROV)=""
+4 FOR I=1:1:$LENGTH($GET(ASTR),$CHAR(26))
Begin DoDot:1
+5 NEW FINFO,FNAME,FVAL,NVAL,PC
+6 SET FINFO=$PIECE(ASTR,$CHAR(26),I)
+7 SET FNAME=$PIECE(FINFO,$CHAR(28))
IF FNAME=""
QUIT
+8 SET FVAL=$PIECE(FINFO,$CHAR(28),2)
IF FVAL=""
QUIT
+9 SET NVAL=""
+10 FOR PC=1:1:$LENGTH(FVAL,$CHAR(29))
Begin DoDot:2
+11 SET VAL=$PIECE(FVAL,$CHAR(29),PC)
IF VAL]""
SET NVAL=NVAL_$SELECT(NVAL]"":", ",1:"")_VAL
End DoDot:2
+12 IF FNAME]""
IF NVAL]""
SET @FNAME=NVAL
End DoDot:1
+13 ;
+14 ;Get visit number(s)
+15 SET (N1,FND)=""
FOR I=1:1:$LENGTH(VALUE)
IF (FND=1&($EXTRACT(VALUE,I)'?1N))
QUIT
IF $EXTRACT(VALUE,I)?1N
SET N1=N1_$EXTRACT(VALUE,I)
SET FND=1
+16 IF N1=""
QUIT
+17 SET (N2,FND)=""
IF I<$LENGTH(VALUE)
FOR I=I:1:$LENGTH(VALUE)
IF (FND=1&($EXTRACT(VALUE,I)'?1N))
QUIT
IF $EXTRACT(VALUE,I)?1N
SET N2=N2_$EXTRACT(VALUE,I)
SET FND=1
+18 ;
+19 SET STR="# of Visits"
+20 IF CLIN]""
SET STR=STR_" in clinic "_CLIN
+21 IF PROV]""
SET STR=STR_" for provider "_PROV
+22 ;
+23 SET V=VALUE
+24 IF V["~"
IF V["'"
SET STR=STR_" in range (inclusive) "_N1_" thru "_N2
+25 IF '$TEST
IF V["~"
SET STR=STR_" out of range (exclusive) less than "_N1_" or greater than "_N2
+26 IF '$TEST
IF V["'<"
SET STR=STR_" greater than or equal to "_N1
+27 IF '$TEST
IF V["'>"
SET STR=STR_" less than or equal to "_N1
+28 IF '$TEST
IF V["<"
SET STR=STR_" less than "_N1
+29 IF '$TEST
IF V[">"
SET STR=STR_" greater than "_N1
+30 IF '$TEST
SET STR=STR_" equal to "_N1
+31 SET VALUE=STR
+32 QUIT
