Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENA3

DGENA3.m

Go to the documentation of this file.
  1. DGENA3 ;ALB/CJM,ISA,KWP,RTK,TDM,LBD,PHH,PJR,TDM,KUM,JAM - Enrollment API - Consistency check ;03/23/20 12:41pm
  1. ;;5.3;Registration;**232,306,327,367,417,454,456,491,514,451,808,993,1027,1111**;Aug 13,1993;Build 18
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;CHECKand TESTVAL moved from DGENA1
  1. CHECK(DGENR,DGPAT,ERRMSG) ;
  1. ; DG*5.3*1111 - ENROLLMENT STATUS (file #27.15) entries of REJECTED renamed to DEFERRED. Comment below modified to reflect this.
  1. ;Phase II consistency checks do not include INACTIVE(3),DEFERRED(4),SUSPENDED(5),EXPIRED(8),PENDING(9) enrollment statuses. References to these statuses have been removed.
  1. ;Description: Does validation checks on the enrollment contained in the
  1. ; DGENR array.
  1. ;Input:
  1. ; DGENR - this local array contains an enrollment and should be passed
  1. ; by reference
  1. ; DGPAT - this local array contains the patient object, it is optional
  1. ; If not passed,the database is referenced. (pass by reference)
  1. ;Output:
  1. ; Function Value - returns 1 if all validation checks passed, 0
  1. ; otherwise
  1. ; ERRMSG - if the consistency checks fail, an error msg is returned (pass by reference)
  1. N VALID,DGELGSUB,SUB,PRIGRP
  1. S VALID=0
  1. S ERRMSG=""
  1. D ;drops out of block if invalid condition found
  1. .I '$G(DGENR("DFN")) S ERRMSG="PATIENT NOT FOUND IN DATABASE" Q
  1. .I '$D(^DPT(DGENR("DFN"),0)) S ERRMSG="PATIENT NOT FOUND IN DATABASE" Q
  1. .;if it points to a prior record, the DFN must match
  1. .I DGENR("PRIORREC") D Q:(ERRMSG'="")
  1. ..N DFN
  1. ..S DFN=$P($G(^DGEN(27.11,DGENR("PRIORREC"),0)),"^",2)
  1. ..I DFN,DFN'=DGENR("DFN") S ERRMSG="PATIENT'S PRIOR ENROLLMENT BELONGS TO ANOTHER PATIENT"
  1. .;check for required fields
  1. .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
  1. .Q:(ERRMSG'="")
  1. .;if the enrollment priority is present, it must be correct
  1. .M DGELGSUB=DGENR("ELIG")
  1. .;Phase II if the enrollment priority is present it must be correct based on the eligibility factors (SRS 6.5.1.2 d)
  1. .; ** temporarily commented out for HVE Phase II and III **
  1. .;I DGENR("PRIORITY") D Q:(ERRMSG'="")
  1. .;.S PRIGRP=$$PRI^DGENELA4(DGENR("ELIG","CODE"),.DGELGSUB,DGENR("DATE"),$G(DGENR("APP")))
  1. .;.;check priority
  1. .;.I DGENR("STATUS")=6 Q ; do not check priority for deceased
  1. .;.I DGENR("PRIORITY")'=$P(PRIGRP,"^") D Q
  1. .;..I $G(DGCDIS("VCD"))'="" Q
  1. .;..S ERRMSG="ENROLLMENT PRIORITY IS INCONSISTENT WITH ELIGIBILITY DATA - PRIORITY SHOULD BE "_$P(PRIGRP,"^")_$$EXTERNAL^DILFD(27.11,.12,"F",$P(PRIGRP,"^",2))
  1. .;.;check subgroup if priority = 7 or 8
  1. .;.Q:DGENR("PRIORITY")<7
  1. .;.; sub-priority "e" can be overridden with "a" at HEC
  1. .;.I "^1^1^5^5^1^"[("^"_DGENR("SUBGRP")_"^"_$P(PRIGRP,"^",2)_"^") Q
  1. .;.; sub-priority "g" can be overridden with "c" at HEC
  1. .;.I "^3^3^7^7^3^"[("^"_DGENR("SUBGRP")_"^"_$P(PRIGRP,"^",2)_"^") Q
  1. .;.S ERRMSG="ENROLLMENT PRIORITY IS INCONSISTENT WITH ELIGIBILITY DATA - PRIORITY SHOULD BE "_$P(PRIGRP,"^")_$$EXTERNAL^DILFD(27.11,.12,"F",$P(PRIGRP,"^",2))
  1. .; end of temporary comments
  1. .;
  1. .; DG*5.3*1111 - ENROLLMENT STATUS (file #27.15) entries of REJECTED renamed to DEFERRED.
  1. .;Phase II require priority if status is VERIFIED(2),DEFERRED-INITIAL APP(14),DEFERRED-FISCAL YEAR(11),DEFERRED-MIDCYCLE(12),DEFERRED-STOP ENROLL(13),DEFERRED-BELOW EGT THRESHOLD(22) (SRS 6.5.1.2 b)
  1. .I (DGENR("STATUS")=2)!(DGENR("STATUS")=14)!(DGENR("STATUS")=11)!(DGENR("STATUS")=12)!(DGENR("STATUS")=13)!(DGENR("STATUS")=22),DGENR("PRIORITY")="" D Q
  1. ..S ERRMSG="ENROLLMENT PRIORITY IS REQUIRED WITH ENROLLMENT STATUSES: VERIFIED,DEFERRED-INITIAL APPLICATION BY VAMC,DEFERRED-FISCAL YEAR,DEFERRED-MID-CYCLE,DEFERRED-STOP NEW ENROLLMENTS,DEFERRED-BELOW EGT"
  1. .;Phase II require enrollment date when status is verified(2)(SRS 6.5.1.2 d)
  1. .I DGENR("STATUS")=2,DGENR("DATE")="" S ERRMSG="ENROLLMENT DATE IS REQUIRED WHEN STATUS IS VERIFIED" Q
  1. .;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)
  1. .N CURIEN S CURIEN=$$FINDCUR^DGENA(DGENR("DFN"))
  1. .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
  1. .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
  1. .;if status is not CANCELED/DECLINED, the REASON field should be ""
  1. .I (DGENR("STATUS")'=7),DGENR("REASON") S ERRMSG="ENROLLMENT STATUS OF OTHER THAN CANCELED/DECLINED IS INCONSISTENT WITH REASON CANCELED/DECLINED" Q
  1. .;if not an eligible vet, enrollment must not have status of VERIFIED, or UNVERIFIED
  1. .;if status is CANCELED/DECLINED, then reason is required
  1. .I (DGENR("STATUS")=7),'DGENR("REASON") S ERRMSG="STATUS OF CANCELED/DECLINED REQUIRES REASON" Q
  1. .;if status is DECEASED and Date of Death is missing, send bulletin
  1. .; This bulletin has been disabled. DG*5.3*808
  1. .;I DGENR("STATUS")=6 D
  1. .;.I $D(DGPAT),'DGPAT("DEATH") D BULLETIN
  1. .;.I '$D(DGPAT),'$$DEATH^DGENPTA(DGENR("DFN")) D BULLETIN
  1. .Q:(ERRMSG'="")
  1. .;certain statuses not allowed for a dead patient
  1. .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
  1. .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
  1. .;all the field values must be valid
  1. .S SUB="" F S SUB=$O(DGENR(SUB)) Q:((ERRMSG'="")!(SUB="")) D
  1. ..;DG*5.3*1027 - Skip Validity check for Application Date if ES transmits Blank
  1. ..I SUB="APP",$G(DGOAPP)="" Q
  1. ..;
  1. ..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"
  1. .Q:(ERRMSG'="")
  1. .S SUB="" F S SUB=$O(DGENR("ELIG",SUB)) Q:((ERRMSG'="")!(SUB="")) D
  1. ..I '$$TESTVAL(SUB,DGENR("ELIG",SUB)) S ERRMSG="ENROLLMENT FIELD "_$$GET1^DID(27.11,$$FIELD^DGENU(SUB),"","LABEL")_" IS NOT VALID"
  1. .;if this point is reached it's valid
  1. .S VALID=1
  1. Q VALID
  1. TESTVAL(SUB,VAL) ;
  1. ;Description: returns 1 if VAL is a valid value for subscript SUB
  1. N DISPLAY,FIELD,RESULT,VALID
  1. S VALID=1
  1. I (VAL'="") D
  1. .S FIELD=$$FIELD^DGENU(SUB)
  1. .;if there is no external value then it is not valid
  1. .S DISPLAY=$$EXTERNAL^DILFD(27.11,FIELD,"F",VAL)
  1. .I (DISPLAY="") S VALID=0 Q
  1. .I $$GET1^DID(27.11,FIELD,"","TYPE")'="POINTER" D
  1. ..D CHK^DIE(27.11,FIELD,,VAL,.RESULT) I RESULT="^" S VALID=0 Q
  1. Q VALID
  1. BULLETIN ; Status vs. Date of Death Data Discrepancy Bulletin
  1. ; This bulletin has been disabled. DG*5.3*808
  1. Q
  1. N DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
  1. S DGMGRP=$O(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))
  1. Q:'DGMGRP
  1. D XMY^DGMTUTL(DGMGRP,0,1)
  1. S DGNAME=$P($G(^DPT(DFN,0)),"^"),DGSSN=$P($G(^DPT(DFN,0)),"^",9)
  1. S XMTEXT="DGBULL("
  1. S XMSUB="STATUS VS. DATE OF DEATH DATA DISCREPANCY"
  1. S DGLINE=0
  1. D LINE^DGEN("Patient: "_DGNAME,.DGLINE)
  1. D LINE^DGEN("SSN: "_DGSSN,.DGLINE)
  1. D LINE^DGEN("",.DGLINE)
  1. D LINE^DGEN("This Veteran's Enrollment Status is Deceased,",.DGLINE)
  1. D LINE^DGEN("however, there is no Date of Death on file for VistA.",.DGLINE)
  1. D LINE^DGEN("Actions you should take:",.DGLINE)
  1. D LINE^DGEN("",.DGLINE)
  1. D LINE^DGEN("- Add Date of Death Information in VistA, or",.DGLINE)
  1. D LINE^DGEN("",.DGLINE)
  1. D LINE^DGEN("- Contact the HEC to remove an erroneous Date of Death.",.DGLINE)
  1. D ^XMD
  1. Q