PXRMFF0 ;SLC/PKR - Clinical Reminders function finding routines. ;02/22/2022
;;2.0;CLINICAL REMINDERS;**4,6,12,18,47,42,65**;Feb 04, 2005;Build 438
;
;============================================
COUNT(LIST,FIEVAL,COUNT) ;
N C1,IND,JND,KND
S COUNT=0
F IND=1:1:LIST(0) D
. S C1=$E(LIST(IND),1)
. I (C1="C")!(C1="R") D Q
.. N CRSUB,SUB
.. S SUB=$E(LIST(IND),2,15)
.. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
.. S KND=0
.. F S KND=+$O(FIEVAL(CRSUB,SUB,KND)) Q:KND=0 I $D(FIEVAL(CRSUB,SUB,KND)) S COUNT=COUNT+1
.;
. 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 C1,CRSUB,DATE1,DATE2,DAYS,SUB
S C1=$E(LIST(1),1)
I (C1="C")!(C1="R") D
. S SUB=$E(LIST(1),2,15)
. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
. S DATE1=+$G(FIEVAL(CRSUB,SUB,"DATE"))
E S DATE1=+$G(FIEVAL(LIST(1),"DATE"))
S C1=$E(LIST(2),1)
I (C1="C")!(C1="R") D
. S SUB=$E(LIST(2),2,15)
. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
. S DATE2=+$G(FIEVAL(CRSUB,SUB,"DATE"))
E 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 C1,CALCUNIT,CRSUB,DATE1,DATE2,SF,SUB
S C1=$E(LIST(1),1)
I (C1="C")!(C1="R") D
. S SUB=$E(LIST(1),2,15)
. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
. S DATE1=+$G(FIEVAL(CRSUB,SUB,LIST(2),LIST(3)))
E S DATE1=+$G(FIEVAL(LIST(1),LIST(2),LIST(3)))
S C1=$E(LIST(4),1)
I (C1="C")!(C1="R") D
. S SUB=$E(LIST(4),2,15)
. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
. S DATE2=+$G(FIEVAL(CRSUB,SUB,LIST(5),LIST(6)))
E 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 C1,CRSUB,EDT,IND,JND,KND,SDT,SUB
S C1=$E(LIST(1),1)
I (C1="C")!(C1="R") D
. S SUB=$E(LIST(1),2,15)
. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
. I +$G(FIEVAL(CRSUB,SUB))=0 S (EDT,SDT)=0 Q
.;Get start and stop for multiple occurrences.
. S KND=$O(FIEVAL(CRSUB,SUB,"A"),-1)
. S EDT=$S(KND="":0,1:$G(FIEVAL(CRSUB,SUB,KND,"DATE")))
. S KND=+$O(FIEVAL(CRSUB,SUB,""))
. S SDT=$S(KND=0:0,1:$G(FIEVAL(CRSUB,SUB,KND,"DATE")))
E D
. S JND=LIST(1)
. 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.
N C1,CRSUB,SUB
S C1=$E(LIST(1),1)
I (C1="C")!(C1="R") D
. S SUB=$E(LIST(1),2,15)
. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
. S LV=+$G(FIEVAL(CRSUB,SUB))
E 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.
N C1,CRSUB,SUB
S C1=$E(LIST(1),1)
I (C1="C")!(C1="R") D
. S SUB=$E(LIST(1),2,15)
. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
. S MAXDATE=+$G(FIEVAL(CRSUB,SUB,"DATE"))
E S MAXDATE=+$G(FIEVAL(LIST(1),"DATE"))
I LIST(0)=1 Q
N DATE,IND
F IND=2:1:LIST(0) D
. S C1=$E(LIST(IND),1)
. I (C1="C")!(C1="R") D
.. S SUB=$E(LIST(IND),2,15)
.. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
.. S DATE=+$G(FIEVAL(CRSUB,SUB,"DATE"))
. E 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 C1,CRSUB,SUB
S C1=$E(LIST(1),1)
I (C1="C")!(C1="R") D
. S SUB=$E(LIST(1),2,15)
. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
. S MINDATE=+$G(FIEVAL(CRSUB,SUB,"DATE"))
E S MINDATE=+$G(FIEVAL(LIST(1),"DATE"))
I LIST(0)=1 Q
N DATE,IND
F IND=2:1:LIST(0) D
. S C1=$E(LIST(IND),1)
. I (C1="C")!(C1="R") D
.. S SUB=$E(LIST(IND),2,15)
.. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
.. S DATE=+$G(FIEVAL(CRSUB,SUB,"DATE"))
. E S DATE=+$G(FIEVAL(LIST(IND),"DATE"))
. I DATE<MINDATE S MINDATE=DATE
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.
N C1,CRSUB,SUB
S C1=$E(LIST(1),1)
I (C1="C")!(C1="R") D
. S SUB=$E(LIST(1),2,15)
. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
. S MRD=+$G(FIEVAL(CRSUB,SUB,"DATE"))
E S MRD=+$G(FIEVAL(LIST(1),"DATE"))
I LIST(0)=1 Q
N DATE,IND
F IND=2:1:LIST(0) D
. S C1=$E(LIST(IND),1)
. I (C1="C")!(C1="R") D
.. S SUB=$E(LIST(IND),2,15)
.. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
.. S DATE=+$G(FIEVAL(CRSUB,SUB,"DATE"))
. E 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.
I LIST(0)=2 S NUMBER=$G(FIEVAL(LIST(1),LIST(2)))
I LIST(0)=3 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.
N C1
S C1=$E(LIST(1),1)
I (C1="C")!(C1="R") D Q
. N CRSUB,SUB
. S SUB=$E(LIST(1),2,15)
. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
. ;I LIST(0)=2 S VALUE=$G(FIEVAL(CRSUB,SUB,LIST(2))) Q
. I LIST(0)=3 S VALUE=$G(FIEVAL(CRSUB,SUB,LIST(2),LIST(3)))
. I LIST(0)=2 S VALUE=$G(FIEVAL(CRSUB,SUB,LIST(2)))
;
;I LIST(0)=2 S VALUE=$G(FIEVAL(LIST(1),LIST(2))) Q
I LIST(0)=3 S VALUE=$G(FIEVAL(LIST(1),LIST(2),LIST(3)))
I LIST(0)=2 S VALUE=$G(FIEVAL(LIST(1),LIST(2)))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMFF0 8123 printed Oct 16, 2024@17:46:14 Page 2
PXRMFF0 ;SLC/PKR - Clinical Reminders function finding routines. ;02/22/2022
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,18,47,42,65**;Feb 04, 2005;Build 438
+2 ;
+3 ;============================================
COUNT(LIST,FIEVAL,COUNT) ;
+1 NEW C1,IND,JND,KND
+2 SET COUNT=0
+3 FOR IND=1:1:LIST(0)
Begin DoDot:1
+4 SET C1=$EXTRACT(LIST(IND),1)
+5 IF (C1="C")!(C1="R")
Begin DoDot:2
+6 NEW CRSUB,SUB
+7 SET SUB=$EXTRACT(LIST(IND),2,15)
+8 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+9 SET KND=0
+10 FOR
SET KND=+$ORDER(FIEVAL(CRSUB,SUB,KND))
if KND=0
QUIT
IF $DATA(FIEVAL(CRSUB,SUB,KND))
SET COUNT=COUNT+1
End DoDot:2
QUIT
+11 ;
+12 SET JND=LIST(IND)
SET KND=0
+13 FOR
SET KND=+$ORDER(FIEVAL(JND,KND))
if KND=0
QUIT
IF FIEVAL(JND,KND)
SET COUNT=COUNT+1
End DoDot:1
+14 QUIT
+15 ;
+16 ;===========================================
DIFFDATE(LIST,FIEVAL,DIFF) ;Return the difference in days between the
+1 ;first two findings in the list.
+2 NEW C1,CRSUB,DATE1,DATE2,DAYS,SUB
+3 SET C1=$EXTRACT(LIST(1),1)
+4 IF (C1="C")!(C1="R")
Begin DoDot:1
+5 SET SUB=$EXTRACT(LIST(1),2,15)
+6 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+7 SET DATE1=+$GET(FIEVAL(CRSUB,SUB,"DATE"))
End DoDot:1
+8 IF '$TEST
SET DATE1=+$GET(FIEVAL(LIST(1),"DATE"))
+9 SET C1=$EXTRACT(LIST(2),1)
+10 IF (C1="C")!(C1="R")
Begin DoDot:1
+11 SET SUB=$EXTRACT(LIST(2),2,15)
+12 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+13 SET DATE2=+$GET(FIEVAL(CRSUB,SUB,"DATE"))
End DoDot:1
+14 IF '$TEST
SET DATE2=+$GET(FIEVAL(LIST(2),"DATE"))
+15 SET DAYS=$$FMDIFF^XLFDT(DATE1,DATE2)
+16 ;If LIST(3) is defined then return actual value.
+17 SET DIFF=$SELECT($DATA(LIST(3)):DAYS,DAYS<0:-DAYS,1:DAYS)
+18 QUIT
+19 ;
+20 ;===========================================
DTIMDIFF(LIST,FIEVAL,DIFF) ;General date difference function.
+1 NEW C1,CALCUNIT,CRSUB,DATE1,DATE2,SF,SUB
+2 SET C1=$EXTRACT(LIST(1),1)
+3 IF (C1="C")!(C1="R")
Begin DoDot:1
+4 SET SUB=$EXTRACT(LIST(1),2,15)
+5 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+6 SET DATE1=+$GET(FIEVAL(CRSUB,SUB,LIST(2),LIST(3)))
End DoDot:1
+7 IF '$TEST
SET DATE1=+$GET(FIEVAL(LIST(1),LIST(2),LIST(3)))
+8 SET C1=$EXTRACT(LIST(4),1)
+9 IF (C1="C")!(C1="R")
Begin DoDot:1
+10 SET SUB=$EXTRACT(LIST(4),2,15)
+11 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+12 SET DATE2=+$GET(FIEVAL(CRSUB,SUB,LIST(5),LIST(6)))
End DoDot:1
+13 IF '$TEST
SET DATE2=+$GET(FIEVAL(LIST(4),LIST(5),LIST(6)))
+14 ;If the passed unit is D get it directly, otherwise use seconds.
+15 SET CALCUNIT=$SELECT(LIST(7)="D":1,1:2)
+16 SET DIFF=$$FMDIFF^XLFDT(DATE1,DATE2,CALCUNIT)
+17 ;If the passed unit is not seconds scale appropriately.
+18 IF (CALCUNIT=2)
IF (LIST(7)'="S")
SET SF=$SELECT(LIST(7)="M":60,LIST(7)="H":3600,1:1)
SET DIFF=DIFF/SF
+19 ;If LIST(8) is "A" return absolute value.
+20 IF $GET(LIST(8))="A"
SET DIFF=$SELECT(DIFF<0:-DIFF,1:DIFF)
+21 QUIT
+22 ;
+23 ;===========================================
DUR(LIST,FIEVAL,DUR) ;
+1 NEW C1,CRSUB,EDT,IND,JND,KND,SDT,SUB
+2 SET C1=$EXTRACT(LIST(1),1)
+3 IF (C1="C")!(C1="R")
Begin DoDot:1
+4 SET SUB=$EXTRACT(LIST(1),2,15)
+5 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+6 IF +$GET(FIEVAL(CRSUB,SUB))=0
SET (EDT,SDT)=0
QUIT
+7 ;Get start and stop for multiple occurrences.
+8 SET KND=$ORDER(FIEVAL(CRSUB,SUB,"A"),-1)
+9 SET EDT=$SELECT(KND="":0,1:$GET(FIEVAL(CRSUB,SUB,KND,"DATE")))
+10 SET KND=+$ORDER(FIEVAL(CRSUB,SUB,""))
+11 SET SDT=$SELECT(KND=0:0,1:$GET(FIEVAL(CRSUB,SUB,KND,"DATE")))
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET JND=LIST(1)
+14 IF FIEVAL(JND)=0
SET (EDT,SDT)=0
QUIT
+15 ;Check for finding with start and stop date.
+16 IF $DATA(FIEVAL(JND,"START DATE"))
Begin DoDot:2
+17 SET SDT=+$GET(FIEVAL(JND,"START DATE"))
+18 SET EDT=+$GET(FIEVAL(JND,"STOP DATE"))
+19 IF EDT=0
SET EDT=+$GET(FIEVAL(JND,"DATE"))
End DoDot:2
+20 IF '$TEST
Begin DoDot:2
+21 ;Get start and stop for multiple occurrences.
+22 SET KND=$ORDER(FIEVAL(JND,"A"),-1)
+23 SET EDT=$SELECT(KND="":0,1:$GET(FIEVAL(JND,KND,"DATE")))
+24 SET KND=+$ORDER(FIEVAL(JND,""))
+25 SET SDT=$SELECT(KND=0:0,1:$GET(FIEVAL(JND,KND,"DATE")))
End DoDot:2
End DoDot:1
+26 ;Return the duration in days.
+27 SET DUR=$$FMDIFF^XLFDT(EDT,SDT)
+28 IF DUR<0
SET DUR=-DUR
+29 QUIT
+30 ;
+31 ;============================================
FI(LIST,FIEVAL,LV) ;Given a regular finding return its true/false value.
+1 NEW C1,CRSUB,SUB
+2 SET C1=$EXTRACT(LIST(1),1)
+3 IF (C1="C")!(C1="R")
Begin DoDot:1
+4 SET SUB=$EXTRACT(LIST(1),2,15)
+5 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+6 SET LV=+$GET(FIEVAL(CRSUB,SUB))
End DoDot:1
+7 IF '$TEST
SET LV=FIEVAL(LIST(1))
+8 QUIT
+9 ;
+10 ;============================================
MAXDATE(LIST,FIEVAL,MAXDATE) ;Given a list of findings return the maximum
+1 ;date. This will be the newest date.
+2 NEW C1,CRSUB,SUB
+3 SET C1=$EXTRACT(LIST(1),1)
+4 IF (C1="C")!(C1="R")
Begin DoDot:1
+5 SET SUB=$EXTRACT(LIST(1),2,15)
+6 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+7 SET MAXDATE=+$GET(FIEVAL(CRSUB,SUB,"DATE"))
End DoDot:1
+8 IF '$TEST
SET MAXDATE=+$GET(FIEVAL(LIST(1),"DATE"))
+9 IF LIST(0)=1
QUIT
+10 NEW DATE,IND
+11 FOR IND=2:1:LIST(0)
Begin DoDot:1
+12 SET C1=$EXTRACT(LIST(IND),1)
+13 IF (C1="C")!(C1="R")
Begin DoDot:2
+14 SET SUB=$EXTRACT(LIST(IND),2,15)
+15 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+16 SET DATE=+$GET(FIEVAL(CRSUB,SUB,"DATE"))
End DoDot:2
+17 IF '$TEST
SET DATE=+$GET(FIEVAL(LIST(IND),"DATE"))
+18 IF DATE>MAXDATE
SET MAXDATE=DATE
End DoDot:1
+19 QUIT
+20 ;
+21 ;============================================
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 C1,CRSUB,SUB
+3 SET C1=$EXTRACT(LIST(1),1)
+4 IF (C1="C")!(C1="R")
Begin DoDot:1
+5 SET SUB=$EXTRACT(LIST(1),2,15)
+6 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+7 SET MINDATE=+$GET(FIEVAL(CRSUB,SUB,"DATE"))
End DoDot:1
+8 IF '$TEST
SET MINDATE=+$GET(FIEVAL(LIST(1),"DATE"))
+9 IF LIST(0)=1
QUIT
+10 NEW DATE,IND
+11 FOR IND=2:1:LIST(0)
Begin DoDot:1
+12 SET C1=$EXTRACT(LIST(IND),1)
+13 IF (C1="C")!(C1="R")
Begin DoDot:2
+14 SET SUB=$EXTRACT(LIST(IND),2,15)
+15 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+16 SET DATE=+$GET(FIEVAL(CRSUB,SUB,"DATE"))
End DoDot:2
+17 IF '$TEST
SET DATE=+$GET(FIEVAL(LIST(IND),"DATE"))
+18 IF DATE<MINDATE
SET MINDATE=DATE
End DoDot:1
+19 QUIT
+20 ;
+21 ;============================================
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 NEW C1,CRSUB,SUB
+3 SET C1=$EXTRACT(LIST(1),1)
+4 IF (C1="C")!(C1="R")
Begin DoDot:1
+5 SET SUB=$EXTRACT(LIST(1),2,15)
+6 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+7 SET MRD=+$GET(FIEVAL(CRSUB,SUB,"DATE"))
End DoDot:1
+8 IF '$TEST
SET MRD=+$GET(FIEVAL(LIST(1),"DATE"))
+9 IF LIST(0)=1
QUIT
+10 NEW DATE,IND
+11 FOR IND=2:1:LIST(0)
Begin DoDot:1
+12 SET C1=$EXTRACT(LIST(IND),1)
+13 IF (C1="C")!(C1="R")
Begin DoDot:2
+14 SET SUB=$EXTRACT(LIST(IND),2,15)
+15 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+16 SET DATE=+$GET(FIEVAL(CRSUB,SUB,"DATE"))
End DoDot:2
+17 IF '$TEST
SET DATE=+$GET(FIEVAL(LIST(IND),"DATE"))
+18 IF DATE>MRD
SET MRD=DATE
End DoDot:1
+19 QUIT
+20 ;
+21 ;============================================
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 IF LIST(0)=2
SET NUMBER=$GET(FIEVAL(LIST(1),LIST(2)))
+4 IF LIST(0)=3
SET NUMBER=$GET(FIEVAL(LIST(1),LIST(2),LIST(3)))
+5 SET NUMBER=$$FIRSTNUM(NUMBER)
+6 QUIT
+7 ;
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 NEW C1
+3 SET C1=$EXTRACT(LIST(1),1)
+4 IF (C1="C")!(C1="R")
Begin DoDot:1
+5 NEW CRSUB,SUB
+6 SET SUB=$EXTRACT(LIST(1),2,15)
+7 SET CRSUB=$SELECT(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
+8 ;I LIST(0)=2 S VALUE=$G(FIEVAL(CRSUB,SUB,LIST(2))) Q
+9 IF LIST(0)=3
SET VALUE=$GET(FIEVAL(CRSUB,SUB,LIST(2),LIST(3)))
+10 IF LIST(0)=2
SET VALUE=$GET(FIEVAL(CRSUB,SUB,LIST(2)))
End DoDot:1
QUIT
+11 ;
+12 ;I LIST(0)=2 S VALUE=$G(FIEVAL(LIST(1),LIST(2))) Q
+13 IF LIST(0)=3
SET VALUE=$GET(FIEVAL(LIST(1),LIST(2),LIST(3)))
+14 IF LIST(0)=2
SET VALUE=$GET(FIEVAL(LIST(1),LIST(2)))
+15 QUIT
+16 ;
