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

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

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1DG53177P ;ALB/SEK - VALIDATE ELIGIBILITY CODE FILES ROUTINE; 20 JULY 1998
2 ;;5.3;Registration;**177**;Aug 13, 1993
3 ;
4 ; This routine will validate entries in the MAS ELIGIBILITY CODE
5 ; file (#8.1) and the ELIGIBILITY CODE file (#8).
6 ;
7 ; The MAS ELIGIBILITY CODE file will be checked to see that there
8 ; are 21 entries with the correct internal entry number (IEN),
9 ; name, and inactive flag.
10 ; Discrepancies will be printed.
11 ;
12 ; If discrepancies are found in the MAS ELIGIBILITY CODE file, the
13 ; ELIGIBILITY CODE file is not checked and the user is asked to
14 ; correct the discrepancies and rerun this routine (D ^DG53177P).
15 ;
16 ; The following checks will be done on the ELIGIBILITY CODE file:
17 ; . Each entry (MAS ELIGIBILITY CODE field) points to an entry in
18 ; the MAS ELIGIBILITY CODE file. Discrepancies will be printed.
19 ; . Inactive entry points to an active entry in the MAS ELIGIBILITY.
20 ; All occurrences will be printed with a message stating this may
21 ; be correct, just listing for further review.
22 ; . Active entry points to an inactive entry in the MAS ELIGIBILITY.
23 ; Occurrences will be printed.
24 ;
25 ;
26 ; Checking the MAS ELIGIBILITY CODE file (#8.1)
27EN ;
28 D BMES^XPDUTL(">>> Checking the internal entry number(IEN), name, and activity")
29 D MES^XPDUTL(" of the 21 entries in the MAS ELIGIBILITY CODE file (#8.1).")
30 N DG1,DG2,DGACT,DGIEN,DGN,DGNAME,DGS,DGSACT,DGX,DGX1
31 K DGERR
32 S DGN=0
33 F DG1=1:1 S DGX=$P($T(DATA+DG1),";;",2) G:DGX="QUIT" PRINT D
34 .S DGIEN=$P(DGX,"^"),DGNAME=$P(DGX,"^",2),DGACT=$P(DGX,"^",3)
35 .S DGS=$G(^DIC(8.1,DGIEN,0)) I DGS']"" S DGN=DGN+1,DGERR(DGN)=DGX_";" Q
36 .I DGNAME'=$P(DGS,"^")!(DGACT'=$P(DGS,"^",7)) D Q
37 ..S DGN=DGN+1,DGERR(DGN)=DGX_";A"
38 ..Q
39 .Q
40 ;
41PRINT ; Print MAS ELIGIBILITY CODE file discrepancies
42 G:'DGN NODEZ
43 D BMES^XPDUTL(" The following discrepancies were found:")
44 F DG2=1:1:DGN D
45 .S DGX=$P($G(DGERR(DG2)),";")
46 .S DGIEN=$P(DGX,"^"),DGNAME=$P(DGX,"^",2),DGACT=$P(DGX,"^",3)
47 .S DGX1=$P($G(DGERR(DG2)),";",2) I DGX1="" D Q
48 ..D MES^XPDUTL("Missing IEN of "_DGIEN_" - "_DGNAME_" and "_$S(DGACT:"inactive",1:"active"))
49 ..Q
50 .D MES^XPDUTL("IEN of "_DGIEN_" should be "_DGNAME_" and "_$S(DGACT:"inactive",1:"active"))
51 .Q
52 ;
53NODEZ ; check ^DIC(8.1,0 for 21 entries
54 I $P($G(^DIC(8.1,0)),"^",4)>21 D G CORR
55 .D BMES^XPDUTL(" The number of entries in the MAS ELIGIBILITY CODE file is greater than 21")
56 ;
57 I 'DGN D BMES^XPDUTL(" MAS ELIGIBILITY CODE file (#8.1) is correct.") G CHECK
58 ;
59CORR D BMES^XPDUTL(">>> Please correct the discrepancies in the MAS ELIGIBILITY CODE file")
60 D MES^XPDUTL(" and rerun DG53177P (D ^DG53177P)")
61 G QUIT
62 ;
63CHECK ; Checking the ELIGIBILITY CODE file (#8)
64 ;
65 D BMES^XPDUTL(">>> Checking the entries in the ELIGIBILITY CODE file (#8).")
66 N DG1,DG2,DGP,DGACT,DGN,DGSACT
67 ;
68 ; Each entry (MAS ELIGIBILITY CODE field) must point to an entry in
69 ; the MAS ELIGIBILITY CODE file.
70 ;
71 S DGN=0,DG1=0
72 F S DG1=$O(^DIC(8,DG1)) G:'DG1 PRINT1 D
73 .S DG2=$G(^DIC(8,DG1,0)) Q:DG2=""
74 .S DGP=$P(DG2,"^",9)
75 .I DGP<1!(DGP>21) S DGN=DGN+1,DGERR(1,DGN)=DG1_"^"_$P(DG2,"^") Q
76 .S DGACT=$P($P($T(DATA+DGP),";;",2),"^",3)
77 .S DGSACT=$P(DG2,"^",7)
78 .I DGSACT=1&(DGACT'=1) S DGN=DGN+1,DGERR(2,DGN)=DG1_"^"_$P(DG2,"^") Q
79 .I DGSACT'=1&(DGACT=1) S DGN=DGN+1,DGERR(3,DGN)=DG1_"^"_$P(DG2,"^") Q
80 .Q
81 ;
82PRINT1 ; Print ELIGIBILITY CODE file discrepancies
83 I 'DGN D G QUIT
84 . D BMES^XPDUTL(" ELIGIBILITY CODE file (#8) is correct.")
85 . D BMES^XPDUTL(" Validation has completed with no discrepancies found")
86 .Q
87 ;
88 N DG1,DG2
89 S DG1=0
90 F S DG1=$O(DGERR(DG1)) Q:'DG1 D
91 .D @$S(DG1=1:"ERR1",DG1=2:"ERR2",1:"ERR3")
92 .S DG2=0
93 .F S DG2=$O(DGERR(DG1,DG2)) Q:'DG2 D
94 ..D MES^XPDUTL(" IEN= "_$P(DGERR(DG1,DG2),"^")_" NAME= "_$P(DGERR(DG1,DG2),"^",2))
95 ..Q
96 G QUIT1
97 ;
98ERR1 D BMES^XPDUTL(" The following entries do not point to an entry in the")
99 D MES^XPDUTL(" MAS ELIGIBILITY CODE file:")
100 Q
101 ;
102ERR2 D BMES^XPDUTL(" The following inactive entries point to an active")
103 D MES^XPDUTL(" entry in the MAS ELIGIBILITY CODE file:")
104 D MES^XPDUTL(" These may be correct, just listing for further review.")
105 Q
106 ;
107ERR3 D BMES^XPDUTL(" The following active entries point to an inactive")
108 D MES^XPDUTL(" entry in the MAS ELIGIBILITY CODE file:")
109 Q
110 ;
111QUIT1 D BMES^XPDUTL(">>> Please correct the discrepancies in the ELIGIBILITY CODE file")
112 D MES^XPDUTL(" and rerun DG53177P (D ^DG53177P)")
113 ;
114QUIT K DGERR
115 Q
116 ;
117DATA ; IEN^NAME^INACTIVE of MAS ELIGIBILIY CODE file (#8.1)
118 ;;1^SERVICE CONNECTED 50% to 100%
119 ;;2^AID & ATTENDANCE
120 ;;3^SC LESS THAN 50%
121 ;;4^NSC, VA PENSION
122 ;;5^NSC
123 ;;6^OTHER FEDERAL AGENCY
124 ;;7^ALLIED VETERAN
125 ;;8^HUMANITARIAN EMERGENCY
126 ;;9^SHARING AGREEMENT
127 ;;10^REIMBURSABLE INSURANCE
128 ;;11^DOM. PATIENT^1
129 ;;12^CHAMPVA
130 ;;13^COLLATERAL OF VET.
131 ;;14^EMPLOYEE
132 ;;15^HOUSEBOUND
133 ;;16^MEXICAN BORDER WAR
134 ;;17^WORLD WAR I
135 ;;18^PRISONER OF WAR
136 ;;19^TRICARE/CHAMPUS
137 ;;20^MEDICARE^1
138 ;;21^CATASTROPHICALLY DISABLED
139 ;;QUIT
Note: See TracBrowser for help on using the repository browser.