Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMFF0

PXRMFF0.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;============================================
  1. COUNT(LIST,FIEVAL,COUNT) ;
  1.  N C1,IND,JND,KND
  1.  S COUNT=0
  1.  F IND=1:1:LIST(0) D
  1.  . S C1=$E(LIST(IND),1)
  1.  . I (C1="C")!(C1="R") D  Q
  1.  .. N CRSUB,SUB
  1.  .. S SUB=$E(LIST(IND),2,15)
  1.  .. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  .. S KND=0
  1.  .. F  S KND=+$O(FIEVAL(CRSUB,SUB,KND)) Q:KND=0  I $D(FIEVAL(CRSUB,SUB,KND)) S COUNT=COUNT+1
  1.  .;
  1.  . S JND=LIST(IND),KND=0
  1.  . F  S KND=+$O(FIEVAL(JND,KND)) Q:KND=0  I FIEVAL(JND,KND) S COUNT=COUNT+1
  1.  Q
  1.  ;
  1.  ;===========================================
  1. DIFFDATE(LIST,FIEVAL,DIFF) ;Return the difference in days between the
  1.  ;first two findings in the list.
  1.  N C1,CRSUB,DATE1,DATE2,DAYS,SUB
  1.  S C1=$E(LIST(1),1)
  1.  I (C1="C")!(C1="R") D
  1.  . S SUB=$E(LIST(1),2,15)
  1.  . S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  . S DATE1=+$G(FIEVAL(CRSUB,SUB,"DATE"))
  1.  E  S DATE1=+$G(FIEVAL(LIST(1),"DATE"))
  1.  S C1=$E(LIST(2),1)
  1.  I (C1="C")!(C1="R") D
  1.  . S SUB=$E(LIST(2),2,15)
  1.  . S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  . S DATE2=+$G(FIEVAL(CRSUB,SUB,"DATE"))
  1.  E  S DATE2=+$G(FIEVAL(LIST(2),"DATE"))
  1.  S DAYS=$$FMDIFF^XLFDT(DATE1,DATE2)
  1.  ;If LIST(3) is defined then return actual value.
  1.  S DIFF=$S($D(LIST(3)):DAYS,DAYS<0:-DAYS,1:DAYS)
  1.  Q
  1.  ;
  1.  ;===========================================
  1. DTIMDIFF(LIST,FIEVAL,DIFF) ;General date difference function.
  1.  N C1,CALCUNIT,CRSUB,DATE1,DATE2,SF,SUB
  1.  S C1=$E(LIST(1),1)
  1.  I (C1="C")!(C1="R") D
  1.  . S SUB=$E(LIST(1),2,15)
  1.  . S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  . S DATE1=+$G(FIEVAL(CRSUB,SUB,LIST(2),LIST(3)))
  1.  E  S DATE1=+$G(FIEVAL(LIST(1),LIST(2),LIST(3)))
  1.  S C1=$E(LIST(4),1)
  1.  I (C1="C")!(C1="R") D
  1.  . S SUB=$E(LIST(4),2,15)
  1.  . S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  . S DATE2=+$G(FIEVAL(CRSUB,SUB,LIST(5),LIST(6)))
  1.  E  S DATE2=+$G(FIEVAL(LIST(4),LIST(5),LIST(6)))
  1.  ;If the passed unit is D get it directly, otherwise use seconds.
  1.  S CALCUNIT=$S(LIST(7)="D":1,1:2)
  1.  S DIFF=$$FMDIFF^XLFDT(DATE1,DATE2,CALCUNIT)
  1.  ;If the passed unit is not seconds scale appropriately. 
  1.  I (CALCUNIT=2),(LIST(7)'="S") S SF=$S(LIST(7)="M":60,LIST(7)="H":3600,1:1),DIFF=DIFF/SF
  1.  ;If LIST(8) is "A" return absolute value.
  1.  I $G(LIST(8))="A" S DIFF=$S(DIFF<0:-DIFF,1:DIFF)
  1.  Q
  1.  ;
  1.  ;===========================================
  1. DUR(LIST,FIEVAL,DUR) ;
  1.  N C1,CRSUB,EDT,IND,JND,KND,SDT,SUB
  1.  S C1=$E(LIST(1),1)
  1.  I (C1="C")!(C1="R") D
  1.  . S SUB=$E(LIST(1),2,15)
  1.  . S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  . I +$G(FIEVAL(CRSUB,SUB))=0 S (EDT,SDT)=0 Q
  1.  .;Get start and stop for multiple occurrences.
  1.  . S KND=$O(FIEVAL(CRSUB,SUB,"A"),-1)
  1.  . S EDT=$S(KND="":0,1:$G(FIEVAL(CRSUB,SUB,KND,"DATE")))
  1.  . S KND=+$O(FIEVAL(CRSUB,SUB,""))
  1.  . S SDT=$S(KND=0:0,1:$G(FIEVAL(CRSUB,SUB,KND,"DATE")))
  1.  E  D
  1.  . S JND=LIST(1)
  1.  . I FIEVAL(JND)=0 S (EDT,SDT)=0 Q
  1.  .;Check for finding with start and stop date.
  1.  . I $D(FIEVAL(JND,"START DATE")) D
  1.  .. S SDT=+$G(FIEVAL(JND,"START DATE"))
  1.  .. S EDT=+$G(FIEVAL(JND,"STOP DATE"))
  1.  .. I EDT=0 S EDT=+$G(FIEVAL(JND,"DATE"))
  1.  . E  D
  1.  ..;Get start and stop for multiple occurrences.
  1.  .. S KND=$O(FIEVAL(JND,"A"),-1)
  1.  .. S EDT=$S(KND="":0,1:$G(FIEVAL(JND,KND,"DATE")))
  1.  .. S KND=+$O(FIEVAL(JND,""))
  1.  .. S SDT=$S(KND=0:0,1:$G(FIEVAL(JND,KND,"DATE")))
  1.  ;Return the duration in days.
  1.  S DUR=$$FMDIFF^XLFDT(EDT,SDT)
  1.  I DUR<0 S DUR=-DUR
  1.  Q
  1.  ;
  1.  ;============================================
  1. FI(LIST,FIEVAL,LV) ;Given a regular finding return its true/false value.
  1.  N C1,CRSUB,SUB
  1.  S C1=$E(LIST(1),1)
  1.  I (C1="C")!(C1="R") D
  1.  . S SUB=$E(LIST(1),2,15)
  1.  . S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  . S LV=+$G(FIEVAL(CRSUB,SUB))
  1.  E  S LV=FIEVAL(LIST(1))
  1.  Q
  1.  ;
  1.  ;============================================
  1. MAXDATE(LIST,FIEVAL,MAXDATE) ;Given a list of findings return the maximum
  1.  ;date. This will be the newest date.
  1.  N C1,CRSUB,SUB
  1.  S C1=$E(LIST(1),1)
  1.  I (C1="C")!(C1="R") D
  1.  . S SUB=$E(LIST(1),2,15)
  1.  . S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  . S MAXDATE=+$G(FIEVAL(CRSUB,SUB,"DATE"))
  1.  E  S MAXDATE=+$G(FIEVAL(LIST(1),"DATE"))
  1.  I LIST(0)=1 Q
  1.  N DATE,IND
  1.  F IND=2:1:LIST(0) D
  1.  . S C1=$E(LIST(IND),1)
  1.  . I (C1="C")!(C1="R") D
  1.  .. S SUB=$E(LIST(IND),2,15)
  1.  .. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  .. S DATE=+$G(FIEVAL(CRSUB,SUB,"DATE"))
  1.  . E  S DATE=+$G(FIEVAL(LIST(IND),"DATE"))
  1.  . I DATE>MAXDATE S MAXDATE=DATE
  1.  Q
  1.  ;
  1.  ;============================================
  1. MAXVALUE(LIST,FIEVAL,MAXVALUE) ;Given a list of findings and associated
  1.  ;CSUBs return the maximum from all the occurrences.
  1.  N IND,OCC,TEMP
  1.  S MAXVALUE=+$G(FIEVAL(LIST(1),1,LIST(2)))
  1.  F IND=1:2:LIST(0) D
  1.  . I 'FIEVAL(LIST(IND)) Q
  1.  . S OCC=""
  1.  . F  S OCC=+$O(FIEVAL(LIST(IND),OCC)) Q:OCC=0  D
  1.  .. S TEMP=+$G(FIEVAL(LIST(IND),OCC,LIST(IND+1)))
  1.  .. I TEMP>MAXVALUE S MAXVALUE=TEMP
  1.  Q
  1.  ;
  1.  ;============================================
  1. MINDATE(LIST,FIEVAL,MINDATE) ;Given a list of findings return the minimum
  1.  ;date.
  1.  N C1,CRSUB,SUB
  1.  S C1=$E(LIST(1),1)
  1.  I (C1="C")!(C1="R") D
  1.  . S SUB=$E(LIST(1),2,15)
  1.  . S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  . S MINDATE=+$G(FIEVAL(CRSUB,SUB,"DATE"))
  1.  E  S MINDATE=+$G(FIEVAL(LIST(1),"DATE"))
  1.  I LIST(0)=1 Q
  1.  N DATE,IND
  1.  F IND=2:1:LIST(0) D
  1.  . S C1=$E(LIST(IND),1)
  1.  . I (C1="C")!(C1="R") D
  1.  .. S SUB=$E(LIST(IND),2,15)
  1.  .. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  .. S DATE=+$G(FIEVAL(CRSUB,SUB,"DATE"))
  1.  . E  S DATE=+$G(FIEVAL(LIST(IND),"DATE"))
  1.  . I DATE<MINDATE S MINDATE=DATE
  1.  Q
  1.  ;
  1.  ;============================================
  1. MINVALUE(LIST,FIEVAL,MINVALUE) ;Given a list of findings return the minimum
  1.  ;from all the occurrences.
  1.  N IND,OCC,TEMP
  1.  S MINVALUE=+$G(FIEVAL(LIST(1),1,LIST(2)))
  1.  F IND=1:2:LIST(0) D
  1.  . I 'FIEVAL(LIST(IND)) Q
  1.  . S OCC=""
  1.  . F  S OCC=+$O(FIEVAL(LIST(IND),OCC)) Q:OCC=0  D
  1.  .. S TEMP=+$G(FIEVAL(LIST(IND),OCC,LIST(IND+1)))
  1.  .. I TEMP<MINVALUE S MINVALUE=TEMP
  1.  Q
  1.  ;
  1.  ;============================================
  1. MRD(LIST,FIEVAL,MRD) ;Given a list of findings return the most recent
  1.  ;finding date from the list.
  1.  N C1,CRSUB,SUB
  1.  S C1=$E(LIST(1),1)
  1.  I (C1="C")!(C1="R") D
  1.  . S SUB=$E(LIST(1),2,15)
  1.  . S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  . S MRD=+$G(FIEVAL(CRSUB,SUB,"DATE"))
  1.  E  S MRD=+$G(FIEVAL(LIST(1),"DATE"))
  1.  I LIST(0)=1 Q
  1.  N DATE,IND
  1.  F IND=2:1:LIST(0) D
  1.  . S C1=$E(LIST(IND),1)
  1.  . I (C1="C")!(C1="R") D
  1.  .. S SUB=$E(LIST(IND),2,15)
  1.  .. S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  .. S DATE=+$G(FIEVAL(CRSUB,SUB,"DATE"))
  1.  . E  S DATE=+$G(FIEVAL(LIST(IND),"DATE"))
  1.  . I DATE>MRD S MRD=DATE
  1.  Q
  1.  ;
  1.  ;============================================
  1. NUMERIC(LIST,FIEVAL,NUMBER) ;Given a finding, return the first numeric
  1.  ;portion of one of the "CSUB" values. Based on original work
  1.  ;by R. Silverman.
  1.  I LIST(0)=2 S NUMBER=$G(FIEVAL(LIST(1),LIST(2)))
  1.  I LIST(0)=3 S NUMBER=$G(FIEVAL(LIST(1),LIST(2),LIST(3)))
  1.  S NUMBER=$$FIRSTNUM(NUMBER)
  1.  Q
  1.  ;
  1. FIRSTNUM(STRING) ;return the first numeric portion of a string.
  1.  N CHAR,DONE,IND,NUMBER,NUMERIC
  1.  S NUMERIC="+-.1234567890"
  1.  S STRING=$TR(STRING," ")
  1.  S DONE=0,IND=0,NUMBER=""
  1.  F  Q:DONE  D
  1.  . S IND=IND+1,CHAR=$E(STRING,IND)
  1.  . I CHAR="" S DONE=1 Q
  1.  . I NUMERIC[CHAR S NUMBER=NUMBER_CHAR
  1.  . I NUMBER'="",NUMERIC'[CHAR S DONE=1
  1.  Q +NUMBER
  1.  ;
  1.  ;============================================
  1. VALUE(LIST,FIEVAL,VALUE) ;Given a finding return one of its "CSUB"
  1.  ;values.
  1.  N C1
  1.  S C1=$E(LIST(1),1)
  1.  I (C1="C")!(C1="R") D  Q
  1.  . N CRSUB,SUB
  1.  . S SUB=$E(LIST(1),2,15)
  1.  . S CRSUB=$S(C1="C":"CONTRA",C1="R":"REFUSED",1:"")
  1.  . ;I LIST(0)=2 S VALUE=$G(FIEVAL(CRSUB,SUB,LIST(2))) Q
  1.  . I LIST(0)=3 S VALUE=$G(FIEVAL(CRSUB,SUB,LIST(2),LIST(3)))
  1.  . I LIST(0)=2 S VALUE=$G(FIEVAL(CRSUB,SUB,LIST(2)))
  1.  ;
  1.  ;I LIST(0)=2 S VALUE=$G(FIEVAL(LIST(1),LIST(2))) Q
  1.  I LIST(0)=3 S VALUE=$G(FIEVAL(LIST(1),LIST(2),LIST(3)))
  1.  I LIST(0)=2 S VALUE=$G(FIEVAL(LIST(1),LIST(2)))
  1.  Q
  1.  ;