SD53P205 ;bp/cmf - Patch SD*5.3*205 utility routine ; 10/23/99
;;5.3;Scheduling;**205**;AUG 13, 1993
;
ENV ;environment check point.
;
S XPDABORT=""
D PROGCHK(.XPDABORT) ;checks programmer variables
I XPDABORT="" K XPDABORT
Q
;
PRE ;Pre-init
D DFILE ;Delete entries in file #404.45 and #404.46
Q
;
DFILE ;
;Delete #404.45 entries
I $D(^SCTM(404.45)) D
. N DIK,DA S DIK="^SCTM(404.45,",DA=0
. D BMES^XPDUTL("Deleting file #404.45 entries...")
. F S DA=$O(^SCTM(404.45,DA)) Q:'DA D ^DIK
. Q
;
;Delete #404.46 entries
I $D(^SCTM(404.46)) D
. N DIK,DA S DIK="^SCTM(404.46,",DA=0
. D BMES^XPDUTL("Deleting file #404.46 entries...")
. F S DA=$O(^SCTM(404.46,DA)) Q:'DA D ^DIK
. Q
Q
;
;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
;
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
.D BMES^XPDUTL("*****")
.D MES^XPDUTL("Your programming variables are not set up properly.")
.D MES^XPDUTL("Installation aborted.")
.D MES^XPDUTL("*****")
.S XPDABORT=2
.Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P205 1058 printed Nov 22, 2024@17:56 Page 2
SD53P205 ;bp/cmf - Patch SD*5.3*205 utility routine ; 10/23/99
+1 ;;5.3;Scheduling;**205**;AUG 13, 1993
+2 ;
ENV ;environment check point.
+1 ;
+2 SET XPDABORT=""
+3 ;checks programmer variables
DO PROGCHK(.XPDABORT)
+4 IF XPDABORT=""
KILL XPDABORT
+5 QUIT
+6 ;
PRE ;Pre-init
+1 ;Delete entries in file #404.45 and #404.46
DO DFILE
+2 QUIT
+3 ;
DFILE ;
+1 ;Delete #404.45 entries
+2 IF $DATA(^SCTM(404.45))
Begin DoDot:1
+3 NEW DIK,DA
SET DIK="^SCTM(404.45,"
SET DA=0
+4 DO BMES^XPDUTL("Deleting file #404.45 entries...")
+5 FOR
SET DA=$ORDER(^SCTM(404.45,DA))
if 'DA
QUIT
DO ^DIK
+6 QUIT
End DoDot:1
+7 ;
+8 ;Delete #404.46 entries
+9 IF $DATA(^SCTM(404.46))
Begin DoDot:1
+10 NEW DIK,DA
SET DIK="^SCTM(404.46,"
SET DA=0
+11 DO BMES^XPDUTL("Deleting file #404.46 entries...")
+12 FOR
SET DA=$ORDER(^SCTM(404.46,DA))
if 'DA
QUIT
DO ^DIK
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
+16 ;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
+1 ;
+2 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+3 DO BMES^XPDUTL("*****")
+4 DO MES^XPDUTL("Your programming variables are not set up properly.")
+5 DO MES^XPDUTL("Installation aborted.")
+6 DO MES^XPDUTL("*****")
+7 SET XPDABORT=2
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;