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. ;07-Jun-2012 09:58;DU
  1.  ;;2.0;CLINICAL REMINDERS;**4,1001**;Feb 04, 2005;Build 21
  1.  ;IHS/MSC/MGH Make changes for babies and toddlers
  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.  ;IHS/MSC/MGH patch 1001 was not returning correct data for babies
  1.  N CDATE,BAGE,VADM
  1.  S CDATE=$S(DOD="":DATE,DOD'="":DOD)
  1.  S BAGE=(CDATE-DOB)\10000
  1.  I BAGE<2 D
  1.  .D DEM^VADPT
  1.  .S BAGE=VADM(4)
  1.  Q BAGE
  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.  ;IHS/MSC/MGH Put back in age check patch 1001
  1.  ;S MAXAGE=+MAXAGE
  1.  ;S MINAGE=+MINAGE
  1.  N PTAGE
  1.  S AGE=$$DECAGE(AGE)
  1.  S MAXAGE=$$DECODE(MAXAGE)
  1.  S MINAGE=$$DECODE(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. DECAGE(AGEVALUE) ; Put age from VADPT into format for reminders
  1.  ; IHS/MSC/MGH - 2/28/2012 PATCH 1001 Added function to change age into days or months
  1.  N NUM,CODE,MULT
  1.  S NUM=$P(AGEVALUE," ",1),CODE=$P(AGEVALUE," ",2)
  1.  S MULT=1.0
  1.  I CODE="MOS" S MULT=30.42
  1.  I CODE=""!(CODE="YRS") S MULT=365.25
  1.  Q +(MULT*NUM)
  1.  ;====================================================================
  1. DECODE(AGEVALUE) ;Determine the age in years or months
  1.  ; IHS/MSC/MGH - 2/28/2012 PATCH 1001 Added function to change reminder
  1.  N CODE,LEN,MULT,NUM
  1.  S LEN=$L(AGEVALUE)
  1.  S NUM=$E(AGEVALUE,1,LEN-1)
  1.  S CODE=$E(AGEVALUE,LEN,LEN)
  1.  S MULT=1.0
  1.  I CODE="M" S MULT=30.42
  1.  I CODE="Y"!(CODE="") S MULT=365.25
  1.  Q +(MULT*NUM)
  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.  ;IHS/MSC/MGH Decode added for IHS ages
  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=$$DECODE(MAXA(IC))
  1.  . I MAXI="" S MAXI=1000
  1.  . S MINI=$$DECODE(MINA(IC))
  1.  . I MINI="" S MINI=0
  1.  . F JC=IC+1:1:NAR D
  1.  .. S MAXJ=$$DECODE(MAXA(JC))
  1.  .. I MAXJ="" S MAXJ=1000
  1.  .. S MINJ=$$DECODE(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.  ;