BQIPDSCL.m

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