Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFF0.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFF0.m
r613 r623 1 PXRMFF0 ;SLC/PKR - Clinical Reminders function finding routines. ;09/11/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;============================================ 5 COUNT(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 ;=========================================== 15 DIFFDATE(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 ;=========================================== 26 DUR(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 ;============================================ 48 FI(LIST,FIEVAL,LV) ;Given a regular finding return its true/false value. 49 S LV=FIEVAL(LIST(1)) 50 Q 51 ; 52 ;============================================ 53 MAXDATE(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 ;============================================ 63 MINDATE(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 ;============================================ 74 MRD(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 ;============================================ 84 NUMERIC(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 ; 91 FIRSTNUM(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 ;============================================ 104 VALUE(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 ; 1 PXRMFF0 ;SLC/PKR - Clinical Reminders function finding routines. ;06/23/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;============================================ 5 COUNT(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 ;=========================================== 15 DIFFDATE(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 ;=========================================== 26 DUR(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 ;============================================ 48 FI(LIST,FIEVAL,LV) ;Given a regular finding return its true/false value. 49 S LV=FIEVAL(LIST(1)) 50 Q 51 ; 52 ;============================================ 53 MAXDATE(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 ;============================================ 63 MINDATE(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 ;============================================ 74 MRD(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 ;============================================ 84 VALUE(LIST,FIEVAL,VALUE) ;Given a finding return one of its "CSUB" 85 ;values. 86 S VALUE=$G(FIEVAL(LIST(1),LIST(2),LIST(3))) 87 Q 88 ;
Note:
See TracChangeset
for help on using the changeset viewer.
