source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53P314.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1DG53P314 ;ALB/RPM - Patch DG*5.3*314 Install Utility Routine ; 12/12/00 5:19pm
2 ;;5.3;Registration;**314**;AUG 13, 1993
3 ;
4 ;
5ENV ;Main entry point for Environment check point.
6 ;
7 S XPDABORT=""
8 D PROGCHK(.XPDABORT) ;checks programmer variables
9 I XPDABORT="" K XPDABORT
10 Q
11 ;
12 ;
13PRE ;Main entry point for Pre-init items.
14 Q
15 ;
16 ;
17POST ;Main entry point for Post-init items.
18 ;
19 D POST1 ;Add new entry to ELIGIBILITY CODE file (#8)
20 D POST2 ;Add new entry to ENROLLMENT STATUS file (#27.15)
21 D POST3 ;Add PURPLE HEART RECIPIENT to PERIOD OF SERVICE file (#21)
22 Q
23 ;
24 ;
25PROGCHK(XPDABORT) ;checks for necessary programmer variables
26 ;
27 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
28 .D BMES^XPDUTL("*****")
29 .D MES^XPDUTL("Your programming variables are not set up properly.")
30 .D MES^XPDUTL("Installation aborted.")
31 .D MES^XPDUTL("*****")
32 .S XPDABORT=2
33 Q
34 ;
35 ;
36POST1 ;Add new entry to ELIGIBILITY CODE file (#8)
37 ;
38 NEW DGEC,DGPH,DGFDA,DGERR
39 S DGEC="PURPLE HEART RECIPIENT"
40 D BMES^XPDUTL("*** Adding 'PURPLE HEART RECIPIENT' to the ELIGIBILITY CODE file (#8).")
41 S DGPH=$$FIND1^DIC(8.1,"","X",DGEC)
42 I 'DGPH D Q
43 . D BMES^XPDUTL("*** PURPLE HEART RECIPIENT entry missing from file 8.1 - contact NVS.")
44 I $$FIND1^DIC(8,"","X",DGEC) D Q
45 . D BMES^XPDUTL("*** PURPLE HEART RECIPIENT entry already exists!")
46 ;add entry to file
47 S DGFDA(8,"+1,",.01)=DGEC
48 S DGFDA(8,"+1,",1)="BLUE"
49 S DGFDA(8,"+1,",2)="PH"
50 S DGFDA(8,"+1,",3)=2
51 S DGFDA(8,"+1,",4)="Y"
52 S DGFDA(8,"+1,",5)=DGEC
53 S DGFDA(8,"+1,",7)=1
54 S DGFDA(8,"+1,",8)=DGEC
55 S DGFDA(8,"+1,",9)="VA STANDARD"
56 S DGFDA(8,"+1,",11)="VA"
57 D UPDATE^DIE("E","DGFDA","","DGERR")
58 I '$D(DGERR) D BMES^XPDUTL("*** PURPLE HEART RECIPIENT successfully added to file #8.")
59 I $D(DGERR) D BMES^XPDUTL("*** PURPLE HEART RECIPIENT was NOT successfully added to file #8.")
60 Q
61 ;
62POST2 ; Add new entry to ENROLLMENT STATUS file (#27.15)
63 N FDA,ERR
64 D BMES^XPDUTL("Add New Pending Status, Purple Heart Unconfirmed.")
65 I $$FIND1^DIC(27.15,"","X","PENDING; PURPLE HEART UNCONFIRMED") D BMES^XPDUTL("*** New Pending Status entry already exists!") Q
66 S FDA(27.15,"+1,",.01)="PENDING; PURPLE HEART UNCONFIRMED"
67 S FDA(27.15,"+1,",.02)="P"
68 D UPDATE^DIE("","FDA","","ERR")
69 I $D(ERR) D BMES^XPDUTL("ERROR! New Pending Status not added!"),MES^XPDUTL(ERR("DIERR",1)_": "_ERR("DIERR",1,"TEXT",1)) Q
70 D MES^XPDUTL("New Pending Status successfully added.")
71 Q
72 ;
73POST3 ;Add Purple Heart to the PERIOD OF SERVICE file (#21) eligibility
74 ;sub-file (#21.01)
75 ;
76 N DGPHEC ;Purple Heart Eligibility Code name
77 N DGPHIEN ;Purple Heart IEN in file #8
78 N DGCNT ;Counter for number of Periods of Service modified
79 N DGPOS ;Period of Service name
80 N DGPOSIEN ;Period of Service IEN in file #21
81 N DGFDA ;FDA for DBS call
82 N DGERR ;Error array for DBS call
83 ;
84 D BMES^XPDUTL("** Updating PERIOD OF SERVICE file with Purple Heart Eligibility code.")
85 S DGPHEC="PURPLE HEART RECIPIENT"
86 S DGPHIEN=$$FIND1^DIC(8,"","MX",DGPHEC,"","","DGERR")
87 I 'DGPHIEN!$D(DGERR) D G POST3Q
88 . D BMES^XPDUTL("** PURPLE HEART RECIPIENT not found in the ELIGIBLITY CODE file (#8).")
89 . D BMES^XPDUTL("** Unable to update PERIOD OF SERVICE file.")
90 ;
91 S DGCNT=1
92 F S DGPOS=$P($T(POSTEX+DGCNT),";;",2) Q:DGPOS="" S DGCNT=DGCNT+1 D
93 . N DGERR
94 . S DGPOSIEN=$$FIND1^DIC(21,"","MX",DGPOS,"","","DGERR")
95 . I 'DGPOSIEN!$D(DGERR) Q
96 . S DGFDA(21.01,"+1,"_DGPOSIEN_",",.01)=DGPHEC
97 . D UPDATE^DIE("E","DGFDA","","DGERR")
98 D BMES^XPDUTL("** PURPLE HEART RECIPIENT successfully added to the PERIOD OF SERVICE file (#21).")
99 ;
100POST3Q ;
101 Q
102 ;
103POSTEX ;
104 ;;KOREAN
105 ;;OPERATION DESERT SHIELD
106 ;;PERSIAN GULF WAR
107 ;;POST-KOREAN
108 ;;POST-VIETNAM
109 ;;PRE-KOREAN
110 ;;SPANISH AMERICAN
111 ;;VIETNAM ERA
112 ;;WORLD WAR I
113 ;;WORLD WAR II
114 ;;
Note: See TracBrowser for help on using the repository browser.