source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARUTL4.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1MCARUTL4 ;HOIFO/WAA-Utility Routine #3;03/06/01 15:00
2 ;;2.3;Medicine;**32**;09/13/1996
3 ;;
4RPTAGE(FN,IEN) ; This function will return the age of the patient
5 ; at the time of the report and pass it back.
6 N RPTAGE,ERROR
7 S RPTAGE="",ERROR=0
8 S FN=$G(FN) I FN="" S ERROR=1 ; Ensure that the FN is defined
9 S IEN=$G(IEN) I IEN="" S ERROR=1 ; Ensure that the IEN is defined
10 I FN=690 S ERROR=1 ; Keep from looking up on Medical patient file
11 I FN<690!(FN>701) S ERROR=1 ; Make sure that the lookup is within range
12 I FN=697.2 S ERROR=1 ; Keep from looking up on procedure file
13 I ERROR G QT ; there was an error so quit
14 E S LN=$G(^MCAR(FN,IEN,0)) ; Ensure that there is an entry in the file
15 I LN'="" D
16 .N DFN,BDATE,RDATE
17 .S DFN=$P(LN,U,2) ; Ensure that the entry has a Patient
18 .Q:DFN<1
19 .S DFN=$G(^MCAR(690,DFN,0)) ; Ensure that patient is Medicine Patient
20 .Q:DFN<1
21 .S BDATE=$$GET1^DIQ(2,DFN,.03,"I") ; Get the Bdate from DPT
22 .Q:BDATE<1
23 .S RDATE=$P(LN,U) Q:RDATE<1
24 .S RDATE=$P(RDATE,".") ; Strip off time
25 .S RPTAGE=($E(RDATE,1,3)-$E(BDATE,1,3))-($E(RDATE,4,7)<$E(BDATE,4,7))
26 .; ^^^ Calculate age at the time of the report
27 .Q
28QT Q RPTAGE
Note: See TracBrowser for help on using the repository browser.