RAIPS162 ;HISC/GJC-postinit 162 ;19 Sep 2019 1:11 PM
;;5.0;Radiology/Nuclear Medicine;**162**;Mar 16, 1998;Build 2
;
N RACHX1 S RACHX1=$$NEWCP^XPDUTL("POST3","AGE^RAIPS162")
Q
;
AGE ;Update the 'AGE OF PATIENT' record from the LABEL PRINT FIELDS
;[#78.7] file. The current calculation is wrong.
;from: S X1=DT,X2=$P(RAY0,"^",3) D ^%DTC S RAGE=X\365
; to: S X1=DT,X2=$P(RAY0,"^",3) D ^%DTC S RAGE=X\365.25
;find the 'AGE OF PATIENT' IEN
N RAIEN,RARSLT,RAX,RAY K RARY162
S RAX="AGE OF PATIENT"
D FIND^DIC(78.7,"","@;.01I","X",RAX,"","","","","RARY162")
;the record's IEN is returned under the 2 subtree: RARY160("DILIST","2",seq#) = IEN
S RARSLT=$P($G(RARY162("DILIST","0")),"^",1)
I RARSLT'=1 D K RARY162 QUIT
.N RATXT S RATXT(1)="'"_RAX_"' record: "_$S(RASLT>1:"in duplicate.",1:"not found.")
.S RATXT(2)="The 'AGE OF PATIENT' record from the LABEL PRINT FIELDS file was not updated."
.D BMES^XPDUTL(.RATXT)
.Q
;
S RAIEN=$G(RARY162("DILIST","2",RARSLT)),RAY=$G(^RA(78.7,RAIEN,"E"))
E I RAIEN>0,(RAY'["365.25") D ;found the record and it's not been updated.
.S ^RA(78.7,RAIEN,"E")="S X1=DT,X2=$P(RAY0,""^"",3) D ^%DTC S RAGE=X\365.25"
.K RARY162
.Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS162 1212 printed Dec 13, 2024@02:36:05 Page 2
RAIPS162 ;HISC/GJC-postinit 162 ;19 Sep 2019 1:11 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**162**;Mar 16, 1998;Build 2
+2 ;
+3 NEW RACHX1
SET RACHX1=$$NEWCP^XPDUTL("POST3","AGE^RAIPS162")
+4 QUIT
+5 ;
AGE ;Update the 'AGE OF PATIENT' record from the LABEL PRINT FIELDS
+1 ;[#78.7] file. The current calculation is wrong.
+2 ;from: S X1=DT,X2=$P(RAY0,"^",3) D ^%DTC S RAGE=X\365
+3 ; to: S X1=DT,X2=$P(RAY0,"^",3) D ^%DTC S RAGE=X\365.25
+4 ;find the 'AGE OF PATIENT' IEN
+5 NEW RAIEN,RARSLT,RAX,RAY
KILL RARY162
+6 SET RAX="AGE OF PATIENT"
+7 DO FIND^DIC(78.7,"","@;.01I","X",RAX,"","","","","RARY162")
+8 ;the record's IEN is returned under the 2 subtree: RARY160("DILIST","2",seq#) = IEN
+9 SET RARSLT=$PIECE($GET(RARY162("DILIST","0")),"^",1)
+10 IF RARSLT'=1
Begin DoDot:1
+11 NEW RATXT
SET RATXT(1)="'"_RAX_"' record: "_$SELECT(RASLT>1:"in duplicate.",1:"not found.")
+12 SET RATXT(2)="The 'AGE OF PATIENT' record from the LABEL PRINT FIELDS file was not updated."
+13 DO BMES^XPDUTL(.RATXT)
+14 QUIT
End DoDot:1
KILL RARY162
QUIT
+15 ;
+16 SET RAIEN=$GET(RARY162("DILIST","2",RARSLT))
SET RAY=$GET(^RA(78.7,RAIEN,"E"))
+17 ;found the record and it's not been updated.
IF '$TEST
IF RAIEN>0
IF (RAY'["365.25")
Begin DoDot:1
+18 SET ^RA(78.7,RAIEN,"E")="S X1=DT,X2=$P(RAY0,""^"",3) D ^%DTC S RAGE=X\365.25"
+19 KILL RARY162
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
