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
