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

DGENDD.m

Go to the documentation of this file. 
  1. DGENDD ;ALB/CJM,JAN,LBD,AMA,ERC - Enrollment Data Dictionary Functions; 13 JUN 1997;6-28-01 ; 5/8/07 11:28am
  1.  ;;5.3;PIMS;**121,351,503,733,1015,1016**;JUN 30, 2012;Build 20
  1.  ;
  1. SET1(DFN,DGENRIEN) ;
  1.  ;Description: sets the "AENRC" X-ref on the patient file
  1.  ;Inputs:
  1.  ;  DFN - the patient ien
  1.  ;  DGENRIEN - ien of current enrollment
  1.  ;
  1.  Q:'$G(DGENRIEN)
  1.  Q:'$G(DFN)
  1.  ;
  1.  N STATUS
  1.  S STATUS=$P($G(^DGEN(27.11,DGENRIEN,0)),"^",4)
  1.  S:STATUS ^DPT("AENRC",STATUS,DFN)=""
  1.  ;
  1.  Q
  1.  ;
  1. KILL1(DFN) ;
  1.  ;Description: This is the kill logic that corresponds to SET1.
  1.  ;Input: DFN is the patient ien
  1.  ;
  1.  Q:'$G(DFN)
  1.  ;
  1.  N DGSTATUS,STATUS
  1.  S DGSTATUS=$P(^DGEN(27.15,0),U,3)
  1.  F STATUS=1:1:DGSTATUS K ^DPT("AENRC",STATUS,DFN)
  1.  Q
  1.  ;
  1. SET2(DGENRIEN,STATUS) ;
  1.  ;Description: This MUMPS x-ref on the Patient Enrollment file sets the
  1.  ;  "AENRC" X-ref on the patient file.
  1.  ;Inputs:
  1.  ;  DGENRIEN - enrollment ien
  1.  ;  STATUS - the enrollment status
  1.  ;
  1.  Q:'$G(DGENRIEN)
  1.  Q:'$G(STATUS)
  1.  ;
  1.  N DFN
  1.  S DFN=$P($G(^DGEN(27.11,DGENRIEN,0)),"^",2)
  1.  Q:'DFN
  1.  I $$FINDCUR^DGENA(DFN)=DGENRIEN D
  1.  . S ^DPT("AENRC",STATUS,DFN)=""
  1.  ;
  1.  Q
  1.  ;
  1. KILL2(DGENRIEN,STATUS) ;
  1.  ;Description: This is the kill logic that corresponds to SET2.
  1.  ;Inputs:
  1.  ;  DGENRIEN - enrollment ien
  1.  ;  STATUS - the enrollment status
  1.  ;
  1.  Q:'$G(DGENRIEN)
  1.  Q:'$G(STATUS)
  1.  ;
  1.  N DFN
  1.  S DFN=$P($G(^DGEN(27.11,DGENRIEN,0)),"^",2)
  1.  Q:'DFN
  1.  I $$FINDCUR^DGENA(DFN)=DGENRIEN D
  1.  . K ^DPT("AENRC",STATUS,DFN)
  1.  Q
  1.  ;
  1. SETREM(DGENRIEN,STATUS) ;
  1.  ;This set logic is called by the Enrollment Status field (#.04) in 
  1.  ;the Patient Enrollment file (#27.11).  If the Enrollment Status
  1.  ;contains the word REJECTED, then "**REJECTED**" will be stuffed
  1.  ;into the Remarks field (#.091) of the Patient file (#2).  If the
  1.  ;Enrollment Status does not contain REJECTED, then the word
  1.  ;"**REJECTED**" will be removed.
  1.  ;Input:
  1.  ;  DGENRIEN - IEN of the enrollment record
  1.  ;  STATUS - enrollment status
  1.  ;
  1.  Q:'$G(DGENRIEN)
  1.  Q:'$G(STATUS)
  1.  ;
  1.  N DFN,REM
  1.  S DFN=$P($G(^DGEN(27.11,DGENRIEN,0)),U,2)
  1.  Q:'DFN  Q:$G(^DPT(DFN,0))=""
  1.  L +^DPT(DFN,0):5 I '$T Q
  1.  S REM=$P(^DPT(DFN,0),U,10)
  1.  ;The enrollment status contains REJECTED, set REMARKS
  1.  I "^11^12^13^14^22^"[(U_STATUS_U) D  G SETREMQ
  1.  . I REM["**REJECTED**" Q  ;Remarks already contain REJECTED
  1.  . S REM=REM_"**REJECTED**"
  1.  . S $P(^DPT(DFN,0),U,10)=REM
  1.  ;The enrollment status does not contain REJECTED, remove REMARKS
  1.  I REM'["**REJECTED**" G SETREMQ
  1.  S REM=$P(REM,"**REJECTED**",1)_$P(REM,"**REJECTED**",2,99)
  1.  S $P(^DPT(DFN,0),U,10)=REM
  1. SETREMQ L -^DPT(DFN,0)
  1.  Q
  1.  ;
  1. CSI1010(DA) ;
  1.  ;If COMBAT SERVICE INDICATED? (2/.5291) is "NO,"
  1.  ;set COMBAT INDICATED ON 1010EZ (2/1010.157) to "NO."
  1.  I $P($G(^DPT(DA,.52)),U,11)="N" D
  1.  . N DGFDA
  1.  . S DGFDA(2,DA_",",1010.157)=0
  1.  . D FILE^DIE(,"DGFDA")
  1.  Q
  1.  ;
  1. CTD1010(DA) ;
  1.  ;If COMBAT SERVICE INDICATED? (2/.5291) is "YES" and
  1.  ;COMBAT TO DATE (2/.5294) is greater than 11/11/1998,
  1.  ;set COMBAT INDICATED ON 1010EZ (2/1010.157) to "YES."
  1.  N NODE,ANS,DGFDA
  1.  S NODE=$G(^DPT(DA,.52)),ANS=0
  1.  I ($P(NODE,U,11)="Y"),($P(NODE,U,14)>2981111) S ANS=1
  1.  S DGFDA(2,DA_",",1010.157)=ANS
  1.  D FILE^DIE(,"DGFDA")
  1.  Q
  1. ENRAPP ;check to see if the Enrollment Application Date (.01 of file 27.11)
  1.  ;is before 10/1/1996 or before DOB or after DOD
  1.  N DGFLD
  1.  S DGFLD=$P(^DD(27.11,.01,0),U)
  1.  I $G(X)<2961001 D EN^DDIOL(DGFLD_" must not be before 10/1/1996.",,"!!!") K X Q
  1.  I $G(X)<$P(^DPT(DFN,0),U,3) D EN^DDIOL(DGFLD_" cannot be before Date of Birth.") K X Q
  1.  I $P($G(^DPT(DFN,.35)),U)>0,($G(X)>$P(^DPT(DFN,.35),U)) D
  1.  . D EN^DDIOL(DGFLD_" cannot be after Date of Death.") K X
  1.  Q