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

MCARUTL4.m

Go to the documentation of this file.
  1. MCARUTL4 ;HOIFO/WAA-Utility Routine #3;03/06/01 15:00
  1. ;;2.3;Medicine;**32**;09/13/1996
  1. ;;
  1. RPTAGE(FN,IEN) ; This function will return the age of the patient
  1. ; at the time of the report and pass it back.
  1. N RPTAGE,ERROR
  1. S RPTAGE="",ERROR=0
  1. S FN=$G(FN) I FN="" S ERROR=1 ; Ensure that the FN is defined
  1. S IEN=$G(IEN) I IEN="" S ERROR=1 ; Ensure that the IEN is defined
  1. I FN=690 S ERROR=1 ; Keep from looking up on Medical patient file
  1. I FN<690!(FN>701) S ERROR=1 ; Make sure that the lookup is within range
  1. I FN=697.2 S ERROR=1 ; Keep from looking up on procedure file
  1. I ERROR G QT ; there was an error so quit
  1. E S LN=$G(^MCAR(FN,IEN,0)) ; Ensure that there is an entry in the file
  1. I LN'="" D
  1. .N DFN,BDATE,RDATE
  1. .S DFN=$P(LN,U,2) ; Ensure that the entry has a Patient
  1. .Q:DFN<1
  1. .S DFN=$G(^MCAR(690,DFN,0)) ; Ensure that patient is Medicine Patient
  1. .Q:DFN<1
  1. .S BDATE=$$GET1^DIQ(2,DFN,.03,"I") ; Get the Bdate from DPT
  1. .Q:BDATE<1
  1. .S RDATE=$P(LN,U) Q:RDATE<1
  1. .S RDATE=$P(RDATE,".") ; Strip off time
  1. .S RPTAGE=($E(RDATE,1,3)-$E(BDATE,1,3))-($E(RDATE,4,7)<$E(BDATE,4,7))
  1. .; ^^^ Calculate age at the time of the report
  1. .Q
  1. QT Q RPTAGE