RAIPS203 ;HISC/GJC - post install routine ; May 19, 2023@11:16:25
;;5.0;Radiology/Nuclear Medicine;**203**;Mar 16, 1998;Build 1
;
; Tag^Routine File IA Type
;-----------------------------------------------
; $$FIND1^DIC() 2051 (S)
; MES^XPDUTL() 10141 (S)
; FILE^DIE() 2053 (S)
;
EN ;rename nat'l hold reason
;From: MYHEALTHYVET CONTACT
; To: MYHEALTHEVET CONTACT
N RAIEN,RANEW,RAOLD S RAOLD="MYHEALTHYVET CONTACT"
S RANEW="MYHEALTHEVET CONTACT"
S RAIEN=$$FIND1^DIC(75.2,,"B",RAOLD)
I RAIEN=0 D Q
.N RATXT S RATXT(1)="The record '"_RAOLD_"' was not found."
.S RATXT(2)="Contact the national radiology development team."
.D MES^XPDUTL(.RATXT)
.Q
N RAFDA,RAIENS S RAIENS=RAIEN_","
S RAFDA(75.2,RAIENS,.01)=RANEW
D FILE^DIE("E","RAFDA")
;
I ($$FIND1^DIC(75.2,,"B",RANEW))'=RAIEN D ;failed...
.N RATXT S RATXT(1)="The record '"_RAOLD_"' was not updated to '"_RANEW_"'."
.S RATXT(2)="Contact the national radiology development team."
.D MES^XPDUTL(.RATXT)
.Q
E D ;success...
.N RATXT S RATXT="The record '"_RAOLD_"' was updated to '"_RANEW_"'."
.D MES^XPDUTL(RATXT)
.Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS203 1236 printed Dec 13, 2024@02:36:21 Page 2
RAIPS203 ;HISC/GJC - post install routine ; May 19, 2023@11:16:25
+1 ;;5.0;Radiology/Nuclear Medicine;**203**;Mar 16, 1998;Build 1
+2 ;
+3 ; Tag^Routine File IA Type
+4 ;-----------------------------------------------
+5 ; $$FIND1^DIC() 2051 (S)
+6 ; MES^XPDUTL() 10141 (S)
+7 ; FILE^DIE() 2053 (S)
+8 ;
EN ;rename nat'l hold reason
+1 ;From: MYHEALTHYVET CONTACT
+2 ; To: MYHEALTHEVET CONTACT
+3 NEW RAIEN,RANEW,RAOLD
SET RAOLD="MYHEALTHYVET CONTACT"
+4 SET RANEW="MYHEALTHEVET CONTACT"
+5 SET RAIEN=$$FIND1^DIC(75.2,,"B",RAOLD)
+6 IF RAIEN=0
Begin DoDot:1
+7 NEW RATXT
SET RATXT(1)="The record '"_RAOLD_"' was not found."
+8 SET RATXT(2)="Contact the national radiology development team."
+9 DO MES^XPDUTL(.RATXT)
+10 QUIT
End DoDot:1
QUIT
+11 NEW RAFDA,RAIENS
SET RAIENS=RAIEN_","
+12 SET RAFDA(75.2,RAIENS,.01)=RANEW
+13 DO FILE^DIE("E","RAFDA")
+14 ;
+15 ;failed...
IF ($$FIND1^DIC(75.2,,"B",RANEW))'=RAIEN
Begin DoDot:1
+16 NEW RATXT
SET RATXT(1)="The record '"_RAOLD_"' was not updated to '"_RANEW_"'."
+17 SET RATXT(2)="Contact the national radiology development team."
+18 DO MES^XPDUTL(.RATXT)
+19 QUIT
End DoDot:1
+20 ;success...
IF '$TEST
Begin DoDot:1
+21 NEW RATXT
SET RATXT="The record '"_RAOLD_"' was updated to '"_RANEW_"'."
+22 DO MES^XPDUTL(RATXT)
+23 QUIT
End DoDot:1
+24 QUIT
+25 ;
