PXRMFF0 ;SLC/PKR - Clinical Reminders function finding routines. ;11/30/2011
;;2.0;CLINICAL REMINDERS;**4,6,12,18**;Feb 04, 2005;Build 152
;
;============================================
COUNT(LIST,FIEVAL,COUNT) ;
N IND,JND,KND
S COUNT=0
F IND=1:1:LIST(0) D
. S JND=LIST(IND),KND=0
. F S KND=+$O(FIEVAL(JND,KND)) Q:KND=0 I FIEVAL(JND,KND) S COUNT=COUNT+1
Q
;
;===========================================
DIFFDATE(LIST,FIEVAL,DIFF) ;Return the difference in days between the
;first two findings in the list.
N DATE1,DATE2,DAYS
S DATE1=+$G(FIEVAL(LIST(1),"DATE"))
S DATE2=+$G(FIEVAL(LIST(2),"DATE"))
S DAYS=$$FMDIFF^XLFDT(DATE1,DATE2)
;If LIST(3) is defined then return actual value.
S DIFF=$S($D(LIST(3)):DAYS,DAYS<0:-DAYS,1:DAYS)
Q
;
;===========================================
DTIMDIFF(LIST,FIEVAL,DIFF) ;General date difference function.
N CALCUNIT,DATE1,DATE2,SF
S DATE1=+$G(FIEVAL(LIST(1),LIST(2),LIST(3)))
S DATE2=+$G(FIEVAL(LIST(4),LIST(5),LIST(6)))
;If the passed unit is D get it directly, otherwise use seconds.
S CALCUNIT=$S(LIST(7)="D":1,1:2)
S DIFF=$$FMDIFF^XLFDT(DATE1,DATE2,CALCUNIT)
;If the passed unit is not seconds scale appropriately.
I (CALCUNIT=2),(LIST(7)'="S") S SF=$S(LIST(7)="M":60,LIST(7)="H":3600,1:1),DIFF=DIFF/SF
;If LIST(8) is "A" return absolute value.
I $G(LIST(8))="A" S DIFF=$S(DIFF<0:-DIFF,1:DIFF)
Q
;
;===========================================
DUR(LIST,FIEVAL,DUR) ;
N EDT,IND,JND,KND,SDT
F IND=1:1:LIST(0) D
. S JND=LIST(IND)
. I FIEVAL(JND)=0 S (EDT,SDT)=0 Q
.;Check for finding with start and stop date.
. I $D(FIEVAL(JND,"START DATE")) D
.. S SDT=+$G(FIEVAL(JND,"START DATE"))
.. S EDT=+$G(FIEVAL(JND,"STOP DATE"))
.. I EDT=0 S EDT=+$G(FIEVAL(JND,"DATE"))
. E D
..;Get start and stop for multiple occurrences.
.. S KND=$O(FIEVAL(JND,"A"),-1)
.. S EDT=$S(KND="":0,1:$G(FIEVAL(JND,KND,"DATE")))
.. S KND=+$O(FIEVAL(JND,""))
.. S SDT=$S(KND=0:0,1:$G(FIEVAL(JND,KND,"DATE")))
;Return the duration in days.
S DUR=$$FMDIFF^XLFDT(EDT,SDT)
I DUR<0 S DUR=-DUR
Q
;
;============================================
FI(LIST,FIEVAL,LV) ;Given a regular finding return its true/false value.
S LV=FIEVAL(LIST(1))
Q
;
;============================================
MAXDATE(LIST,FIEVAL,MAXDATE) ;Given a list of findings return the maximum
;date. This will be the newest date.
S MAXDATE=$S(FIEVAL(LIST(1)):FIEVAL(LIST(1),"DATE"),1:0)
I LIST(0)=1 Q
N DATE,IND
F IND=2:1:LIST(0) D
. I 'FIEVAL(LIST(IND)) Q
. S DATE=+$G(FIEVAL(LIST(IND),"DATE"))
. I DATE>MAXDATE S MAXDATE=DATE
Q
;
;============================================
MAXVALUE(LIST,FIEVAL,MAXVALUE) ;Given a list of findings and associated
;CSUBs return the maximum from all the occurrences.
N IND,OCC,TEMP
S MAXVALUE=+$G(FIEVAL(LIST(1),1,LIST(2)))
F IND=1:2:LIST(0) D
. I 'FIEVAL(LIST(IND)) Q
. S OCC=""
. F S OCC=+$O(FIEVAL(LIST(IND),OCC)) Q:OCC=0 D
.. S TEMP=+$G(FIEVAL(LIST(IND),OCC,LIST(IND+1)))
.. I TEMP>MAXVALUE S MAXVALUE=TEMP
Q
;
;============================================
MINDATE(LIST,FIEVAL,MINDATE) ;Given a list of findings return the minimum
;date.
N DLIST,IND
F IND=1:1:LIST(0) S DLIST(+$G(FIEVAL(LIST(IND),"DATE")))=""
S MINDATE=+$O(DLIST(0))
Q
;
;============================================
MINVALUE(LIST,FIEVAL,MINVALUE) ;Given a list of findings return the minimum
;from all the occurrences.
N IND,OCC,TEMP
S MINVALUE=+$G(FIEVAL(LIST(1),1,LIST(2)))
F IND=1:2:LIST(0) D
. I 'FIEVAL(LIST(IND)) Q
. S OCC=""
. F S OCC=+$O(FIEVAL(LIST(IND),OCC)) Q:OCC=0 D
.. S TEMP=+$G(FIEVAL(LIST(IND),OCC,LIST(IND+1)))
.. I TEMP<MINVALUE S MINVALUE=TEMP
Q
;
;============================================
MRD(LIST,FIEVAL,MRD) ;Given a list of findings return the most recent
;finding date from the list.
S MRD=$S(FIEVAL(LIST(1)):FIEVAL(LIST(1),"DATE"),1:0)
I LIST(0)=1 Q
N DATE,IND
F IND=2:1:LIST(0) D
. I 'FIEVAL(LIST(IND)) Q
. S DATE=+$G(FIEVAL(LIST(IND),"DATE"))
. I DATE>MRD S MRD=DATE
Q
;
;============================================
NUMERIC(LIST,FIEVAL,NUMBER) ;Given a finding, return the first numeric
;portion of one of the "CSUB" values. Based on original work
;by R. Silverman.
S NUMBER=$G(FIEVAL(LIST(1),LIST(2),LIST(3)))
S NUMBER=$$FIRSTNUM(NUMBER)
Q
;
FIRSTNUM(STRING) ;return the first numeric portion of a string.
N CHAR,DONE,IND,NUMBER,NUMERIC
S NUMERIC="+-.1234567890"
S STRING=$TR(STRING," ")
S DONE=0,IND=0,NUMBER=""
F Q:DONE D
. S IND=IND+1,CHAR=$E(STRING,IND)
. I CHAR="" S DONE=1 Q
. I NUMERIC[CHAR S NUMBER=NUMBER_CHAR
. I NUMBER'="",NUMERIC'[CHAR S DONE=1
Q +NUMBER
;
;============================================
VALUE(LIST,FIEVAL,VALUE) ;Given a finding return one of its "CSUB"
;values.
S VALUE=$G(FIEVAL(LIST(1),LIST(2),LIST(3)))
Q
;
PXRMFF0 ;SLC/PKR - Clinical Reminders function finding routines. ;11/30/2011
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,18**;Feb 04, 2005;Build 152
+2 ;
+3 ;============================================
COUNT(LIST,FIEVAL,COUNT) ;
+1 NEW IND,JND,KND
+2 SET COUNT=0
+3 FOR IND=1:1:LIST(0)
Begin DoDot:1
+4 SET JND=LIST(IND)
SET KND=0
+5 FOR
SET KND=+$ORDER(FIEVAL(JND,KND))
IF KND=0
QUIT
IF FIEVAL(JND,KND)
SET COUNT=COUNT+1
End DoDot:1
+6 QUIT
+7 ;
+8 ;===========================================
DIFFDATE(LIST,FIEVAL,DIFF) ;Return the difference in days between the
+1 ;first two findings in the list.
+2 NEW DATE1,DATE2,DAYS
+3 SET DATE1=+$GET(FIEVAL(LIST(1),"DATE"))
+4 SET DATE2=+$GET(FIEVAL(LIST(2),"DATE"))
+5 SET DAYS=$$FMDIFF^XLFDT(DATE1,DATE2)
+6 ;If LIST(3) is defined then return actual value.
+7 SET DIFF=$SELECT($DATA(LIST(3)):DAYS,DAYS<0:-DAYS,1:DAYS)
+8 QUIT
+9 ;
+10 ;===========================================
DTIMDIFF(LIST,FIEVAL,DIFF) ;General date difference function.
+1 NEW CALCUNIT,DATE1,DATE2,SF
+2 SET DATE1=+$GET(FIEVAL(LIST(1),LIST(2),LIST(3)))
+3 SET DATE2=+$GET(FIEVAL(LIST(4),LIST(5),LIST(6)))
+4 ;If the passed unit is D get it directly, otherwise use seconds.
+5 SET CALCUNIT=$SELECT(LIST(7)="D":1,1:2)
+6 SET DIFF=$$FMDIFF^XLFDT(DATE1,DATE2,CALCUNIT)
+7 ;If the passed unit is not seconds scale appropriately.
+8 IF (CALCUNIT=2)
IF (LIST(7)'="S")
SET SF=$SELECT(LIST(7)="M":60,LIST(7)="H":3600,1:1)
SET DIFF=DIFF/SF
+9 ;If LIST(8) is "A" return absolute value.
+10 IF $GET(LIST(8))="A"
SET DIFF=$SELECT(DIFF<0:-DIFF,1:DIFF)
+11 QUIT
+12 ;
+13 ;===========================================
DUR(LIST,FIEVAL,DUR) ;
+1 NEW EDT,IND,JND,KND,SDT
+2 FOR IND=1:1:LIST(0)
Begin DoDot:1
+3 SET JND=LIST(IND)
+4 IF FIEVAL(JND)=0
SET (EDT,SDT)=0
QUIT
+5 ;Check for finding with start and stop date.
+6 IF $DATA(FIEVAL(JND,"START DATE"))
Begin DoDot:2
+7 SET SDT=+$GET(FIEVAL(JND,"START DATE"))
+8 SET EDT=+$GET(FIEVAL(JND,"STOP DATE"))
+9 IF EDT=0
SET EDT=+$GET(FIEVAL(JND,"DATE"))
End DoDot:2
+10 IF '$TEST
Begin DoDot:2
+11 ;Get start and stop for multiple occurrences.
+12 SET KND=$ORDER(FIEVAL(JND,"A"),-1)
+13 SET EDT=$SELECT(KND="":0,1:$GET(FIEVAL(JND,KND,"DATE")))
+14 SET KND=+$ORDER(FIEVAL(JND,""))
+15 SET SDT=$SELECT(KND=0:0,1:$GET(FIEVAL(JND,KND,"DATE")))
End DoDot:2
End DoDot:1
+16 ;Return the duration in days.
+17 SET DUR=$$FMDIFF^XLFDT(EDT,SDT)
+18 IF DUR<0
SET DUR=-DUR
+19 QUIT
+20 ;
+21 ;============================================
FI(LIST,FIEVAL,LV) ;Given a regular finding return its true/false value.
+1 SET LV=FIEVAL(LIST(1))
+2 QUIT
+3 ;
+4 ;============================================
MAXDATE(LIST,FIEVAL,MAXDATE) ;Given a list of findings return the maximum
+1 ;date. This will be the newest date.
+2 SET MAXDATE=$SELECT(FIEVAL(LIST(1)):FIEVAL(LIST(1),"DATE"),1:0)
+3 IF LIST(0)=1
QUIT
+4 NEW DATE,IND
+5 FOR IND=2:1:LIST(0)
Begin DoDot:1
+6 IF 'FIEVAL(LIST(IND))
QUIT
+7 SET DATE=+$GET(FIEVAL(LIST(IND),"DATE"))
+8 IF DATE>MAXDATE
SET MAXDATE=DATE
End DoDot:1
+9 QUIT
+10 ;
+11 ;============================================
MAXVALUE(LIST,FIEVAL,MAXVALUE) ;Given a list of findings and associated
+1 ;CSUBs return the maximum from all the occurrences.
+2 NEW IND,OCC,TEMP
+3 SET MAXVALUE=+$GET(FIEVAL(LIST(1),1,LIST(2)))
+4 FOR IND=1:2:LIST(0)
Begin DoDot:1
+5 IF 'FIEVAL(LIST(IND))
QUIT
+6 SET OCC=""
+7 FOR
SET OCC=+$ORDER(FIEVAL(LIST(IND),OCC))
IF OCC=0
QUIT
Begin DoDot:2
+8 SET TEMP=+$GET(FIEVAL(LIST(IND),OCC,LIST(IND+1)))
+9 IF TEMP>MAXVALUE
SET MAXVALUE=TEMP
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
+12 ;============================================
MINDATE(LIST,FIEVAL,MINDATE) ;Given a list of findings return the minimum
+1 ;date.
+2 NEW DLIST,IND
+3 FOR IND=1:1:LIST(0)
SET DLIST(+$GET(FIEVAL(LIST(IND),"DATE")))=""
+4 SET MINDATE=+$ORDER(DLIST(0))
+5 QUIT
+6 ;
+7 ;============================================
MINVALUE(LIST,FIEVAL,MINVALUE) ;Given a list of findings return the minimum
+1 ;from all the occurrences.
+2 NEW IND,OCC,TEMP
+3 SET MINVALUE=+$GET(FIEVAL(LIST(1),1,LIST(2)))
+4 FOR IND=1:2:LIST(0)
Begin DoDot:1
+5 IF 'FIEVAL(LIST(IND))
QUIT
+6 SET OCC=""
+7 FOR
SET OCC=+$ORDER(FIEVAL(LIST(IND),OCC))
IF OCC=0
QUIT
Begin DoDot:2
+8 SET TEMP=+$GET(FIEVAL(LIST(IND),OCC,LIST(IND+1)))
+9 IF TEMP<MINVALUE
SET MINVALUE=TEMP
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
+12 ;============================================
MRD(LIST,FIEVAL,MRD) ;Given a list of findings return the most recent
+1 ;finding date from the list.
+2 SET MRD=$SELECT(FIEVAL(LIST(1)):FIEVAL(LIST(1),"DATE"),1:0)
+3 IF LIST(0)=1
QUIT
+4 NEW DATE,IND
+5 FOR IND=2:1:LIST(0)
Begin DoDot:1
+6 IF 'FIEVAL(LIST(IND))
QUIT
+7 SET DATE=+$GET(FIEVAL(LIST(IND),"DATE"))
+8 IF DATE>MRD
SET MRD=DATE
End DoDot:1
+9 QUIT
+10 ;
+11 ;============================================
NUMERIC(LIST,FIEVAL,NUMBER) ;Given a finding, return the first numeric
+1 ;portion of one of the "CSUB" values. Based on original work
+2 ;by R. Silverman.
+3 SET NUMBER=$GET(FIEVAL(LIST(1),LIST(2),LIST(3)))
+4 SET NUMBER=$$FIRSTNUM(NUMBER)
+5 QUIT
+6 ;
FIRSTNUM(STRING) ;return the first numeric portion of a string.
+1 NEW CHAR,DONE,IND,NUMBER,NUMERIC
+2 SET NUMERIC="+-.1234567890"
+3 SET STRING=$TRANSLATE(STRING," ")
+4 SET DONE=0
SET IND=0
SET NUMBER=""
+5 FOR
IF DONE
QUIT
Begin DoDot:1
+6 SET IND=IND+1
SET CHAR=$EXTRACT(STRING,IND)
+7 IF CHAR=""
SET DONE=1
QUIT
+8 IF NUMERIC[CHAR
SET NUMBER=NUMBER_CHAR
+9 IF NUMBER'=""
IF NUMERIC'[CHAR
SET DONE=1
End DoDot:1
+10 QUIT +NUMBER
+11 ;
+12 ;============================================
VALUE(LIST,FIEVAL,VALUE) ;Given a finding return one of its "CSUB"
+1 ;values.
+2 SET VALUE=$GET(FIEVAL(LIST(1),LIST(2),LIST(3)))
+3 QUIT
+4 ;
