source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFF0.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1PXRMFF0 ;SLC/PKR - Clinical Reminders function finding routines. ;09/11/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;============================================
5COUNT(LIST,FIEVAL,COUNT) ;
6 N IND,JND,KND
7 S COUNT=0
8 F IND=1:1:LIST(0) D
9 . S JND=LIST(IND),KND=0
10 . F S KND=+$O(FIEVAL(JND,KND)) Q:KND=0 D
11 .. I FIEVAL(JND,KND) S COUNT=COUNT+1
12 Q
13 ;
14 ;===========================================
15DIFFDATE(LIST,FIEVAL,DIFF) ;Return the difference in days between the
16 ;first two findings in the list.
17 I LIST(0)<2 S DIFF=2 Q
18 N DATE1,DATE2,DAYS,IND,JND
19 S DATE1=+$G(FIEVAL(LIST(1),"DATE"))
20 S DATE2=+$G(FIEVAL(LIST(2),"DATE"))
21 S DAYS=$$FMDIFF^XLFDT(DATE1,DATE2)
22 S DIFF=$S(DAYS<0:-DAYS,1:DAYS)
23 Q
24 ;
25 ;===========================================
26DUR(LIST,FIEVAL,DUR) ;
27 N EDT,IND,JND,KND,SDT
28 F IND=1:1:LIST(0) D
29 . S JND=LIST(IND)
30 . I FIEVAL(JND)=0 S (EDT,SDT)=0 Q
31 .;Check for finding with start and stop date.
32 . I $D(FIEVAL(JND,"START DATE")) D
33 .. S SDT=+$G(FIEVAL(JND,"START DATE"))
34 .. S EDT=+$G(FIEVAL(JND,"STOP DATE"))
35 .. I EDT=0 S EDT=+$G(FIEVAL(JND,"DATE"))
36 . E D
37 ..;Get start and stop for multiple occurrences.
38 .. S KND=$O(FIEVAL(JND,"A"),-1)
39 .. S EDT=$S(KND="":0,1:$G(FIEVAL(JND,KND,"DATE")))
40 .. S KND=+$O(FIEVAL(JND,""))
41 .. S SDT=$S(KND=0:0,1:$G(FIEVAL(JND,KND,"DATE")))
42 ;Return the duration in days.
43 S DUR=$$FMDIFF^XLFDT(EDT,SDT)
44 I DUR<0 S DUR=-DUR
45 Q
46 ;
47 ;============================================
48FI(LIST,FIEVAL,LV) ;Given a regular finding return its true/false value.
49 S LV=FIEVAL(LIST(1))
50 Q
51 ;
52 ;============================================
53MAXDATE(LIST,FIEVAL,MAXDATE) ;Given a list of findings return the maximum
54 ;date. This will be the newest date.
55 N DATE,IND
56 S MAXDATE=0
57 F IND=1:1:LIST(0) D
58 . S DATE=$G(FIEVAL(LIST(IND),"DATE"))
59 . I DATE>MAXDATE S MAXDATE=DATE
60 Q
61 ;
62 ;============================================
63MINDATE(LIST,FIEVAL,MINDATE) ;Given a list of findings return the minimum
64 ;date. This will be the oldest non-null or zero date.
65 N DATE,IND
66 S MINDATE=9991231
67 F IND=1:1:LIST(0) D
68 . S DATE=$G(FIEVAL(LIST(IND),"DATE"))
69 . I DATE<MINDATE S MINDATE=DATE
70 I MINDATE=9991231 S MINDATE=0
71 Q
72 ;
73 ;============================================
74MRD(LIST,FIEVAL,MRD) ;Given a list of findings return the most recent
75 ;finding date from the list.
76 N DATE,IND
77 S MRD=0
78 F IND=1:1:LIST(0) D
79 . S DATE=$G(FIEVAL(LIST(IND),"DATE"))
80 . I DATE>MRD S MRD=DATE
81 Q
82 ;
83 ;============================================
84NUMERIC(LIST,FIEVAL,VALUE) ;Given a finding, return the first numeric
85 ;portion of one of the "CSUB" values. Based on original work
86 ;by R. Silverman.
87 S VALUE=$G(FIEVAL(LIST(1),LIST(2),LIST(3)))
88 S VALUE=$$FIRSTNUM(VALUE)
89 Q
90 ;
91FIRSTNUM(STRING) ;return the first numeric portion of a string.
92 N CHAR,DONE,IND,NUMBER,NUMERIC
93 S NUMERIC="+-.1234567890"
94 S STRING=$TR(STRING," ")
95 S DONE=0,IND=0,NUMBER=""
96 F Q:DONE D
97 . S IND=IND+1,CHAR=$E(STRING,IND)
98 . I CHAR="" S DONE=1 Q
99 . I NUMERIC[CHAR S NUMBER=NUMBER_CHAR
100 . I NUMBER'="",NUMERIC'[CHAR S DONE=1
101 Q +NUMBER
102 ;
103 ;============================================
104VALUE(LIST,FIEVAL,VALUE) ;Given a finding return one of its "CSUB"
105 ;values.
106 S VALUE=$G(FIEVAL(LIST(1),LIST(2),LIST(3)))
107 Q
108 ;
Note: See TracBrowser for help on using the repository browser.