RA98PST.m

RA98PST ;Hines OI/RTK - Post-install routine, patch 98 ;10/15/08  08:37

VERSION ;;5.0;Radiology/Nuclear Medicine;**98**;Mar 16, 1998;Build 2

 ;

 ;Integration Agreements

 ;----------------------

 ;^DIE(2053); BMES^XPDUTL(10141)

 ;

EN ;Entry point

 ;

 N RAAODT,RAOIEN,RARFSV1,RARFSVX,RARFSV2

 S RAAODT=3080819  ;start date=CPRSv27 release date-1

 D BMES^XPDUTL("Performing clean-up of Reason For Study data...")

 F  S RAAODT=$O(^RAO(75.1,"AO",RAAODT)) Q:RAAODT=""  D

 .F RAOIEN=0:0 S RAOIEN=$O(^RAO(75.1,"AO",RAAODT,RAOIEN)) Q:RAOIEN'>0  D

 ..S RARFSV1=$G(^RAO(75.1,RAOIEN,.1))

 ..I RARFSV1'[$C(10),RARFSV1'[$C(13) Q

 ..S RARFSVX=$TR(RARFSV1,$C(10)," ")

 ..S RARFSV2=$TR(RARFSVX,$C(13)," ")

 ..S RARFSV2=$E(RARFSV2,1,64)

 ..S DIE=75.1,DA=RAOIEN,DR="1.1///^S X=RARFSV2" D ^DIE

 ..K DIE,DA,DR Q

 .Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RA98PST   821     printed  Mar 13, 2025@21:38:25                                                                                                                                                                                                      Page 2

RA98PST   ;Hines OI/RTK - Post-install routine, patch 98 ;10/15/08  08:37

VERSION   ;;5.0;Radiology/Nuclear Medicine;**98**;Mar 16, 1998;Build 2

 +1       ;

 +2       ;Integration Agreements

 +3       ;----------------------

 +4       ;^DIE(2053); BMES^XPDUTL(10141)

 +5       ;

EN        ;Entry point

 +1       ;

 +2        NEW RAAODT,RAOIEN,RARFSV1,RARFSVX,RARFSV2

 +3       ;start date=CPRSv27 release date-1

           SET RAAODT=3080819

 +4        DO BMES^XPDUTL("Performing clean-up of Reason For Study data...")

 +5        FOR 

               SET RAAODT=$ORDER(^RAO(75.1,"AO",RAAODT))

               if RAAODT=""

                   QUIT 

               Begin DoDot:1

 +6                FOR RAOIEN=0:0

                       SET RAOIEN=$ORDER(^RAO(75.1,"AO",RAAODT,RAOIEN))

                       if RAOIEN'>0

                           QUIT 

                       Begin DoDot:2

 +7                        SET RARFSV1=$GET(^RAO(75.1,RAOIEN,.1))

 +8                        IF RARFSV1'[$CHAR(10)

                               IF RARFSV1'[$CHAR(13)

                                   QUIT 

 +9                        SET RARFSVX=$TRANSLATE(RARFSV1,$CHAR(10)," ")

 +10                       SET RARFSV2=$TRANSLATE(RARFSVX,$CHAR(13)," ")

 +11                       SET RARFSV2=$EXTRACT(RARFSV2,1,64)

 +12                       SET DIE=75.1

                           SET DA=RAOIEN

                           SET DR="1.1///^S X=RARFSV2"

                           DO ^DIE

 +13                       KILL DIE,DA,DR

                           QUIT 

                       End DoDot:2

 +14               QUIT 

               End DoDot:1

 +15       QUIT