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

PXRMAGE.m

Go to the documentation of this file.
  1. PXRMAGE ; SLC/PKR - Utilities for age calculations. ;10/07/2005
  1. ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
  1. ;===========================================
  1. AGE(DOB,DOD,DATE) ;Given a date of birth, date of death, and a date
  1. ;return the age on that date. If the date of death is not null the
  1. ;return the age on the date of death. All dates should be in VA
  1. ;Fileman format.
  1. N CDATE
  1. S CDATE=$S(DOD="":DATE,DOD'="":DOD)
  1. Q (CDATE-DOB)\10000
  1. ;
  1. ;===========================================
  1. AGECHECK(AGE,MINAGE,MAXAGE) ;Given an AGE, MINimumAGE, and MAXimumAGE
  1. ;return true if age lies within the range.
  1. ;Special values of NULL or 0 mean there are no limits.
  1. ;
  1. S MAXAGE=+MAXAGE
  1. S MINAGE=+MINAGE
  1. ;See if too old.
  1. I (AGE>MAXAGE)&(MAXAGE>0) Q 0
  1. ;
  1. ;See if too young.
  1. I MINAGE=0 Q 1
  1. I AGE<MINAGE Q 0
  1. Q 1
  1. ;
  1. ;===========================================
  1. FMTAGE(MINAGE,MAXAGE) ;Format the minimum age and maximum age for display.
  1. N STR
  1. I $L(MINAGE)!$L(MAXAGE) D
  1. . I $L(MINAGE)&$L(MAXAGE) S STR=" for ages "_MINAGE_" to "_MAXAGE Q
  1. . I $L(MINAGE) S STR=" for ages "_MINAGE_" and older" Q
  1. . I $L(MAXAGE) S STR=" for ages "_MAXAGE_" and younger" Q
  1. E S STR=" for all ages"
  1. Q STR
  1. ;
  1. ;===========================================
  1. FMTFREQ(FREQ) ;Format the frequency for display.
  1. N FREQT,STR
  1. S STR="Frequency: "
  1. S FREQT=$$FREQ^PXRMPTD2(FREQ)
  1. I FREQ=-1 Q STR_FREQT
  1. Q STR_"Due every "_FREQT
  1. ;
  1. ;===========================================
  1. MMF(DEFARR,PXRMPDEM,MINAGE,MAXAGE,FREQ,FIEVAL) ;Set the baseline minimum age,
  1. ;maximum age, and frequency. If there are multiple intervals they
  1. ;cannot overlap.
  1. N FR,IC,INDEX,MATCH,MAXA,MINA,NAR,TEMP
  1. ;Initialize MINAGE, MAXAGE, and FREQ.
  1. S (MINAGE,MAXAGE,FREQ)=""
  1. S (IC,NAR)=0
  1. F S IC=$O(DEFARR(7,IC)) Q:+IC=0 D
  1. . S NAR=NAR+1
  1. . S TEMP=DEFARR(7,IC,0)
  1. . S FR(NAR)=$$UP^XLFSTR($P(TEMP,U,1))
  1. . S MINA(NAR)=$P(TEMP,U,2)
  1. . S MAXA(NAR)=$P(TEMP,U,3)
  1. . S INDEX(NAR)=IC
  1. . S FIEVAL("AGE",IC)=0
  1. I NAR=0 Q
  1. ;
  1. ;Make sure that none of the age ranges overlap.
  1. I $D(PXRMDEBG),$$OVERLAP(NAR,.MINA,.MAXA) Q
  1. ;
  1. ;Look for an age range match.
  1. S FREQ=-1
  1. S MATCH=0
  1. F IC=1:1:NAR Q:MATCH D
  1. . I $$AGECHECK(PXRMPDEM("AGE"),MINA(IC),MAXA(IC)) D
  1. .. S MATCH=1
  1. .. S MINAGE=MINA(IC)
  1. .. S MAXAGE=MAXA(IC)
  1. .. S FREQ=FR(IC)
  1. .. S FIEVAL("AGE",INDEX(IC))=1
  1. Q
  1. ;
  1. ;===========================================
  1. OVERLAP(NAR,MINA,MAXA) ;Check age ranges for overlap. Return an error message
  1. ;if an overlap is found.
  1. I NAR'>1 Q 0
  1. N IC,IN,JC,MAXI,MAXJ,MINI,MINJ,OVRLAP,TEXT
  1. S OVRLAP=0
  1. F IC=1:1:NAR-1 D
  1. . S MAXI=MAXA(IC)
  1. . I MAXI="" S MAXI=1000
  1. . S MINI=MINA(IC)
  1. . I MINI="" S MINI=0
  1. . F JC=IC+1:1:NAR D
  1. .. S MAXJ=MAXA(JC)
  1. .. I MAXJ="" S MAXJ=1000
  1. .. S MINJ=MINA(JC)
  1. .. I MINJ="" S MINJ=0
  1. .. S IN=0
  1. .. I (MINJ'<MINI)&(MINJ'>MAXI) S IN=1
  1. .. I (MAXJ'<MINI)&(MAXJ'>MAXI) S IN=1
  1. .. I IN D
  1. ... S OVRLAP=OVRLAP+1
  1. ... S TEXT=MINA(IC)_" to "_MAXA(IC)_" and "_MINA(JC)_" to "_MAXA(JC)
  1. ... I $D(PXRMPID) S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","AGE OVERLAP",OVRLAP)=TEXT
  1. ... E S ^TMP($J,"OVERLAP",OVRLAP)=TEXT
  1. I OVRLAP>1 S OVRLAP=1
  1. Q OVRLAP
  1. ;
  1. ;===========================================
  1. OVLAP() ;Check age ranges for overlap. Called from definition editor after
  1. ;input of baseline frequency/age ranges.
  1. N IC,NAR,MAXA,MINA,OVERLAP,TEMP
  1. S (IC,NAR)=0
  1. F S IC=$O(^PXD(811.9,DA,7,IC)) Q:+IC=0 D
  1. . S NAR=NAR+1
  1. . S TEMP=^PXD(811.9,DA,7,IC,0)
  1. . S MINA(NAR)=$P(TEMP,U,2)
  1. . S MAXA(NAR)=$P(TEMP,U,3)
  1. S OVERLAP=$$OVERLAP^PXRMAGE(NAR,.MINA,.MAXA)
  1. I OVERLAP D
  1. . W !,"Error - the following age ranges overlap:"
  1. . S IC=0
  1. . F S IC=$O(^TMP($J,"OVERLAP",IC)) Q:IC="" W !,?2,^TMP($J,"OVERLAP",IC)
  1. . K ^TMP($J,"OVERLAP")
  1. . W !,"Please correct this problem."
  1. Q OVERLAP
  1. ;