- 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 Jan 18, 2025@03:15:49 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