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 ---[H[J[2J[HRA98PST 821 printed Oct 16, 2024@18:34:16 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
