RAIPS203.m

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 ---RAIPS203   1236     printed  Apr 09, 2024@21:39:54                                                                                                                                                                                                    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      ;