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

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

initial load of FOIAVistA 6/30/08 version

File size: 7.0 KB
Line 
1DGENA3 ;ALB/CJM,ISA/KWP,RTK,TDM,LBD,PHH,PJR - Enrollment API - Consistency check 05/05/99 ; 7/16/04 1:33pm
2 ;;5.3;Registration;**232,306,327,367,417,454,456,491,514,451**;Aug 13,1993
3 ;CHECKand TESTVAL moved from DGENA1
4CHECK(DGENR,DGPAT,ERRMSG) ;
5 ;Phase II consistency checks do not include INACTIVE(3),REJECTED(4),SUSPENDED(5),EXPIRED(8),PENDING(9) enrollment statuses. References to these statuses have been removed.
6 ;Description: Does validation checks on the enrollment contained in the
7 ; DGENR array.
8 ;Input:
9 ; DGENR - this local array contains an enrollment and should be passed
10 ; by reference
11 ; DGPAT - this local array contains the patient object, it is optional
12 ; If not passed,the database is referenced. (pass by reference)
13 ;Output:
14 ; Function Value - returns 1 if all validation checks passed, 0
15 ; otherwise
16 ; ERRMSG - if the consistency checks fail, an error msg is returned (pass by reference)
17 N VALID,DGELGSUB,SUB,PRIGRP
18 S VALID=0
19 S ERRMSG=""
20 D ;drops out of block if invalid condition found
21 .I '$G(DGENR("DFN")) S ERRMSG="PATIENT NOT FOUND IN DATABASE" Q
22 .I '$D(^DPT(DGENR("DFN"),0)) S ERRMSG="PATIENT NOT FOUND IN DATABASE" Q
23 .;if it points to a prior record, the DFN must match
24 .I DGENR("PRIORREC") D Q:(ERRMSG'="")
25 ..N DFN
26 ..S DFN=$P($G(^DGEN(27.11,DGENR("PRIORREC"),0)),"^",2)
27 ..I DFN,DFN'=DGENR("DFN") S ERRMSG="PATIENT'S PRIOR ENROLLMENT BELONGS TO ANOTHER PATIENT"
28 .;check for required fields
29 .F SUB="APP","SOURCE","STATUS","EFFDATE" I $G(DGENR(SUB))="" S ERRMSG="ENROLLMENT FIELD "_$$GET1^DID(27.11,$$FIELD^DGENU(SUB),"","LABEL")_" IS MISSING" Q
30 .Q:(ERRMSG'="")
31 .;if the enrollment priority is present, it must be correct
32 .M DGELGSUB=DGENR("ELIG")
33 .;Phase II if the enrollment priority is present it must be correct based on the eligibility factors (SRS 6.5.1.2 d)
34 .; ** temporarily commented out for HVE Phase II and III **
35 .;I DGENR("PRIORITY") D Q:(ERRMSG'="")
36 .;.S PRIGRP=$$PRI^DGENELA4(DGENR("ELIG","CODE"),.DGELGSUB,DGENR("DATE"),$G(DGENR("APP")))
37 .;.;check priority
38 .;.I DGENR("STATUS")=6 Q ; do not check priority for deceased
39 .;.I DGENR("PRIORITY")'=$P(PRIGRP,"^") D Q
40 .;..I $G(DGCDIS("VCD"))'="" Q
41 .;..S ERRMSG="ENROLLMENT PRIORITY IS INCONSISTENT WITH ELIGIBILITY DATA - PRIORITY SHOULD BE "_$P(PRIGRP,"^")_$$EXTERNAL^DILFD(27.11,.12,"F",$P(PRIGRP,"^",2))
42 .;.;check subgroup if priority = 7 or 8
43 .;.Q:DGENR("PRIORITY")<7
44 .;.; sub-priority "e" can be overridden with "a" at HEC
45 .;.I "^1^1^5^5^1^"[("^"_DGENR("SUBGRP")_"^"_$P(PRIGRP,"^",2)_"^") Q
46 .;.; sub-priority "g" can be overridden with "c" at HEC
47 .;.I "^3^3^7^7^3^"[("^"_DGENR("SUBGRP")_"^"_$P(PRIGRP,"^",2)_"^") Q
48 .;.S ERRMSG="ENROLLMENT PRIORITY IS INCONSISTENT WITH ELIGIBILITY DATA - PRIORITY SHOULD BE "_$P(PRIGRP,"^")_$$EXTERNAL^DILFD(27.11,.12,"F",$P(PRIGRP,"^",2))
49 .; end of temporary comments
50 .;
51 .;Phase II require priority if status is VERIFIED(2),REJECTED-INITIAL APP(14),REJECTED-FISCAL YEAR(11),REJECTED-MIDCYCLE(12),REJECTED-STOP ENROLL(13),REJECTED BELOW EGT THRESHOLD(SRS 6.5.1.2 b)
52 .I (DGENR("STATUS")=2)!(DGENR("STATUS")=14)!(DGENR("STATUS")=11)!(DGENR("STATUS")=12)!(DGENR("STATUS")=13)!(DGENR("STATUS")=22),DGENR("PRIORITY")="" D Q
53 ..S ERRMSG="ENROLLMENT PRIORITY IS REQUIRED WITH ENROLLMENT STATUSES: VERIFIED,REJECTED-INITIAL APPLICATION BY VAMC,REJECTED-FISCAL YEAR,REJECTED-MID-CYCLE,REJECTED-STOP NEW ENROLLMENTS,REJECTED-BELOW EGT"
54 .;Phase II require enrollment date when status is verified(2)(SRS 6.5.1.2 d)
55 .I DGENR("STATUS")=2,DGENR("DATE")="" S ERRMSG="ENROLLMENT DATE IS REQUIRED WHEN STATUS IS VERIFIED" Q
56 .;Phase II if enrollment date present with statuses other than verified then veteran must be previously VERIFIED(2) and enrolled (SRS 6.5.1.2 d)
57 .N CURIEN S CURIEN=$$FINDCUR^DGENA(DGENR("DFN"))
58 .I DGENR("DATE"),DGENR("DATE")'="@",DGENR("STATUS")'=2,'CURIEN S ERRMSG="ENROLLMENT DATE IS PRESENT WITH STATUS OTHER THAN VERIFIED AND THE VETERAN WAS NOT PREVIOUSLY ENROLLED." Q
59 .I DGENR("DATE"),DGENR("DATE")'="@",DGENR("STATUS")'=2,CURIEN,$P($G(^DGEN(27.11,CURIEN,0)),"^",4)'=2 S ERRMSG="ENROLLMENT DATE IS PRESENT WITH STATUS OTHER THAN VERIFIED WAS PREVIOUSLY ENROLLED BUT THE PREVIOUS STATUS WAS NOT VERIFIED." Q
60 .;if status is not CANCELED/DECLINED, the REASON field should be ""
61 .I (DGENR("STATUS")'=7),DGENR("REASON") S ERRMSG="ENROLLMENT STATUS OF OTHER THAN CANCELED/DECLINED IS INCONSISTENT WITH REASON CANCELED/DECLINED" Q
62 .;if not an eligible vet, enrollment must not have status of VERIFIED, or UNVERIFIED
63 .;if status is CANCELED/DECLINED, then reason is required
64 .I (DGENR("STATUS")=7),'DGENR("REASON") S ERRMSG="STATUS OF CANCELED/DECLINED REQUIRES REASON" Q
65 .;if status is DECEASED and Date of Death is missing, send bulletin
66 .I DGENR("STATUS")=6 D
67 ..I $D(DGPAT),'DGPAT("DEATH") D BULLETIN
68 ..I '$D(DGPAT),'$$DEATH^DGENPTA(DGENR("DFN")) D BULLETIN
69 .Q:(ERRMSG'="")
70 .;certain statuses not allowed for a dead patient
71 .I $D(DGPAT),DGPAT("DEATH"),(DGENR("STATUS")=1)!(DGENR("STATUS")=2) S ERRMSG="ENROLLMENT STATUS OF VERIFIED OR UNVERIFIED NOT ALLOWED FOR A DECEASED PATIENT" Q
72 .I '$D(DGPAT),$$DEATH^DGENPTA(DGENR("DFN")),(DGENR("STATUS")=1)!(DGENR("STATUS")=2) S ERRMSG="ENROLLMENT STATUS OF VERIFIED OR UNVERIFIED NOT ALLOWED FOR A DECEASED PATIENT" Q
73 .;all the field values must be valid
74 .S SUB="" F S SUB=$O(DGENR(SUB)) Q:((ERRMSG'="")!(SUB="")) D
75 ..I SUB'="ELIG",(SUB'="DATE"),(SUB'="FACREC") I '$$TESTVAL(SUB,DGENR(SUB)) S ERRMSG="ENROLLMENT FIELD "_$$GET1^DID(27.11,$$FIELD^DGENU(SUB),"","LABEL")_" IS NOT VALID"
76 .Q:(ERRMSG'="")
77 .S SUB="" F S SUB=$O(DGENR("ELIG",SUB)) Q:((ERRMSG'="")!(SUB="")) D
78 ..I '$$TESTVAL(SUB,DGENR("ELIG",SUB)) S ERRMSG="ENROLLMENT FIELD "_$$GET1^DID(27.11,$$FIELD^DGENU(SUB),"","LABEL")_" IS NOT VALID"
79 .;if this point is reached it's valid
80 .S VALID=1
81 Q VALID
82TESTVAL(SUB,VAL) ;
83 ;Description: returns 1 if VAL is a valid value for subscript SUB
84 N DISPLAY,FIELD,RESULT,VALID
85 S VALID=1
86 I (VAL'="") D
87 .S FIELD=$$FIELD^DGENU(SUB)
88 .;if there is no external value then it is not valid
89 .S DISPLAY=$$EXTERNAL^DILFD(27.11,FIELD,"F",VAL)
90 .I (DISPLAY="") S VALID=0 Q
91 .I $$GET1^DID(27.11,FIELD,"","TYPE")'="POINTER" D
92 ..D CHK^DIE(27.11,FIELD,,VAL,.RESULT) I RESULT="^" S VALID=0 Q
93 Q VALID
94BULLETIN ; Status vs. Date of Death Data Discrepancy Bulletin
95 N DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
96 S DGMGRP=$O(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))
97 Q:'DGMGRP
98 D XMY^DGMTUTL(DGMGRP,0,1)
99 S DGNAME=$P($G(^DPT(DFN,0)),"^"),DGSSN=$P($G(^DPT(DFN,0)),"^",9)
100 S XMTEXT="DGBULL("
101 S XMSUB="STATUS VS. DATE OF DEATH DATA DISCREPANCY"
102 S DGLINE=0
103 D LINE^DGEN("Patient: "_DGNAME,.DGLINE)
104 D LINE^DGEN("SSN: "_DGSSN,.DGLINE)
105 D LINE^DGEN("",.DGLINE)
106 D LINE^DGEN("This Veteran's Enrollment Status is Deceased,",.DGLINE)
107 D LINE^DGEN("however, there is no Date of Death on file for VistA.",.DGLINE)
108 D LINE^DGEN("Actions you should take:",.DGLINE)
109 D LINE^DGEN("",.DGLINE)
110 D LINE^DGEN("- Add Date of Death Information in VistA, or",.DGLINE)
111 D LINE^DGEN("",.DGLINE)
112 D LINE^DGEN("- Contact the HEC to remove an erroneous Date of Death.",.DGLINE)
113 D ^XMD
114 Q
Note: See TracBrowser for help on using the repository browser.