DG531048P ;ALB/JAM - DG*5.3*1048 PRE-INSTALL ROUTINE FOR PATCH DG*5.3*1048;04 March 2021 9:00 AM
;;5.3;Registration;**1048**;Aug 13, 1993;Build 7
;
QUIT
;--------------------------------------------------------------------------
;Patch DG*5.3*1048: Pre-Install routine. Tag INCLUDE only used for Screen Logic
;--------------------------------------------------------------------------
;
; ICRs:
; 10141 : BMES^XPDUTL
; : MES^XPDUTL
;
PRE ; Pre-install for patch DG*5.3*1048
;Add OTHER FEDERAL AGENCY eligibility to entries in file #21 (Period Of Service)
; sub-file (#21.01)
;
N DGPHEC ;OTHER FEDERAL AGENCY - Eligibility Code actual name
N DGPHIEN ;OTHER FEDERAL AGENCY - IEN in file #8
N DGPOSIEN ;Period of Service IEN in file #21
N DGFDA ;FDA for DBS call
N DGERR ;Error array for DBS call
;
D BMES^XPDUTL("**Updating the OTHER NON-VETERANS entry in the PERIOD OF SERVICE FILE (#21).")
S DGPHEC="OTHER FEDERAL AGENCY",DGPHIEN=$$FIND1^DIC(8,"","X",DGPHEC,"","","DGERR")
I 'DGPHIEN!$D(DGERR) D Q
.D BMES^XPDUTL(" >> OTHER FEDERAL AGENCY not found in ELIGIBILITY CODE file (#8).")
.D MES^XPDUTL(" >> Unable to update PERIOD OF SERVICE file (#21).")
;
S DGPOSIEN=$$FIND1^DIC(21,"","X","OTHER NON-VETERANS","","","DGERR") I 'DGPOSIEN!$D(DGERR) Q
I $$FIND1^DIC(21.01,","_DGPOSIEN_",","X",DGPHIEN,"","","DGERR") D Q
.D BMES^XPDUTL(" >> OTHER FEDERAL AGENCY already exists in OTHER NON-VETERANS entry.")
.D MES^XPDUTL(" >> No update required.")
S DGFDA(21.01,"+1,"_DGPOSIEN_",",.01)=DGPHEC
D UPDATE^DIE("E","DGFDA","","DGERR")
I $D(DGERR) D BMES^XPDUTL(" >> Unable to update PERIOD OF SERVICE file (#21).") Q
D BMES^XPDUTL(" >> Successfully added OTHER FEDERAL AGENCY as ELIGIBILITY for OTHER NON-VETERANS. ")
Q
;
INCLUDE(DGY) ; This tag is called by the Screen Logic of the build to determine which entries should be included in the build
; for the OTHER FEDERAL AGENCY file (#35).
; Input: DGY - the entry number of the entry in file #35
; Output: TRUE if the entry should be included in the build
;
I $P($G(^DIC(35,+DGY,0)),U,1)="DEPT HEALTH AND HUMAN SERVICES" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="DEPARTMENT OF INTERIOR" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="DEPARTMENT OF JUSTICE" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="DEPARTMENT OF AGRICULTURE" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="DEPARTMENT OF TRANSPORTATION" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="NAT ARCHIVES AND RECORDS ADMIN" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="SMALL BUSINESS ADMINISTRATION" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="ENVIRONMENTAL PROTECTION AGCY" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="GENERAL SERVICES ADMIN" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="OFFICE OF PERSONNEL MANAGEMENT" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="US FEDERAL JUDICIARY" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="VA - STATE VETERANS HOME" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="HHS - FOOD AND DRUG ADMIN" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="HHS - OFC OF THE INSP GENERAL" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="HHS - CHILDREN AND FAMILIES" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="US DC SOUTHERN DISTRICT OF NY" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="DOJ - DRUG ENFORCEMENT ADMIN" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="DC FEDERAL CIRCUIT COURT" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="DOA - FOREST SERVICE" Q 1
I $P($G(^DIC(35,+DGY,0)),U,1)="OTHER" Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531048P 3414 printed Nov 22, 2024@17:45:42 Page 2
DG531048P ;ALB/JAM - DG*5.3*1048 PRE-INSTALL ROUTINE FOR PATCH DG*5.3*1048;04 March 2021 9:00 AM
+1 ;;5.3;Registration;**1048**;Aug 13, 1993;Build 7
+2 ;
+3 QUIT
+4 ;--------------------------------------------------------------------------
+5 ;Patch DG*5.3*1048: Pre-Install routine. Tag INCLUDE only used for Screen Logic
+6 ;--------------------------------------------------------------------------
+7 ;
+8 ; ICRs:
+9 ; 10141 : BMES^XPDUTL
+10 ; : MES^XPDUTL
+11 ;
PRE ; Pre-install for patch DG*5.3*1048
+1 ;Add OTHER FEDERAL AGENCY eligibility to entries in file #21 (Period Of Service)
+2 ; sub-file (#21.01)
+3 ;
+4 ;OTHER FEDERAL AGENCY - Eligibility Code actual name
NEW DGPHEC
+5 ;OTHER FEDERAL AGENCY - IEN in file #8
NEW DGPHIEN
+6 ;Period of Service IEN in file #21
NEW DGPOSIEN
+7 ;FDA for DBS call
NEW DGFDA
+8 ;Error array for DBS call
NEW DGERR
+9 ;
+10 DO BMES^XPDUTL("**Updating the OTHER NON-VETERANS entry in the PERIOD OF SERVICE FILE (#21).")
+11 SET DGPHEC="OTHER FEDERAL AGENCY"
SET DGPHIEN=$$FIND1^DIC(8,"","X",DGPHEC,"","","DGERR")
+12 IF 'DGPHIEN!$DATA(DGERR)
Begin DoDot:1
+13 DO BMES^XPDUTL(" >> OTHER FEDERAL AGENCY not found in ELIGIBILITY CODE file (#8).")
+14 DO MES^XPDUTL(" >> Unable to update PERIOD OF SERVICE file (#21).")
End DoDot:1
QUIT
+15 ;
+16 SET DGPOSIEN=$$FIND1^DIC(21,"","X","OTHER NON-VETERANS","","","DGERR")
IF 'DGPOSIEN!$DATA(DGERR)
QUIT
+17 IF $$FIND1^DIC(21.01,","_DGPOSIEN_",","X",DGPHIEN,"","","DGERR")
Begin DoDot:1
+18 DO BMES^XPDUTL(" >> OTHER FEDERAL AGENCY already exists in OTHER NON-VETERANS entry.")
+19 DO MES^XPDUTL(" >> No update required.")
End DoDot:1
QUIT
+20 SET DGFDA(21.01,"+1,"_DGPOSIEN_",",.01)=DGPHEC
+21 DO UPDATE^DIE("E","DGFDA","","DGERR")
+22 IF $DATA(DGERR)
DO BMES^XPDUTL(" >> Unable to update PERIOD OF SERVICE file (#21).")
QUIT
+23 DO BMES^XPDUTL(" >> Successfully added OTHER FEDERAL AGENCY as ELIGIBILITY for OTHER NON-VETERANS. ")
+24 QUIT
+25 ;
INCLUDE(DGY) ; This tag is called by the Screen Logic of the build to determine which entries should be included in the build
+1 ; for the OTHER FEDERAL AGENCY file (#35).
+2 ; Input: DGY - the entry number of the entry in file #35
+3 ; Output: TRUE if the entry should be included in the build
+4 ;
+5 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="DEPT HEALTH AND HUMAN SERVICES"
QUIT 1
+6 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="DEPARTMENT OF INTERIOR"
QUIT 1
+7 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="DEPARTMENT OF JUSTICE"
QUIT 1
+8 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="DEPARTMENT OF AGRICULTURE"
QUIT 1
+9 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="DEPARTMENT OF TRANSPORTATION"
QUIT 1
+10 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="NAT ARCHIVES AND RECORDS ADMIN"
QUIT 1
+11 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="SMALL BUSINESS ADMINISTRATION"
QUIT 1
+12 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="ENVIRONMENTAL PROTECTION AGCY"
QUIT 1
+13 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="GENERAL SERVICES ADMIN"
QUIT 1
+14 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="OFFICE OF PERSONNEL MANAGEMENT"
QUIT 1
+15 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="US FEDERAL JUDICIARY"
QUIT 1
+16 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="VA - STATE VETERANS HOME"
QUIT 1
+17 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="HHS - FOOD AND DRUG ADMIN"
QUIT 1
+18 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="HHS - OFC OF THE INSP GENERAL"
QUIT 1
+19 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="HHS - CHILDREN AND FAMILIES"
QUIT 1
+20 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="US DC SOUTHERN DISTRICT OF NY"
QUIT 1
+21 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="DOJ - DRUG ENFORCEMENT ADMIN"
QUIT 1
+22 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="DC FEDERAL CIRCUIT COURT"
QUIT 1
+23 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="DOA - FOREST SERVICE"
QUIT 1
+24 IF $PIECE($GET(^DIC(35,+DGY,0)),U,1)="OTHER"
QUIT 1
+25 QUIT 0
