DG53546P.m

DG53546P ; BAY/KAM- Patch DG*5.3*546 Install Utility Routine ; 9/29/03 4:46pm

 ;;5.3;Registration;**546**;AUG 13, 1993

 ;

ENV ;Main entry point for Environment check point.

 ;

 S XPDABORT=""

 D PROGCHK(.XPDABORT) ;checks programmer variables

 I XPDABORT="" K XPDABORT

 Q

PRE ;Main entry point for Pre-install items.

 Q

 ;

 ;

POST ;Main entry point for Post-install items.

 ;

 D POST1

 Q

POST1 ; Update DIC(8  Eligibility Code for TRICARE/CHAMPUS

 ; NOIS CALLS CHY-0703-52232, PHI-0600-21416, MAC-1101-61117,

 ;            MAC-0201-61637, EKH-0600-41137

 N ELGIEN,NATIEN,DA,DR,DIE

 S ELGIEN=0

 F  S ELGIEN=$O(^DIC(8,ELGIEN)) Q:ELGIEN=""!(ELGIEN'?1.N)  D

 . S NATIEN=$P(^DIC(8,ELGIEN,0),"^",9)

 . I $P(^DIC(8.1,NATIEN,0),"^")="TRICARE/CHAMPUS" D 

 .. S DIE="^DIC(8,",DA=ELGIEN,DR="9///VA STANDARD"

 .. D ^DIE

 Q

PROGCHK(XPDABORT)       ;checks for necessary programmer variables

 ;

 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D

 . 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53546P   1154     printed  Apr 09, 2024@21:55:16                                                                                                                                                                                                    Page 2

DG53546P  ; BAY/KAM- Patch DG*5.3*546 Install Utility Routine ; 9/29/03 4:46pm

 +1       ;;5.3;Registration;**546**;AUG 13, 1993

 +2       ;

ENV       ;Main entry point for Environment check point.

 +1       ;

 +2        SET XPDABORT=""

 +3       ;checks programmer variables

           DO PROGCHK(.XPDABORT)

 +4        IF XPDABORT=""

               KILL XPDABORT

 +5        QUIT 

PRE       ;Main entry point for Pre-install items.

 +1        QUIT 

 +2       ;

 +3       ;

POST      ;Main entry point for Post-install items.

 +1       ;

 +2        DO POST1

 +3        QUIT 

POST1     ; Update DIC(8  Eligibility Code for TRICARE/CHAMPUS

 +1       ; NOIS CALLS CHY-0703-52232, PHI-0600-21416, MAC-1101-61117,

 +2       ;            MAC-0201-61637, EKH-0600-41137

 +3        NEW ELGIEN,NATIEN,DA,DR,DIE

 +4        SET ELGIEN=0

 +5        FOR 

               SET ELGIEN=$ORDER(^DIC(8,ELGIEN))

               if ELGIEN=""!(ELGIEN'?1.N)

                   QUIT 

               Begin DoDot:1

 +6                SET NATIEN=$PIECE(^DIC(8,ELGIEN,0),"^",9)

 +7                IF $PIECE(^DIC(8.1,NATIEN,0),"^")="TRICARE/CHAMPUS"

                       Begin DoDot:2

 +8                        SET DIE="^DIC(8,"

                           SET DA=ELGIEN

                           SET DR="9///VA STANDARD"

 +9                        DO ^DIE

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

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

               End DoDot:1

 +8        QUIT