Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAIPS162

RAIPS162.m

Go to the documentation of this file.
  1. RAIPS162 ;HISC/GJC-postinit 162 ;19 Sep 2019 1:11 PM
  1. ;;5.0;Radiology/Nuclear Medicine;**162**;Mar 16, 1998;Build 2
  1. ;
  1. N RACHX1 S RACHX1=$$NEWCP^XPDUTL("POST3","AGE^RAIPS162")
  1. Q
  1. ;
  1. AGE ;Update the 'AGE OF PATIENT' record from the LABEL PRINT FIELDS
  1. ;[#78.7] file. The current calculation is wrong.
  1. ;from: S X1=DT,X2=$P(RAY0,"^",3) D ^%DTC S RAGE=X\365
  1. ; to: S X1=DT,X2=$P(RAY0,"^",3) D ^%DTC S RAGE=X\365.25
  1. ;find the 'AGE OF PATIENT' IEN
  1. N RAIEN,RARSLT,RAX,RAY K RARY162
  1. S RAX="AGE OF PATIENT"
  1. D FIND^DIC(78.7,"","@;.01I","X",RAX,"","","","","RARY162")
  1. ;the record's IEN is returned under the 2 subtree: RARY160("DILIST","2",seq#) = IEN
  1. S RARSLT=$P($G(RARY162("DILIST","0")),"^",1)
  1. I RARSLT'=1 D K RARY162 QUIT
  1. .N RATXT S RATXT(1)="'"_RAX_"' record: "_$S(RASLT>1:"in duplicate.",1:"not found.")
  1. .S RATXT(2)="The 'AGE OF PATIENT' record from the LABEL PRINT FIELDS file was not updated."
  1. .D BMES^XPDUTL(.RATXT)
  1. .Q
  1. ;
  1. S RAIEN=$G(RARY162("DILIST","2",RARSLT)),RAY=$G(^RA(78.7,RAIEN,"E"))
  1. E I RAIEN>0,(RAY'["365.25") D ;found the record and it's not been updated.
  1. .S ^RA(78.7,RAIEN,"E")="S X1=DT,X2=$P(RAY0,""^"",3) D ^%DTC S RAGE=X\365.25"
  1. .K RARY162
  1. .Q
  1. Q
  1. ;