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 - Enrollment API - Consistency check 05/05/99 ; 4/10/09 1:27pm
  1.  ;;5.3;PIMS;**232,306,327,367,417,454,456,491,514,451,1015,1016**;JUN 30, 2012;Build 20
  1.  ;CHECKand TESTVAL moved from DGENA1
  1. CHECK(DGENR,DGPAT,ERRMSG) ;
  1.  ;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.
  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.  .;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)
  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,REJECTED-INITIAL APPLICATION BY VAMC,REJECTED-FISCAL YEAR,REJECTED-MID-CYCLE,REJECTED-STOP NEW ENROLLMENTS,REJECTED-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.  ..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