SD53P205.m

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 ---SD53P205   1058     printed  Apr 09, 2024@21:44:46                                                                                                                                                                                                    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      ;