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

DGOTHD.m

Go to the documentation of this file.
  1. DGOTHD ;SLC/SS,RM - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ;Feb 14, 2019@09:57
  1. ;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Last Edited: SHRPE/RM - Feb 14, 2019@09:57
  1. ;
  1. ;ICR# TYPE DESCRIPTION
  1. ;----- ---- ---------------------
  1. ; 2056 Sup ^DIQ : GET1
  1. ;10061 Sup ELIG^VADPT
  1. ;
  1. Q
  1. ;
  1. ;ask for the starting date for the ENTRY in file #33 (OTH ELIGIBILITY)
  1. STRDATE(DGDFN) ;
  1. I '$G(DGDFN) Q
  1. N DGSTRDT,Y,DGEXPMH,DGIEN33
  1. I '$$ISOTHD(DGDFN) Q
  1. S DGIEN33=$$HASENTRY^DGOTHD2(DGDFN)
  1. I DGIEN33 Q:$D(^DGOTH(33,DGIEN33,1))
  1. S DGEXPMH=$$GET1^DIQ(2,DGDFN,.5501,"I")
  1. S DGEXPMH=$$ISOTH(DGEXPMH)
  1. Q:'DGEXPMH
  1. D FRSTNTRY^DGOTHD1(DGDFN,DT,DGEXPMH)
  1. Q
  1. ;
  1. ;Functionality:
  1. ; checks OTHD eligibility
  1. ;
  1. ;Parameters:
  1. ; DFN - patient's IEN in the file (#2)
  1. ;
  1. ;Return values:
  1. ; 0 - not eligible for OTHD
  1. ; 1 - eligible for OTHD
  1. ;
  1. ISOTHD(DFN) ;
  1. N VAEL,DGOTHD,X
  1. D ELIG^VADPT
  1. S DGOTHD=0
  1. I +VAEL(1)>0,$$GET1^DIQ(8,+VAEL(1)_",",8)="EXPANDED MH CARE NON-ENROLLEE" S DGOTHD=1
  1. Q DGOTHD
  1. ;
  1. ;retrieve the default EXPANDED MH CARE TYPE
  1. GETEXPMH(DFN) ;
  1. ; Input:
  1. ; DFN - Patient IEN
  1. ;
  1. ; Output:
  1. ; EXPANDED MH CARE TYPE (File #2,Field #.5501)
  1. ;
  1. N VAEL,X
  1. I '$D(^DPT(DFN)) Q "-1^Patient not found"
  1. D ELIG^VADPT
  1. Q $P($G(VAEL(10)),U)
  1. ;
  1. ;this API returns the EXPANDED MH CARE TYPE
  1. GETEXPR(DFN) ;
  1. ; Input:
  1. ; DFN - Patient IEN
  1. ;
  1. ; Output:
  1. ; RET - EXPANDED MH CARE TYPE
  1. ;
  1. Q $$GETEXPMH(DFN)
  1. ;
  1. ISOTH(DGEXP) ;
  1. ;DG*5.3*977 OTH-EXT
  1. ;Added OTH-EXT check
  1. Q $S("/OTH-EXT/"[("/"_DGEXP_"/"):1,"/OTH-90/"[("/"_DGEXP_"/"):2,1:0)
  1. ;