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

DGENELA1.m

Go to the documentation of this file. 
  1. DGENELA1 ;ALB/CJM,RTK,TDM,PJR,RGL,LBD,EG,TMK,CKN,ERC,HM - Patient Eligibility API ;20 Jan 2015  3:27 PM
  1.  ;;5.3;Registration;**147,327,314,367,497,451,564,631,672,659,583,746,653,688,841,909,972,952**;Aug 13,1993;Build 160
  1.  ;
  1. CHECK(DGELG,DGPAT,DGCDIS,ERRMSG) ;
  1.  ;Does validation checks on the eligibility contained in the DGELG array.
  1.  ;
  1.  ;Input:
  1.  ;  DGELG - array containing eligibility data (pass by reference)
  1.  ;  DGPAT - array containing patient data (pass by reference)
  1.  ;  DGCDIS - array containing catastrophic disability determination (pass by reference)
  1.  ;
  1.  ;Output:
  1.  ;  Function Value - returns 1 if all validation checks passed, 0 otherwise
  1.  ;  ERRMSG - returns a message if validations fail (pass by reference)
  1.  ;
  1.  N SUCCESS,NATCODE,BAD,SUB,CODE,DGONV,DGTEXT,INELDATE
  1.  S SUCCESS=0
  1.  S ERRMSG=""
  1.  ;
  1.  D  ;drops out of block on failure
  1.  .;
  1.  .;get optional arrays if not there
  1.  .I '$D(DGPAT),'$$GET^DGENPTA(DGELG("DFN"),.DGPAT) S ERRMSG="PATIENT NOT FOUND" Q
  1.  .I '$D(DGCDIS),'$$GET^DGENCDA(DGELG("DFN"),.DGCDIS) S ERRMSG="PATIENT NOT FOUND" Q
  1.  .;
  1.  .;do field level checks
  1.  .S SUB="" F  S SUB=$O(DGELG(SUB)) Q:(SUB="")  I SUB'="ELIG",SUB'="RATEDIS",'$$CHKFIELD(SUB,DGELG(SUB)) S ERRMSG="BAD VALUE, FIELD = "_$$GET1^DID(2,$$FIELD(SUB),"","LABEL") Q
  1.  .;
  1.  .Q:(SUB'="")  ;didn't finish the loop
  1.  .;
  1.  .;also check SC % field of Rated Disabilities
  1.  .S SUB="" F  S SUB=$O(DGELG("RATEDIS",SUB)) Q:(SUB="")  I '$$CHKFIELD("PER",DGELG("RATEDIS",SUB,"PER")) S ERRMSG="BAD VALUE, FIELD = DISABILITY % OF THE RATED DISABILITIES MULTIPLE" Q
  1.  .Q:(SUB'="")  ;didn't finish the loop
  1.  .;
  1.  .I DGELG("SC")="Y",DGELG("SCPER")="" S ERRMSG="SC% UNSPECIFIED FOR SC VET" Q
  1.  .;
  1.  .;!! put this check back when POS is added to the Z11 message
  1.  .;I DGPAT("VETERAN")="Y",'DGELG("POS") S ERRMSG="POS UNSPECIFIED" Q 
  1.  .;
  1.  .I 'DGELG("ELIG","CODE") S ERRMSG="PRIMARY ELIGIBILITY IS UNSPECIFIED" Q
  1.  .;
  1.  .I (DGELG("VACKAMT")>0),(DGELG("A&A")_DGELG("HB")_DGELG("VAPEN")_DGELG("VADISAB")'["Y") S ERRMSG="VA CHECK AMOUNT > 0 BUT INCOME INDICATORS ALL SHOW 'NO'" Q
  1.  .;
  1.  .;
  1.  .;
  1.  .I (DGELG("SC")="N"),(DGELG("VADISAB")="Y") S ERRMSG="NSC VETERANS CAN NOT BE RECEIVING VA DISABILITY BENEFITS" Q
  1.  .;
  1.  .S BAD=1 D  Q:BAD  ;check primary eligibility
  1.  ..S NATCODE=$$NATCODE^DGENELA(DGELG("ELIG","CODE"))
  1.  ..Q:'NATCODE
  1.  ..;
  1.  ..I NATCODE=21 S ERRMSG="CATASTROPHICALLY DISABLED NOT ALLOWED AS PRIMARY ELIGIBILITY" Q
  1.  ..;
  1.  ..I (DGPAT("VETERAN")="Y"),(DGELG("SC")="Y"),(DGELG("SCPER")<50),(NATCODE'=3) S ERRMSG="PRIMARY ELIGIBILITY CODE INCONSISTENT WITH SERVICE CONNECTED PERCENTAGE" Q
  1.  ..;
  1.  ..I (DGPAT("VETERAN")="Y"),(DGELG("SC")="Y"),(DGELG("SCPER")>49),(NATCODE'=1) S ERRMSG="PRIMARY ELIGIBILITY CODE INCONSISTENT WITH SERVICE CONNECTED PERCENTAGE" Q
  1.  ..;
  1.  ..S DGONV=$O(^DIC(21,"B","OTHER NON-VETERANS","")),INELDATE=$P($G(^DPT(DFN,.15)),"^",2)
  1.  ..I INELDATE'="",DGPAT("INELDATE")'>0,DGELG("POS"),DGELG("POS")=DGONV,'$D(^DIC(21,DGELG("POS"),"E",DGELG("ELIG","CODE"))) D
  1.  ...S DGTEXT="Patient was previously determined to be ineligible for VA health care.  Upon review, the individual is determined to be eligible for "
  1.  ...S DGTEXT=DGTEXT_"VA care.  Please update period of service and other eligibility data as needed.."
  1.  ...D ADDMSG^DGENUPL3(.MSGS,DGTEXT,0)
  1.  ..;
  1.  ..I (DGPAT("VETERAN")="Y"),(DGELG("SC")="Y"),(NATCODE=1)!(NATCODE=3) S BAD=0 Q  ;primary eligibility OK
  1.  ..;
  1.  ..I (DGPAT("VETERAN")="Y"),(DGELG("POW")="Y"),NATCODE'=18 S ERRMSG="PRIMARY ELIGIBILITY SHOULD BE PRISONER OF WAR" Q
  1.  ..;
  1.  ..I (DGPAT("VETERAN")="Y"),(DGELG("POW")="Y"),NATCODE=18 S BAD=0 Q
  1.  ..;
  1.  ..I (DGPAT("VETERAN")="Y"),(DGELG("PH")="Y"),NATCODE'=22 S ERRMSG="PRIMARY ELIGIBILITY SHOULD BE PURPLE HEART RECIPIENT" Q
  1.  ..;
  1.  ..I (DGPAT("VETERAN")="Y"),(DGELG("PH")="Y"),NATCODE=22 S BAD=0 Q
  1.  ..;
  1.  ..; disabled DG*5.3*367, for Inel
  1.  ..;I (DGPAT("VETERAN")'=$P($G(^DIC(8.1,NATCODE,0)),"^",5)) S ERRMSG="PRIMARY ELIGIBILTY NOT CONSISTENT WITH VETERAN STATUS" Q
  1.  ..;
  1.  ..I DGELG("A&A")'="Y",NATCODE=2 S ERRMSG="PRIMARY ELIGIBILITY INCONSISTENT WITH A&A INDICATOR" Q
  1.  ..;
  1.  ..I DGELG("HB")'="Y",NATCODE=15 S ERRMSG="PRIMARY ELIGIBILITY INCONSISTENT WITH HOUSEBOUND INDICATOR" Q
  1.  ..;
  1.  ..I DGELG("VAPEN")'="Y",NATCODE=4 S ERRMSG="PRIMARY ELIGIBILITY INCONSISTENT WITH VA PENSION INDICATOR" Q
  1.  ..;
  1.  ..I DGELG("SC")="Y",((NATCODE=4)!(NATCODE=5)) S ERRMSG="NSC ELIGIBILITY CODE INCONSISTENT WITH SERVICE CONNECTION INDICATOR" Q
  1.  ..;
  1.  ..I (DGPAT("DOB")>2061231),(NATCODE=16) S ERRMSG="DOB IS INCONSISTENT WITH ELIGIBILITY OF MEXICAN BORDER WAR" Q
  1.  ..;
  1.  ..I (DGPAT("DOB")>2071231),(NATCODE=17) S ERRMSG="DOB IS INCONSISTENT WITH ELIGIBILITY OF WORLD WAR I" Q
  1.  ..;
  1.  ..;primary eligibility is good
  1.  ..S BAD=0
  1.  .;
  1.  .S SUCCESS=1
  1.  .;check eligibilities multiple
  1.  .S CODE=0 F  S CODE=$O(DGELG("ELIG","CODE",CODE)) Q:'CODE  D  Q:('SUCCESS)
  1.  ..S NATCODE=$$NATCODE^DGENELA(CODE)
  1.  ..Q:'NATCODE
  1.  ..I NATCODE=21,'DGCDIS("DATE") S SUCCESS=0,ERRMSG="CATASTROPHICALLY DISABLED ELIGIBILITY REQUIRES CATASTROPHICALLY DISABLED DETERMINATION DATE" Q
  1.  .;
  1.  Q SUCCESS
  1.  ;
  1. STORE(DGELG,DGPAT,DGCDIS,ERROR,SKIPCHK) ;
  1.  ;Stores an eligibility record for a patient. The patient record must
  1.  ;already exist. A lock on the Patient record is required, and is
  1.  ;released upon completion.
  1.  ;
  1.  ;Input:
  1.  ;  DGELG - eligibility array (pass by reference)
  1.  ;  DGPAT - patient array (optional, pass by reference)
  1.  ;  DGCDIS - array containing the catastrophic disability determination (optional, pass by reference)
  1.  ;  SKIPCHK - flag, set to 1 means that the consistency checks
  1.  ;            were already done & should be skipped
  1.  ;
  1.  ;Output:
  1.  ;  Function Value - returns 1 if successful, otherwise 0
  1.  ;  ERROR - in event of failure returns an error message (pass by reference, optional)
  1.  ;
  1.  N SUCCESS,DATA,FIELD,DA,DFN,COUNT,OTHSTAT,Z
  1.  S DFN=$G(DGELG("DFN"))
  1.  S SUCCESS=0
  1.  S ERROR=""
  1.  ;
  1.  D  ;drops out of block on failure
  1.  .I '$$LOCK^DGENPTA1(DFN) S ERROR="UNABLE TO LOCK PATIENT RECORD" Q
  1.  .I $G(SKIPCHK)'=1,'$$CHECK(.DGELG,.DGPAT,.DGCDIS,.ERROR) Q
  1.  .S SUB="" F  S SUB=$O(DGELG(SUB)) Q:SUB=""  D
  1.  ..I SUB'="ELIG",SUB'="RATEDIS",SUB'="DFN" S FIELD=$$FIELD(SUB) I FIELD S DATA(FIELD)=DGELG(SUB)
  1.  .;lock Camp Lejeune when it comes over from HEC in Z11 - DG*5.3*909
  1.  .I "^Y^N^"[("^"_$G(DATA(.321701))_"^") S DATA(.32171)=1
  1.  .;
  1.  .;don't add the Primary Eligibility unless different, so as to not
  1.  .;fire off x-refs unless necessary
  1.  .I $P($G(^DPT(DFN,.36)),"^")'=DGELG("ELIG","CODE") S DATA(.361)=DGELG("ELIG","CODE")
  1.  .;
  1.  .; Only update User Enrollee fields if the incoming UE status is
  1.  .; greater than the USER ENROLLEE VALID THROUGH on file.
  1.  .I $G(DATA(.3617))<$P($G(^DPT(DFN,.361)),"^",7) K DATA(.3617),DATA(.3618)
  1.  .; update field 2/.5501 and entry in file 33
  1.  .I +$O(^DGOTH(33,"B",DFN,""))>0 S DATA(.5501)="" ; DG*5.3*952
  1.  .S OTHSTAT=$G(DGELG("OTH")) ; DG*5.3*952
  1.  .I "^0^1^"[(U_OTHSTAT_U) D  ; ; DG*5.3*952
  1.  ..S Z=$$FILSTAT^DGOTHUT1(DFN,OTHSTAT) I '+Z S ERROR="FILEMAN FAILED TO UPDATE FILE 33: "_$P(Z,U,2) Q  ; DG*5.3*952
  1.  ..I OTHSTAT=1 S DATA(.5501)=DGELG("OTHTYPE") ; DG*5.3*952
  1.  ..Q  ; DG*5.3*952
  1.  .;
  1.  .;update Patient file record with data from Z11
  1.  .D UPDZ11^DGENELA2
  1.  .;
  1.  .;delete eligibilities that do not belong
  1.  .D DELELIG^DGENELA2(DFN,.DGELG)
  1.  .;
  1.  .;overlay Rated Disabilities
  1.  .Q:'$$OVERLAY()
  1.  .;
  1.  .;Add the new Patient Eligibilities
  1.  .;Don't add the an eligibility unless different - so as to not
  1.  .;fire off the x-refs unless necessary.
  1.  .;Also, try to assign ien = the code (see input transform of the field).
  1.  .K DA,DATA
  1.  .S DA(1)=DFN
  1.  .S DATA(.01)=0
  1.  .F  S DATA(.01)=$O(DGELG("ELIG","CODE",DATA(.01))) Q:'DATA(.01)  I '$D(^DPT(DFN,"E","B",DATA(.01))) I '$$ADD^DGENDBS(2.0361,.DA,.DATA,,$S($D(^DPT(DFN,"E",DATA(.01))):0,1:DATA(.01))) S ERROR="FILEMAN FAILED TO ADD PATIENT ELIGIBILITY" Q
  1.  .;
  1.  .S SUCCESS=1
  1.  ;
  1.  D UNLOCK^DGENPTA1(DFN)
  1.  Q SUCCESS
  1.  ;
  1. FIELD(SUB) ;
  1.  ;given a subscript from the ELIGIBILITY array, returns the field number
  1.  ;
  1.  Q:SUB="CODE" .361
  1.  Q:SUB="SC" .301
  1.  Q:SUB="SCPER" .302
  1.  Q:SUB="EFFDT" .3014
  1.  Q:SUB="POW" .525
  1.  Q:SUB="PH" .531
  1.  Q:SUB="A&A" .36205
  1.  Q:SUB="HB" .36215
  1.  Q:SUB="VAPEN" .36235
  1.  Q:SUB="VACKAMT" .36295
  1.  Q:SUB="DISRET" .3602
  1.  Q:SUB="DISLOD" .3603
  1.  Q:SUB="MEDICAID" .381
  1.  Q:SUB="MEDASKDT" .382 ;EVC - DG*5.3*653
  1.  Q:SUB="AO" .32102
  1.  Q:SUB="IR" .32103
  1.  Q:SUB="EC" .322013  ;name change from Env Con, DG*5.3*688
  1.  Q:SUB="MTSTA" ""  ;don't map Means Test Category
  1.  Q:SUB="P&T" .304
  1.  Q:SUB="P&TDT" .3013  ;field added with DG*5.3*688
  1.  Q:SUB="POS" .323
  1.  Q:SUB="UNEMPLOY" .305
  1.  Q:SUB="SCAWDATE" .3012
  1.  Q:SUB="RATEINC" .293
  1.  Q:SUB="CLAIMNUM" .313
  1.  Q:SUB="CLAIMLOC" .314
  1.  Q:SUB="VADISAB" .3025
  1.  Q:SUB="ELIGSTA" .3611
  1.  Q:SUB="ELIGSTADATE" .3612
  1.  Q:SUB="ELIGVERIF" .3615
  1.  Q:SUB="ELIGENTBY" .3616
  1.  Q:SUB="RD" .01
  1.  Q:SUB="PER" 2
  1.  Q:SUB="RDSC" 3
  1.  Q:SUB="RDEXT" 4
  1.  Q:SUB="RDORIG" 5
  1.  Q:SUB="RDCURR" 6
  1.  Q:SUB="UEYEAR" .3617
  1.  Q:SUB="UESITE" .3618
  1.  Q:SUB="AOEXPLOC" .3213
  1.  Q:SUB="CVELEDT" .5295
  1.  Q:SUB="SHAD" .32115
  1.  Q:SUB="MOH" .541
  1.  Q:SUB="MOHAWRDDATE" .542  ;MOH AWARD DATE DG*5.3*972 HM
  1.  Q:SUB="MOHSTATDATE" .543  ;MOH STATUS DATE DG*5.3*972 HM
  1.  Q:SUB="MOHEXEMPDATE" .544 ;MOH COPAYMENT EXEMPTION DATE DG*5.3*972 HM
  1.  Q:SUB="CLE" .321701     ; Added for Camp Lejeune - DG*5.3*909
  1.  Q:SUB="CLEDT" .321702   ; Added for Camp Lejeune - DG*5.3*909
  1.  Q:SUB="CLEST" .321703   ; Added for Camp Lejeune - DG*5.3*909
  1.  Q:SUB="CLESOR" .321704  ; Added for Camp Lejeune - DG*5.3*909
  1.  ;
  1.  Q ""
  1.  ;
  1. CHKFIELD(SUB,VAL) ;
  1.  ;Description: Does field level validation of the value. Returns 1
  1.  ;if the value is good, 0 otherwise.
  1.  ;
  1.  Q:($G(VAL)="") 1  ;for now, all NULL values assumed okay
  1.  ;
  1.  N BAD S BAD=0
  1.  I (SUB="SCPER")!(SUB="PER"),(+VAL'=VAL)!(VAL>100)!(VAL<0)!(VAL?.E1"."1N.N) S BAD=1
  1.  I SUB="VACKAMT",+VAL'=VAL&(VAL'?.N1"."2N)!(VAL>99999)!(VAL<0) S BAD=1
  1.  I SUB="DISRET",VAL'=0,VAL'=1 S BAD=1
  1.  I SUB="DISLOD",VAL'=0,VAL'=1 S BAD=1
  1.  I SUB="MEDICAID",VAL'=0,VAL'=1 S BAD=1
  1.  I SUB="RATEINC",VAL'=0,VAL'=1 S BAD=1
  1.  I SUB="ELIGSTA",VAL'="P",VAL'="R",VAL'="V" S BAD=1
  1.  I SUB="POW",VAL'="Y",VAL'="N",VAL'="U" S BAD=1
  1.  Q 'BAD
  1.  ;
  1.  ;
  1. OVERLAY() ;
  1.  ;Description: Overlay the local Rated Disabilities with whatever HEC
  1.  ;sent.
  1.  ;
  1.  N SUCCESS S SUCCESS=1
  1.  ;
  1.  ;delete the rated disabilities multiple
  1.  D DELRDIS^DGENELA2(DFN)
  1.  ;
  1.  ;add the rated disabilities
  1.  K DATA,DA
  1.  S DA(1)=DFN
  1.  S COUNT=0
  1.  F  S COUNT=$O(DGELG("RATEDIS",COUNT)) Q:'COUNT  D
  1.  .S DATA(.01)=DGELG("RATEDIS",COUNT,"RD")
  1.  .I DATA(.01) D
  1.  ..S DATA(2)=DGELG("RATEDIS",COUNT,"PER")
  1.  ..S DATA(3)=DGELG("RATEDIS",COUNT,"RDSC")
  1.  ..S DATA(4)=DGELG("RATEDIS",COUNT,"RDEXT")
  1.  ..S DATA(5)=DGELG("RATEDIS",COUNT,"RDORIG")
  1.  ..S DATA(6)=DGELG("RATEDIS",COUNT,"RDCURR")
  1.  ..I '$$ADD^DGENDBS(2.04,.DA,.DATA) S ERROR="FILEMAN FAILED TO ADD RATED DISABILTIES",SUCCESS=0
  1.  Q SUCCESS