BQIPLDS2.m

BQIPLDS2 ;VNGT/HS/ALA-Panel Def Description Utility Cont. ; 04 Feb 2011  1:58 PM

 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66

 ;

 ;

ALGY ;EP - Allergy

 ; Only reformat description with designated operand

 I $G(FPARMS("ALLOP"))="" Q

 ; If only a single Allergy was identified operand is meaningless

 I '$D(FMPARMS("ALLERGY")) Q

 S FPARMS("ALLOP")=$S(FPARMS("ALLOP")="&":", AND ",1:", OR ")

 N DX,APM

 S (DX,APM)="",FPARMS("ALLERGY")=""

 F  S DX=$O(FMPARMS("ALLERGY",DX)) Q:DX=""  D

 . I $D(AFMPARMS("ALLERGY",DX)) D

 .. S APM=$$ADDAP^BQIPLDS1("ALLERGY",DX)

 . I $O(FMPARMS("ALLERGY",DX))="" S FPARMS("ALLERGY")=FPARMS("ALLERGY")_DX_APM Q

 . S FPARMS("ALLERGY")=FPARMS("ALLERGY")_DX_APM_FPARMS("ALLOP")

 K FMPARMS("ALLERGY"),AFMPARMS("ALLERGY")

 Q

 ;

DEC ;EP - Format Deceased status

 I $D(FPARMS("DEC")) D

 . N DEC

 . S DEC=FPARMS("DEC")

 . I DEC="Y" S DEC="Deceased, "

 . I DEC="N" S DEC=""

 . S FPARMS("DEC")=DEC

 ;

 I $D(FPARMS("LIV")) D

 . N LIV

 . S LIV=FPARMS("LIV")

 . I LIV="Y" S LIV="Living, "

 . I LIV="N" S LIV=""

 . S FPARMS("LIV")=LIV

 ;

INAC ;EP- Inactive patients

 I $D(FPARMS("INAC")) D

 . N INAC

 . S INAC=FPARMS("INAC")

 . I INAC="Y" S INAC="Inactive, "

 . I INAC="N" S INAC=""

 . S FPARMS("INAC")=INAC

 ;

 S FPARMS("DEC")=$$TKO^BQIUL1($G(FPARMS("DEC"))_$G(FPARMS("LIV"))_$G(FPARMS("INAC")),", ")

 Q

 ;

ALNAS(VALUE) ;EP - Allergies Not Assessed

 ;

 Q $S(VALUE="Y":"Not Assessed",1:"")

 ;

ALNKN(VALUE,PORD,FNAME) ;EP - Allergies Not Known

 ;

 ;Combine with Allergies Not Assessed

 S PORD=$$PORD^BQIDCDF(FSOURCE,"ALNAS") Q:PORD=""

 S FNAME="ALNAS"

 ;

 Q $S(VALUE="Y":"Not Known",1:"")

 ;

AGE ; Format Age Line

 ;

 NEW PORD,AGE,XAGE

 ;

 S PORD=$$PORD^BQIDCDF(FSOURCE,"AGE") Q:PORD=""

 ;

 ; Added the following line to replace the subsequent code for PR_0124

 I VALUE]"" D

 . NEW EXT,OP,COM

 . S AGE=VALUE,OP=0

 . I $E(AGE,1)="'" S OP=1,AGE=$E(AGE,2,99)

 . S COM=$E(AGE,1)

 . I OP,COM="<" S XAGE="Greater than or equal to ",AGE=$E(AGE,2,99)

 . E  I OP,COM=">" S XAGE="Less than or equal to ",AGE=$E(AGE,2,99)

 . E  I COM="<" S XAGE="Less than ",AGE=$E(AGE,2,99)

 . E  I COM=">" S XAGE="Greater than ",AGE=$E(AGE,2,99)

 . E  S XAGE="Equal to ",AGE=$E(AGE,2,99)

 . ;

 . I AGE["YRS" S AGE=XAGE_+AGE_" years"

 . I AGE["MOS" S AGE=XAGE_+AGE_" months"

 . I AGE["DYS" S AGE=XAGE_+AGE_" days"

 . ;

 . S VALUE=AGE

 ;

 I $D(FPARMS(PORD,"AGE"))>9 D

 . NEW PREV,AGE1,AGE2

 . S PREV=$O(FPARMS(PORD,"AGE","")) Q:PREV=""

 . ;

 . ;Check for inclusive

 . I PREV["Greater than or equal to" D  Q

 .. S AGE1=$P(PREV,"Greater than or equal to ",2) Q:AGE1=""

 .. S AGE2=$P(AGE,"Less than or equal to ",2) Q:AGE2=""

 .. S VALUE="Between (inclusive) "_AGE1_" and "_AGE2

 .. K FPARMS(PORD,"AGE",PREV)

 . ;

 . ;Check for exclusive

 . I PREV["Less than " D  Q

 .. S AGE1=$P(PREV,"Less than ",2) Q:AGE1=""

 .. S AGE2=$P(AGE,"Greater than ",2) Q:AGE2=""

 .. S VALUE="Less than "_AGE1_" or greater than "_AGE2

 .. K FPARMS(PORD,"AGE",PREV)

 ;

 Q

BQIPLDS2  ;VNGT/HS/ALA-Panel Def Description Utility Cont. ; 04 Feb 2011  1:58 PM

 +1       ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66

 +2       ;

 +3       ;

ALGY      ;EP - Allergy

 +1       ; Only reformat description with designated operand

 +2        IF $GET(FPARMS("ALLOP"))=""

               QUIT 

 +3       ; If only a single Allergy was identified operand is meaningless

 +4        IF '$DATA(FMPARMS("ALLERGY"))

               QUIT 

 +5        SET FPARMS("ALLOP")=$SELECT(FPARMS("ALLOP")="&":", AND ",1:", OR ")

 +6        NEW DX,APM

 +7        SET (DX,APM)=""

           SET FPARMS("ALLERGY")=""

 +8        FOR 

               SET DX=$ORDER(FMPARMS("ALLERGY",DX))

               IF DX=""

                   QUIT 

               Begin DoDot:1

 +9                IF $DATA(AFMPARMS("ALLERGY",DX))

                       Begin DoDot:2

 +10                       SET APM=$$ADDAP^BQIPLDS1("ALLERGY",DX)

                       End DoDot:2

 +11               IF $ORDER(FMPARMS("ALLERGY",DX))=""

                       SET FPARMS("ALLERGY")=FPARMS("ALLERGY")_DX_APM

                       QUIT 

 +12               SET FPARMS("ALLERGY")=FPARMS("ALLERGY")_DX_APM_FPARMS("ALLOP")

               End DoDot:1

 +13       KILL FMPARMS("ALLERGY"),AFMPARMS("ALLERGY")

 +14       QUIT 

 +15      ;

DEC       ;EP - Format Deceased status

 +1        IF $DATA(FPARMS("DEC"))

               Begin DoDot:1

 +2                NEW DEC

 +3                SET DEC=FPARMS("DEC")

 +4                IF DEC="Y"

                       SET DEC="Deceased, "

 +5                IF DEC="N"

                       SET DEC=""

 +6                SET FPARMS("DEC")=DEC

               End DoDot:1

 +7       ;

 +8        IF $DATA(FPARMS("LIV"))

               Begin DoDot:1

 +9                NEW LIV

 +10               SET LIV=FPARMS("LIV")

 +11               IF LIV="Y"

                       SET LIV="Living, "

 +12               IF LIV="N"

                       SET LIV=""

 +13               SET FPARMS("LIV")=LIV

               End DoDot:1

 +14      ;

INAC      ;EP- Inactive patients

 +1        IF $DATA(FPARMS("INAC"))

               Begin DoDot:1

 +2                NEW INAC

 +3                SET INAC=FPARMS("INAC")

 +4                IF INAC="Y"

                       SET INAC="Inactive, "

 +5                IF INAC="N"

                       SET INAC=""

 +6                SET FPARMS("INAC")=INAC

               End DoDot:1

 +7       ;

 +8        SET FPARMS("DEC")=$$TKO^BQIUL1($GET(FPARMS("DEC"))_$GET(FPARMS("LIV"))_$GET(FPARMS("INAC")),", ")

 +9        QUIT 

 +10      ;

ALNAS(VALUE) ;EP - Allergies Not Assessed

 +1       ;

 +2        QUIT $SELECT(VALUE="Y":"Not Assessed",1:"")

 +3       ;

ALNKN(VALUE,PORD,FNAME) ;EP - Allergies Not Known

 +1       ;

 +2       ;Combine with Allergies Not Assessed

 +3        SET PORD=$$PORD^BQIDCDF(FSOURCE,"ALNAS")

           IF PORD=""

               QUIT 

 +4        SET FNAME="ALNAS"

 +5       ;

 +6        QUIT $SELECT(VALUE="Y":"Not Known",1:"")

 +7       ;

AGE       ; Format Age Line

 +1       ;

 +2        NEW PORD,AGE,XAGE

 +3       ;

 +4        SET PORD=$$PORD^BQIDCDF(FSOURCE,"AGE")

           IF PORD=""

               QUIT 

 +5       ;

 +6       ; Added the following line to replace the subsequent code for PR_0124

 +7        IF VALUE]""

               Begin DoDot:1

 +8                NEW EXT,OP,COM

 +9                SET AGE=VALUE

                   SET OP=0

 +10               IF $EXTRACT(AGE,1)="'"

                       SET OP=1

                       SET AGE=$EXTRACT(AGE,2,99)

 +11               SET COM=$EXTRACT(AGE,1)

 +12               IF OP

                       IF COM="<"

                           SET XAGE="Greater than or equal to "

                           SET AGE=$EXTRACT(AGE,2,99)

 +13              IF '$TEST

                       IF OP

                           IF COM=">"

                               SET XAGE="Less than or equal to "

                               SET AGE=$EXTRACT(AGE,2,99)

 +14              IF '$TEST

                       IF COM="<"

                           SET XAGE="Less than "

                           SET AGE=$EXTRACT(AGE,2,99)

 +15              IF '$TEST

                       IF COM=">"

                           SET XAGE="Greater than "

                           SET AGE=$EXTRACT(AGE,2,99)

 +16              IF '$TEST

                       SET XAGE="Equal to "

                       SET AGE=$EXTRACT(AGE,2,99)

 +17      ;

 +18               IF AGE["YRS"

                       SET AGE=XAGE_+AGE_" years"

 +19               IF AGE["MOS"

                       SET AGE=XAGE_+AGE_" months"

 +20               IF AGE["DYS"

                       SET AGE=XAGE_+AGE_" days"

 +21      ;

 +22               SET VALUE=AGE

               End DoDot:1

 +23      ;

 +24       IF $DATA(FPARMS(PORD,"AGE"))>9

               Begin DoDot:1

 +25               NEW PREV,AGE1,AGE2

 +26               SET PREV=$ORDER(FPARMS(PORD,"AGE",""))

                   IF PREV=""

                       QUIT 

 +27      ;

 +28      ;Check for inclusive

 +29               IF PREV["Greater than or equal to"

                       Begin DoDot:2

 +30                       SET AGE1=$PIECE(PREV,"Greater than or equal to ",2)

                           IF AGE1=""

                               QUIT 

 +31                       SET AGE2=$PIECE(AGE,"Less than or equal to ",2)

                           IF AGE2=""

                               QUIT 

 +32                       SET VALUE="Between (inclusive) "_AGE1_" and "_AGE2

 +33                       KILL FPARMS(PORD,"AGE",PREV)

                       End DoDot:2

                       QUIT 

 +34      ;

 +35      ;Check for exclusive

 +36               IF PREV["Less than "

                       Begin DoDot:2

 +37                       SET AGE1=$PIECE(PREV,"Less than ",2)

                           IF AGE1=""

                               QUIT 

 +38                       SET AGE2=$PIECE(AGE,"Greater than ",2)

                           IF AGE2=""

                               QUIT 

 +39                       SET VALUE="Less than "_AGE1_" or greater than "_AGE2

 +40                       KILL FPARMS(PORD,"AGE",PREV)

                       End DoDot:2

                       QUIT 

               End DoDot:1

 +41      ;

 +42       QUIT