MCARUTL4.m

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 ---MCARUTL4   1180     printed  Apr 09, 2024@21:17:44                                                                                                                                                                                                    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