BRAUTL.m

BRAUTL ;IHS/BJI/DAY - IHS Radiology Utility Routine ; 20 Apr 2011  4:18 PM

 ;;5.0;Radiology/Nuclear Medicine;**1003**;Nov 01, 2010;Build 3

 ;

RAZAGE ;EP - Called from IHS AGE OF PATIENT in LABEL PRINT FIELDS FILE

 ;

 N DFN,BRADAYS,BRADOB,BRAAGE

 ;

 I '$G(RADFN) S RAZAGE="" Q

 ;

 S DFN=RADFN

 ;

 D DEM^VADPT

 ;

 S X1=DT

 S X2=$P(VADM(3),U)

 D ^%DTC

 S BRADAYS=X

 ;

 D GETDOB

 ;

 D GETAGE

 ;

 S RAZAGE=BRADOB_" "_BRAAGE

 ;

 Q

 ;

 ;

RAZEXAGE ;EP - Called from IHS AGE OF PATIENT AT EXAM

 ;Entry in LABEL PRINT FIELDS file

 ;

 N DFN,BRADAYS,BRADOB,BRAAGE

 ;

 I '$D(RADFN) S RAZEXAGE="" Q

 ;

 S DFN=RADFN

 ;

 D DEM^VADPT

 ;

 ;Exam Date

 S X1=$P($P(RAY2,U),".")

 S X2=$P(VADM(3),U)

 D ^%DTC

 S BRADAYS=X

 ;

 D GETDOB

 ;

 D GETAGE

 ;

 S RAZEXAGE=BRADOB_" "_BRAAGE

 ;

 Q

 ;

 ;

GETDOB ;EP - Get DOB and format it

 ;

 S X=$P(VADM(3),U)

 ;

 S BRADOB=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))

 ;

 Q

 ;

 ;

GETAGE ;EP - Get AGE and format it

 ;

 S X=BRADAYS

 ;

 I X<60 S BRAAGE=X_" Days" Q

 ;

 I X<913 S BRAAGE=$J(X/30.44,0,0)_" Mos" Q

 ;

 S BRAAGE=$J(X/365.25,0,0)_" Yrs"

 ;

 Q

 ;

BRAUTL    ;IHS/BJI/DAY - IHS Radiology Utility Routine ; 20 Apr 2011  4:18 PM

 +1       ;;5.0;Radiology/Nuclear Medicine;**1003**;Nov 01, 2010;Build 3

 +2       ;

RAZAGE    ;EP - Called from IHS AGE OF PATIENT in LABEL PRINT FIELDS FILE

 +1       ;

 +2        NEW DFN,BRADAYS,BRADOB,BRAAGE

 +3       ;

 +4        IF '$GET(RADFN)

               SET RAZAGE=""

               QUIT 

 +5       ;

 +6        SET DFN=RADFN

 +7       ;

 +8        DO DEM^VADPT

 +9       ;

 +10       SET X1=DT

 +11       SET X2=$PIECE(VADM(3),U)

 +12       DO ^%DTC

 +13       SET BRADAYS=X

 +14      ;

 +15       DO GETDOB

 +16      ;

 +17       DO GETAGE

 +18      ;

 +19       SET RAZAGE=BRADOB_" "_BRAAGE

 +20      ;

 +21       QUIT 

 +22      ;

 +23      ;

RAZEXAGE  ;EP - Called from IHS AGE OF PATIENT AT EXAM

 +1       ;Entry in LABEL PRINT FIELDS file

 +2       ;

 +3        NEW DFN,BRADAYS,BRADOB,BRAAGE

 +4       ;

 +5        IF '$DATA(RADFN)

               SET RAZEXAGE=""

               QUIT 

 +6       ;

 +7        SET DFN=RADFN

 +8       ;

 +9        DO DEM^VADPT

 +10      ;

 +11      ;Exam Date

 +12       SET X1=$PIECE($PIECE(RAY2,U),".")

 +13       SET X2=$PIECE(VADM(3),U)

 +14       DO ^%DTC

 +15       SET BRADAYS=X

 +16      ;

 +17       DO GETDOB

 +18      ;

 +19       DO GETAGE

 +20      ;

 +21       SET RAZEXAGE=BRADOB_" "_BRAAGE

 +22      ;

 +23       QUIT 

 +24      ;

 +25      ;

GETDOB    ;EP - Get DOB and format it

 +1       ;

 +2        SET X=$PIECE(VADM(3),U)

 +3       ;

 +4        SET BRADOB=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_(1700+$EXTRACT(X,1,3))

 +5       ;

 +6        QUIT 

 +7       ;

 +8       ;

GETAGE    ;EP - Get AGE and format it

 +1       ;

 +2        SET X=BRADAYS

 +3       ;

 +4        IF X<60

               SET BRAAGE=X_" Days"

               QUIT 

 +5       ;

 +6        IF X<913

               SET BRAAGE=$JUSTIFY(X/30.44,0,0)_" Mos"

               QUIT 

 +7       ;

 +8        SET BRAAGE=$JUSTIFY(X/365.25,0,0)_" Yrs"

 +9       ;

 +10       QUIT 

 +11      ;