| 1 | MCARUTL4 ;HOIFO/WAA-Utility Routine #3;03/06/01 15:00
|
|---|
| 2 | ;;2.3;Medicine;**32**;09/13/1996
|
|---|
| 3 | ;;
|
|---|
| 4 | RPTAGE(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
|
|---|
| 28 | QT Q RPTAGE
|
|---|
