RAIPR135 ;HISC/GJC pre-install routine ;26 Jan 2018 12:14 PM
;;5.0;Radiology/Nuclear Medicine;**135**;Mar 16, 1998;Build 7
;
;Routine IA Type
;-------------------------------------
; UPDATE^DIE 2053 (S)
;
N RACHX1,RACHX2
S RACHX1=$$NEWCP^XPDUTL("PRE1","EN1^RAIPR135")
Q
;
EN1 ;Add "OBSOLETE ORDER-P135 (automated)" to the 'RAD/NUC MED REASON'
; #75.2 file.
;
N RAERR,RAFDA,RAIEN,RAR,RATXT,RAX
S RAX="OBSOLETE ORDER-P135 (automated)"
S RAR=$NA(RAFDA(75.2,"?+1,")) ;RAFDA root
;.01 - NAME
S @RAR@(.01)=RAX
;field #: 5 - NATIONAL
S @RAR@(5)="Y"
;field #: 4 - NATURE OF ORDER ACTIVITY
S @RAR@(4)="i"
;field #: 2 - TYPE OF REASON
S @RAR@(2)=""
D UPDATE^DIE("E","RAFDA","RAIEN","RAERR")
I $D(RAERR) D
.S RATXT(1)="Error: """_RAX_""" could not be added."
.S RATXT(2)="Contact the developers of RA*5.0*135 to address this issue."
.D BMES^XPDUTL(.RATXT)
.Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPR135 956 printed Dec 13, 2024@02:35:48 Page 2
RAIPR135 ;HISC/GJC pre-install routine ;26 Jan 2018 12:14 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**135**;Mar 16, 1998;Build 7
+2 ;
+3 ;Routine IA Type
+4 ;-------------------------------------
+5 ; UPDATE^DIE 2053 (S)
+6 ;
+7 NEW RACHX1,RACHX2
+8 SET RACHX1=$$NEWCP^XPDUTL("PRE1","EN1^RAIPR135")
+9 QUIT
+10 ;
EN1 ;Add "OBSOLETE ORDER-P135 (automated)" to the 'RAD/NUC MED REASON'
+1 ; #75.2 file.
+2 ;
+3 NEW RAERR,RAFDA,RAIEN,RAR,RATXT,RAX
+4 SET RAX="OBSOLETE ORDER-P135 (automated)"
+5 ;RAFDA root
SET RAR=$NAME(RAFDA(75.2,"?+1,"))
+6 ;.01 - NAME
+7 SET @RAR@(.01)=RAX
+8 ;field #: 5 - NATIONAL
+9 SET @RAR@(5)="Y"
+10 ;field #: 4 - NATURE OF ORDER ACTIVITY
+11 SET @RAR@(4)="i"
+12 ;field #: 2 - TYPE OF REASON
+13 SET @RAR@(2)=""
+14 DO UPDATE^DIE("E","RAFDA","RAIEN","RAERR")
+15 IF $DATA(RAERR)
Begin DoDot:1
+16 SET RATXT(1)="Error: """_RAX_""" could not be added."
+17 SET RATXT(2)="Contact the developers of RA*5.0*135 to address this issue."
+18 DO BMES^XPDUTL(.RATXT)
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
