MCARUTL4 ;HOIFO/WAA-Utility Routine #3;03/06/01 15:00
;;2.3;Medicine;**32**;09/13/1996
;;
RPTAGE(FN,IEN) ; This function will return the age of the patient
; at the time of the report and pass it back.
N RPTAGE,ERROR
S RPTAGE="",ERROR=0
S FN=$G(FN) I FN="" S ERROR=1 ; Ensure that the FN is defined
S IEN=$G(IEN) I IEN="" S ERROR=1 ; Ensure that the IEN is defined
I FN=690 S ERROR=1 ; Keep from looking up on Medical patient file
I FN<690!(FN>701) S ERROR=1 ; Make sure that the lookup is within range
I FN=697.2 S ERROR=1 ; Keep from looking up on procedure file
I ERROR G QT ; there was an error so quit
E S LN=$G(^MCAR(FN,IEN,0)) ; Ensure that there is an entry in the file
I LN'="" D
.N DFN,BDATE,RDATE
.S DFN=$P(LN,U,2) ; Ensure that the entry has a Patient
.Q:DFN<1
.S DFN=$G(^MCAR(690,DFN,0)) ; Ensure that patient is Medicine Patient
.Q:DFN<1
.S BDATE=$$GET1^DIQ(2,DFN,.03,"I") ; Get the Bdate from DPT
.Q:BDATE<1
.S RDATE=$P(LN,U) Q:RDATE<1
.S RDATE=$P(RDATE,".") ; Strip off time
.S RPTAGE=($E(RDATE,1,3)-$E(BDATE,1,3))-($E(RDATE,4,7)<$E(BDATE,4,7))
.; ^^^ Calculate age at the time of the report
.Q
QT Q RPTAGE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARUTL4 1180 printed Sep 23, 2025@19:50:55 Page 2
MCARUTL4 ;HOIFO/WAA-Utility Routine #3;03/06/01 15:00
+1 ;;2.3;Medicine;**32**;09/13/1996
+2 ;;
RPTAGE(FN,IEN) ; This function will return the age of the patient
+1 ; at the time of the report and pass it back.
+2 NEW RPTAGE,ERROR
+3 SET RPTAGE=""
SET ERROR=0
+4 ; Ensure that the FN is defined
SET FN=$GET(FN)
IF FN=""
SET ERROR=1
+5 ; Ensure that the IEN is defined
SET IEN=$GET(IEN)
IF IEN=""
SET ERROR=1
+6 ; Keep from looking up on Medical patient file
IF FN=690
SET ERROR=1
+7 ; Make sure that the lookup is within range
IF FN<690!(FN>701)
SET ERROR=1
+8 ; Keep from looking up on procedure file
IF FN=697.2
SET ERROR=1
+9 ; there was an error so quit
IF ERROR
GOTO QT
+10 ; Ensure that there is an entry in the file
IF '$TEST
SET LN=$GET(^MCAR(FN,IEN,0))
+11 IF LN'=""
Begin DoDot:1
+12 NEW DFN,BDATE,RDATE
+13 ; Ensure that the entry has a Patient
SET DFN=$PIECE(LN,U,2)
+14 if DFN<1
QUIT
+15 ; Ensure that patient is Medicine Patient
SET DFN=$GET(^MCAR(690,DFN,0))
+16 if DFN<1
QUIT
+17 ; Get the Bdate from DPT
SET BDATE=$$GET1^DIQ(2,DFN,.03,"I")
+18 if BDATE<1
QUIT
+19 SET RDATE=$PIECE(LN,U)
if RDATE<1
QUIT
+20 ; Strip off time
SET RDATE=$PIECE(RDATE,".")
+21 SET RPTAGE=($EXTRACT(RDATE,1,3)-$EXTRACT(BDATE,1,3))-($EXTRACT(RDATE,4,7)<$EXTRACT(BDATE,4,7))
+22 ; ^^^ Calculate age at the time of the report
+23 QUIT
End DoDot:1
QT QUIT RPTAGE
