DG53653U.m

DG53653U ;TDM - Patch DG*5.3*653 Install Utility Routine ; 11/28/05 4:58pm

 ;;5.3;Registration;**653,1015**;AUG 13, 1993;Build 21

 Q

 ;

EP ; Add new entries to the INCONSISTENT DATA ELEMENTS file (#38.6)

 N BRNG,ERNG,DGKRTN,KEYREQ

 D ADDINC(301,312,"DG53653V",0) Q:$G(XPDABORT)=2

 D ADDINC(401,413,"DG53653W",0) Q:$G(XPDABORT)=2

 D ADDINC(501,517,"DG53653X",0) Q:$G(XPDABORT)=2

 D ADDINC(701,726,"DG53653Y",0) Q:$G(XPDABORT)=2

 Q

 ;

ADDINC(BRNG,ERNG,DGKRTN,KEYREQ) ; add new entries to the INCONSISTENT DATA ELEMENTS file (#38.6)

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

 ; Input:    BRNG = Beginning Number

 ;           ERNG = Ending Number

 ;         DGKRTN = Routine Name for the Range

 ;         KEYREQ = Key Required

 ;                    0=No Key Required

 ;                    1=Eligibility Verified

 ;                    2=Money Verified

 ;                    3=Service Verified

 ;                    4=Key Always Required

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

 N DGK,DGKSUB,DGWP,ROOT,DGFDA,DGWP,DGERR,DGIEN,DGTITL

 K XPDABORT

 D BMES^XPDUTL("  >> Adding entries "_BRNG_"-"_ERNG_" into the INCONSISTENT DATA ELEMENTS file (#38.6)")

 F DGK=BRNG:1:ERNG Q:$G(XPDABORT)=2  D

 .I $D(^DGIN(38.6,DGK)) D  Q

 ..D BMES^XPDUTL("     Internal Entry # "_DGK_" already exists in file #38.6")

 ..S ROOT="DGFDA(38.6,"""_DGK_","")" S DGKSUB=DGK_U_DGKRTN D @DGKSUB

 ..I $P($G(^DGIN(38.6,DGK,0)),"^")=$G(@ROOT@(.01)) D MES^XPDUTL("Entry "_DGK_" matches incoming entry - OK") Q

 ..D MES^XPDUTL("     >>> ERROR: Entry # "_DGK_" needs to be reviewed by NVS! <<<")

 ..D MES^XPDUTL("           Existing entry: "_$P($G(^DGIN(38.6,DGK,0)),"^"))

 ..D MES^XPDUTL("           Incoming entry: "_$G(@ROOT@(.01)))

 ..D BMES^XPDUTL("                        <<<< INSTALLATION ABORTED >>>>")

 ..S XPDABORT=2

 .K DGFDA,ROOT,DGWP

 .S ROOT="DGFDA(38.6,""?+1,"")"

 .S DGKSUB=DGK_U_DGKRTN D @DGKSUB Q:'$D(DGFDA)

 .S DGIEN(1)=DGK,DGTITL=@ROOT@(.01),@ROOT@(3)=KEYREQ,@ROOT@(4)=0,@ROOT@(5)=0,@ROOT@(6)=1,@ROOT@(50)="DGWP"

 .D UPDATE^DIE("","DGFDA","DGIEN","DGERR")

 .I $D(DGERR) D  Q

 ..D BMES^XPDUTL("   >>> ERROR! "_DGTITL_" not added to file #38.6")

 ..D MES^XPDUTL("     "_DGERR("DIERR",1)_": "_DGERR("DIERR",1,"TEXT",1))

 ..D BMES^XPDUTL("                        <<<< INSTALLATION ABORTED >>>>")

 ..S XPDABORT=2

 .D BMES^XPDUTL("      "_DGTITL_" successfully added.")

 Q

DG53653U  ;TDM - Patch DG*5.3*653 Install Utility Routine ; 11/28/05 4:58pm

 +1       ;;5.3;Registration;**653,1015**;AUG 13, 1993;Build 21

 +2        QUIT 

 +3       ;

EP        ; Add new entries to the INCONSISTENT DATA ELEMENTS file (#38.6)

 +1        NEW BRNG,ERNG,DGKRTN,KEYREQ

 +2        DO ADDINC(301,312,"DG53653V",0)

           IF $GET(XPDABORT)=2

               QUIT 

 +3        DO ADDINC(401,413,"DG53653W",0)

           IF $GET(XPDABORT)=2

               QUIT 

 +4        DO ADDINC(501,517,"DG53653X",0)

           IF $GET(XPDABORT)=2

               QUIT 

 +5        DO ADDINC(701,726,"DG53653Y",0)

           IF $GET(XPDABORT)=2

               QUIT 

 +6        QUIT 

 +7       ;

ADDINC(BRNG,ERNG,DGKRTN,KEYREQ) ; add new entries to the INCONSISTENT DATA ELEMENTS file (#38.6)

 +1       ;-----------------------------------------------------------------

 +2       ; Input:    BRNG = Beginning Number

 +3       ;           ERNG = Ending Number

 +4       ;         DGKRTN = Routine Name for the Range

 +5       ;         KEYREQ = Key Required

 +6       ;                    0=No Key Required

 +7       ;                    1=Eligibility Verified

 +8       ;                    2=Money Verified

 +9       ;                    3=Service Verified

 +10      ;                    4=Key Always Required

 +11      ;-----------------------------------------------------------------

 +12       NEW DGK,DGKSUB,DGWP,ROOT,DGFDA,DGWP,DGERR,DGIEN,DGTITL

 +13       KILL XPDABORT

 +14       DO BMES^XPDUTL("  >> Adding entries "_BRNG_"-"_ERNG_" into the INCONSISTENT DATA ELEMENTS file (#38.6)")

 +15       FOR DGK=BRNG:1:ERNG

               IF $GET(XPDABORT)=2

                   QUIT 

               Begin DoDot:1

 +16               IF $DATA(^DGIN(38.6,DGK))

                       Begin DoDot:2

 +17                       DO BMES^XPDUTL("     Internal Entry # "_DGK_" already exists in file #38.6")

 +18                       SET ROOT="DGFDA(38.6,"""_DGK_","")"

                           SET DGKSUB=DGK_U_DGKRTN

                           DO @DGKSUB

 +19                       IF $PIECE($GET(^DGIN(38.6,DGK,0)),"^")=$GET(@ROOT@(.01))

                               DO MES^XPDUTL("Entry "_DGK_" matches incoming entry - OK")

                               QUIT 

 +20                       DO MES^XPDUTL("     >>> ERROR: Entry # "_DGK_" needs to be reviewed by NVS! <<<")

 +21                       DO MES^XPDUTL("           Existing entry: "_$PIECE($GET(^DGIN(38.6,DGK,0)),"^"))

 +22                       DO MES^XPDUTL("           Incoming entry: "_$GET(@ROOT@(.01)))

 +23                       DO BMES^XPDUTL("                        <<<< INSTALLATION ABORTED >>>>")

 +24                       SET XPDABORT=2

                       End DoDot:2

                       QUIT 

 +25               KILL DGFDA,ROOT,DGWP

 +26               SET ROOT="DGFDA(38.6,""?+1,"")"

 +27               SET DGKSUB=DGK_U_DGKRTN

                   DO @DGKSUB

                   IF '$DATA(DGFDA)

                       QUIT 

 +28               SET DGIEN(1)=DGK

                   SET DGTITL=@ROOT@(.01)

                   SET @ROOT@(3)=KEYREQ

                   SET @ROOT@(4)=0

                   SET @ROOT@(5)=0

                   SET @ROOT@(6)=1

                   SET @ROOT@(50)="DGWP"

 +29               DO UPDATE^DIE("","DGFDA","DGIEN","DGERR")

 +30               IF $DATA(DGERR)

                       Begin DoDot:2

 +31                       DO BMES^XPDUTL("   >>> ERROR! "_DGTITL_" not added to file #38.6")

 +32                       DO MES^XPDUTL("     "_DGERR("DIERR",1)_": "_DGERR("DIERR",1,"TEXT",1))

 +33                       DO BMES^XPDUTL("                        <<<< INSTALLATION ABORTED >>>>")

 +34                       SET XPDABORT=2

                       End DoDot:2

                       QUIT 

 +35               DO BMES^XPDUTL("      "_DGTITL_" successfully added.")

               End DoDot:1

 +36       QUIT