DGENDD ;ALB/CJM,JAN,LBD,AMA,ERC,JAM - Enrollment Data Dictionary Functions; 13 JUN 1997;6-28-01 ;5/8/07 11:28am
;;5.3;Registration;**121,351,503,733,754,1015,1111**;Aug 13,1993;Build 18
;
SET1(DFN,DGENRIEN) ;
;Description: sets the "AENRC" X-ref on the patient file
;Inputs:
; DFN - the patient ien
; DGENRIEN - ien of current enrollment
;
Q:'$G(DGENRIEN)
Q:'$G(DFN)
;
N STATUS
S STATUS=$P($G(^DGEN(27.11,DGENRIEN,0)),"^",4)
S:STATUS ^DPT("AENRC",STATUS,DFN)=""
;
Q
;
KILL1(DFN) ;
;Description: This is the kill logic that corresponds to SET1.
;Input: DFN is the patient ien
;
Q:'$G(DFN)
;
N DGSTATUS,STATUS
S DGSTATUS=$P(^DGEN(27.15,0),U,3)
F STATUS=1:1:DGSTATUS K ^DPT("AENRC",STATUS,DFN)
Q
;
SET2(DGENRIEN,STATUS) ;
;Description: This MUMPS x-ref on the Patient Enrollment file sets the
; "AENRC" X-ref on the patient file.
;Inputs:
; DGENRIEN - enrollment ien
; STATUS - the enrollment status
;
Q:'$G(DGENRIEN)
Q:'$G(STATUS)
;
N DFN
S DFN=$P($G(^DGEN(27.11,DGENRIEN,0)),"^",2)
Q:'DFN
I $$FINDCUR^DGENA(DFN)=DGENRIEN D
. S ^DPT("AENRC",STATUS,DFN)=""
;
Q
;
KILL2(DGENRIEN,STATUS) ;
;Description: This is the kill logic that corresponds to SET2.
;Inputs:
; DGENRIEN - enrollment ien
; STATUS - the enrollment status
;
Q:'$G(DGENRIEN)
Q:'$G(STATUS)
;
N DFN
S DFN=$P($G(^DGEN(27.11,DGENRIEN,0)),"^",2)
Q:'DFN
I $$FINDCUR^DGENA(DFN)=DGENRIEN D
. K ^DPT("AENRC",STATUS,DFN)
Q
;
SETREM(DGENRIEN,STATUS) ;
; DG*5.3*1111 - All ENROLLMENT STATUS (file #27.15) entries of REJECTED renamed to DEFERRED.
; The comments and code below are modified to reflect this.
;This set logic is called by the Enrollment Status field (#.04) in
;the Patient Enrollment file (#27.11). If the Enrollment Status
;contains the word DEFERRED, then "**DEFERRED**" will be stuffed
;into the Remarks field (#.091) of the Patient file (#2). If the
;Enrollment Status does not contain DEFERRED, then the word
;"**DEFERRED**" will be removed.
;Input:
; DGENRIEN - IEN of the enrollment record
; STATUS - enrollment status
;
Q:'$G(DGENRIEN)
Q:'$G(STATUS)
;
N DFN,REM
S DFN=$P($G(^DGEN(27.11,DGENRIEN,0)),U,2)
Q:'DFN Q:$G(^DPT(DFN,0))=""
L +^DPT(DFN,0):5 I '$T Q
S REM=$P(^DPT(DFN,0),U,10)
;The enrollment status contains DEFERRED, set REMARKS
I "^11^12^13^14^22^"[(U_STATUS_U) D G SETREMQ
. I REM["**DEFERRED**" Q ;Remarks already contain REJECTED
. S REM=REM_"**DEFERRED**"
. S $P(^DPT(DFN,0),U,10)=REM
;The enrollment status does not contain DEFERRED, remove REMARKS
I REM'["**DEFERRED**" G SETREMQ
S REM=$P(REM,"**DEFERRED**",1)_$P(REM,"**DEFERRED**",2,99)
S $P(^DPT(DFN,0),U,10)=REM
SETREMQ L -^DPT(DFN,0)
Q
;
CSI1010(DA) ;
;If COMBAT SERVICE INDICATED? (2/.5291) is "NO,"
;set COMBAT INDICATED ON 1010EZ (2/1010.157) to "NO."
I $P($G(^DPT(DA,.52)),U,11)="N" D
. N DGFDA
. S DGFDA(2,DA_",",1010.157)=0
. D FILE^DIE(,"DGFDA")
Q
;
CTD1010(DA) ;
;If COMBAT SERVICE INDICATED? (2/.5291) is "YES" and
;COMBAT TO DATE (2/.5294) is greater than 11/11/1998,
;set COMBAT INDICATED ON 1010EZ (2/1010.157) to "YES."
N NODE,ANS,DGFDA
S NODE=$G(^DPT(DA,.52)),ANS=0
I ($P(NODE,U,11)="Y"),($P(NODE,U,14)>2981111) S ANS=1
S DGFDA(2,DA_",",1010.157)=ANS
D FILE^DIE(,"DGFDA")
Q
ENRAPP ;check to see if the Enrollment Application Date (.01 of file 27.11)
;is before 10/1/1996 or before DOB or after DOD
N DGFLD
S DGFLD=$P(^DD(27.11,.01,0),U)
I $G(X)<2961001 D EN^DDIOL(DGFLD_" must not be before 10/1/1996.",,"!!!") K X Q
; DG*5.3*1015;jam ; quit if DFN not defined
Q:'$G(DFN)
I $G(X)<$P(^DPT(DFN,0),U,3) D EN^DDIOL(DGFLD_" cannot be before Date of Birth.") K X Q
I $P($G(^DPT(DFN,.35)),U)>0,($G(X)>$P(^DPT(DFN,.35),U)) D
. D EN^DDIOL(DGFLD_" cannot be after Date of Death.") K X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENDD 3890 printed Nov 22, 2024@17:52:34 Page 2
DGENDD ;ALB/CJM,JAN,LBD,AMA,ERC,JAM - Enrollment Data Dictionary Functions; 13 JUN 1997;6-28-01 ;5/8/07 11:28am
+1 ;;5.3;Registration;**121,351,503,733,754,1015,1111**;Aug 13,1993;Build 18
+2 ;
SET1(DFN,DGENRIEN) ;
+1 ;Description: sets the "AENRC" X-ref on the patient file
+2 ;Inputs:
+3 ; DFN - the patient ien
+4 ; DGENRIEN - ien of current enrollment
+5 ;
+6 if '$GET(DGENRIEN)
QUIT
+7 if '$GET(DFN)
QUIT
+8 ;
+9 NEW STATUS
+10 SET STATUS=$PIECE($GET(^DGEN(27.11,DGENRIEN,0)),"^",4)
+11 if STATUS
SET ^DPT("AENRC",STATUS,DFN)=""
+12 ;
+13 QUIT
+14 ;
KILL1(DFN) ;
+1 ;Description: This is the kill logic that corresponds to SET1.
+2 ;Input: DFN is the patient ien
+3 ;
+4 if '$GET(DFN)
QUIT
+5 ;
+6 NEW DGSTATUS,STATUS
+7 SET DGSTATUS=$PIECE(^DGEN(27.15,0),U,3)
+8 FOR STATUS=1:1:DGSTATUS
KILL ^DPT("AENRC",STATUS,DFN)
+9 QUIT
+10 ;
SET2(DGENRIEN,STATUS) ;
+1 ;Description: This MUMPS x-ref on the Patient Enrollment file sets the
+2 ; "AENRC" X-ref on the patient file.
+3 ;Inputs:
+4 ; DGENRIEN - enrollment ien
+5 ; STATUS - the enrollment status
+6 ;
+7 if '$GET(DGENRIEN)
QUIT
+8 if '$GET(STATUS)
QUIT
+9 ;
+10 NEW DFN
+11 SET DFN=$PIECE($GET(^DGEN(27.11,DGENRIEN,0)),"^",2)
+12 if 'DFN
QUIT
+13 IF $$FINDCUR^DGENA(DFN)=DGENRIEN
Begin DoDot:1
+14 SET ^DPT("AENRC",STATUS,DFN)=""
End DoDot:1
+15 ;
+16 QUIT
+17 ;
KILL2(DGENRIEN,STATUS) ;
+1 ;Description: This is the kill logic that corresponds to SET2.
+2 ;Inputs:
+3 ; DGENRIEN - enrollment ien
+4 ; STATUS - the enrollment status
+5 ;
+6 if '$GET(DGENRIEN)
QUIT
+7 if '$GET(STATUS)
QUIT
+8 ;
+9 NEW DFN
+10 SET DFN=$PIECE($GET(^DGEN(27.11,DGENRIEN,0)),"^",2)
+11 if 'DFN
QUIT
+12 IF $$FINDCUR^DGENA(DFN)=DGENRIEN
Begin DoDot:1
+13 KILL ^DPT("AENRC",STATUS,DFN)
End DoDot:1
+14 QUIT
+15 ;
SETREM(DGENRIEN,STATUS) ;
+1 ; DG*5.3*1111 - All ENROLLMENT STATUS (file #27.15) entries of REJECTED renamed to DEFERRED.
+2 ; The comments and code below are modified to reflect this.
+3 ;This set logic is called by the Enrollment Status field (#.04) in
+4 ;the Patient Enrollment file (#27.11). If the Enrollment Status
+5 ;contains the word DEFERRED, then "**DEFERRED**" will be stuffed
+6 ;into the Remarks field (#.091) of the Patient file (#2). If the
+7 ;Enrollment Status does not contain DEFERRED, then the word
+8 ;"**DEFERRED**" will be removed.
+9 ;Input:
+10 ; DGENRIEN - IEN of the enrollment record
+11 ; STATUS - enrollment status
+12 ;
+13 if '$GET(DGENRIEN)
QUIT
+14 if '$GET(STATUS)
QUIT
+15 ;
+16 NEW DFN,REM
+17 SET DFN=$PIECE($GET(^DGEN(27.11,DGENRIEN,0)),U,2)
+18 if 'DFN
QUIT
if $GET(^DPT(DFN,0))=""
QUIT
+19 LOCK +^DPT(DFN,0):5
IF '$TEST
QUIT
+20 SET REM=$PIECE(^DPT(DFN,0),U,10)
+21 ;The enrollment status contains DEFERRED, set REMARKS
+22 IF "^11^12^13^14^22^"[(U_STATUS_U)
Begin DoDot:1
+23 ;Remarks already contain REJECTED
IF REM["**DEFERRED**"
QUIT
+24 SET REM=REM_"**DEFERRED**"
+25 SET $PIECE(^DPT(DFN,0),U,10)=REM
End DoDot:1
GOTO SETREMQ
+26 ;The enrollment status does not contain DEFERRED, remove REMARKS
+27 IF REM'["**DEFERRED**"
GOTO SETREMQ
+28 SET REM=$PIECE(REM,"**DEFERRED**",1)_$PIECE(REM,"**DEFERRED**",2,99)
+29 SET $PIECE(^DPT(DFN,0),U,10)=REM
SETREMQ LOCK -^DPT(DFN,0)
+1 QUIT
+2 ;
CSI1010(DA) ;
+1 ;If COMBAT SERVICE INDICATED? (2/.5291) is "NO,"
+2 ;set COMBAT INDICATED ON 1010EZ (2/1010.157) to "NO."
+3 IF $PIECE($GET(^DPT(DA,.52)),U,11)="N"
Begin DoDot:1
+4 NEW DGFDA
+5 SET DGFDA(2,DA_",",1010.157)=0
+6 DO FILE^DIE(,"DGFDA")
End DoDot:1
+7 QUIT
+8 ;
CTD1010(DA) ;
+1 ;If COMBAT SERVICE INDICATED? (2/.5291) is "YES" and
+2 ;COMBAT TO DATE (2/.5294) is greater than 11/11/1998,
+3 ;set COMBAT INDICATED ON 1010EZ (2/1010.157) to "YES."
+4 NEW NODE,ANS,DGFDA
+5 SET NODE=$GET(^DPT(DA,.52))
SET ANS=0
+6 IF ($PIECE(NODE,U,11)="Y")
IF ($PIECE(NODE,U,14)>2981111)
SET ANS=1
+7 SET DGFDA(2,DA_",",1010.157)=ANS
+8 DO FILE^DIE(,"DGFDA")
+9 QUIT
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
+2 NEW DGFLD
+3 SET DGFLD=$PIECE(^DD(27.11,.01,0),U)
+4 IF $GET(X)<2961001
DO EN^DDIOL(DGFLD_" must not be before 10/1/1996.",,"!!!")
KILL X
QUIT
+5 ; DG*5.3*1015;jam ; quit if DFN not defined
+6 if '$GET(DFN)
QUIT
+7 IF $GET(X)<$PIECE(^DPT(DFN,0),U,3)
DO EN^DDIOL(DGFLD_" cannot be before Date of Birth.")
KILL X
QUIT
+8 IF $PIECE($GET(^DPT(DFN,.35)),U)>0
IF ($GET(X)>$PIECE(^DPT(DFN,.35),U))
Begin DoDot:1
+9 DO EN^DDIOL(DGFLD_" cannot be after Date of Death.")
KILL X
End DoDot:1
+10 QUIT
