| 1 | DG53653U ;TDM - Patch DG*5.3*653 Install Utility Routine ; 11/28/05 4:58pm
|
|---|
| 2 | ;;5.3;Registration;**653**;AUG 13, 1993;Build 2
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | EP ; Add new entries to the INCONSISTENT DATA ELEMENTS file (#38.6)
|
|---|
| 6 | N BRNG,ERNG,DGKRTN,KEYREQ
|
|---|
| 7 | D ADDINC(301,312,"DG53653V",0) Q:$G(XPDABORT)=2
|
|---|
| 8 | D ADDINC(401,413,"DG53653W",0) Q:$G(XPDABORT)=2
|
|---|
| 9 | D ADDINC(501,517,"DG53653X",0) Q:$G(XPDABORT)=2
|
|---|
| 10 | D ADDINC(701,726,"DG53653Y",0) Q:$G(XPDABORT)=2
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | ADDINC(BRNG,ERNG,DGKRTN,KEYREQ) ; add new entries to the INCONSISTENT DATA ELEMENTS file (#38.6)
|
|---|
| 14 | ;-----------------------------------------------------------------
|
|---|
| 15 | ; Input: BRNG = Beginning Number
|
|---|
| 16 | ; ERNG = Ending Number
|
|---|
| 17 | ; DGKRTN = Routine Name for the Range
|
|---|
| 18 | ; KEYREQ = Key Required
|
|---|
| 19 | ; 0=No Key Required
|
|---|
| 20 | ; 1=Eligibility Verified
|
|---|
| 21 | ; 2=Money Verified
|
|---|
| 22 | ; 3=Service Verified
|
|---|
| 23 | ; 4=Key Always Required
|
|---|
| 24 | ;-----------------------------------------------------------------
|
|---|
| 25 | N DGK,DGKSUB,DGWP,ROOT,DGFDA,DGWP,DGERR,DGIEN,DGTITL
|
|---|
| 26 | K XPDABORT
|
|---|
| 27 | D BMES^XPDUTL(" >> Adding entries "_BRNG_"-"_ERNG_" into the INCONSISTENT DATA ELEMENTS file (#38.6)")
|
|---|
| 28 | F DGK=BRNG:1:ERNG Q:$G(XPDABORT)=2 D
|
|---|
| 29 | .I $D(^DGIN(38.6,DGK)) D Q
|
|---|
| 30 | ..D BMES^XPDUTL(" Internal Entry # "_DGK_" already exists in file #38.6")
|
|---|
| 31 | ..S ROOT="DGFDA(38.6,"""_DGK_","")" S DGKSUB=DGK_U_DGKRTN D @DGKSUB
|
|---|
| 32 | ..I $P($G(^DGIN(38.6,DGK,0)),"^")=$G(@ROOT@(.01)) D MES^XPDUTL("Entry "_DGK_" matches incoming entry - OK") Q
|
|---|
| 33 | ..D MES^XPDUTL(" >>> ERROR: Entry # "_DGK_" needs to be reviewed by NVS! <<<")
|
|---|
| 34 | ..D MES^XPDUTL(" Existing entry: "_$P($G(^DGIN(38.6,DGK,0)),"^"))
|
|---|
| 35 | ..D MES^XPDUTL(" Incoming entry: "_$G(@ROOT@(.01)))
|
|---|
| 36 | ..D BMES^XPDUTL(" <<<< INSTALLATION ABORTED >>>>")
|
|---|
| 37 | ..S XPDABORT=2
|
|---|
| 38 | .K DGFDA,ROOT,DGWP
|
|---|
| 39 | .S ROOT="DGFDA(38.6,""?+1,"")"
|
|---|
| 40 | .S DGKSUB=DGK_U_DGKRTN D @DGKSUB Q:'$D(DGFDA)
|
|---|
| 41 | .S DGIEN(1)=DGK,DGTITL=@ROOT@(.01),@ROOT@(3)=KEYREQ,@ROOT@(4)=0,@ROOT@(5)=0,@ROOT@(6)=1,@ROOT@(50)="DGWP"
|
|---|
| 42 | .D UPDATE^DIE("","DGFDA","DGIEN","DGERR")
|
|---|
| 43 | .I $D(DGERR) D Q
|
|---|
| 44 | ..D BMES^XPDUTL(" >>> ERROR! "_DGTITL_" not added to file #38.6")
|
|---|
| 45 | ..D MES^XPDUTL(" "_DGERR("DIERR",1)_": "_DGERR("DIERR",1,"TEXT",1))
|
|---|
| 46 | ..D BMES^XPDUTL(" <<<< INSTALLATION ABORTED >>>>")
|
|---|
| 47 | ..S XPDABORT=2
|
|---|
| 48 | .D BMES^XPDUTL(" "_DGTITL_" successfully added.")
|
|---|
| 49 | Q
|
|---|
