DG53653U ;TDM - Patch DG*5.3*653 Install Utility Routine ; 11/28/05 4:58pm
;;5.3;Registration;**653**;AUG 13, 1993;Build 2
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53653U 2442 printed Nov 22, 2024@17:48:02 Page 2
DG53653U ;TDM - Patch DG*5.3*653 Install Utility Routine ; 11/28/05 4:58pm
+1 ;;5.3;Registration;**653**;AUG 13, 1993;Build 2
+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
