DGENDD ;ALB/CJM,JAN,LBD,AMA,ERC - Enrollment Data Dictionary Functions; 13 JUN 1997;6-28-01 ; 5/8/07 11:28am
;;5.3;PIMS;**121,351,503,733,1015,1016**;JUN 30, 2012;Build 20
;
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) ;
;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 REJECTED, then "**REJECTED**" will be stuffed
;into the Remarks field (#.091) of the Patient file (#2). If the
;Enrollment Status does not contain REJECTED, then the word
;"**REJECTED**" 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 REJECTED, set REMARKS
I "^11^12^13^14^22^"[(U_STATUS_U) D G SETREMQ
. I REM["**REJECTED**" Q ;Remarks already contain REJECTED
. S REM=REM_"**REJECTED**"
. S $P(^DPT(DFN,0),U,10)=REM
;The enrollment status does not contain REJECTED, remove REMARKS
I REM'["**REJECTED**" G SETREMQ
S REM=$P(REM,"**REJECTED**",1)_$P(REM,"**REJECTED**",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
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
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
+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 ;This set logic is called by the Enrollment Status field (#.04) in
+2 ;the Patient Enrollment file (#27.11). If the Enrollment Status
+3 ;contains the word REJECTED, then "**REJECTED**" will be stuffed
+4 ;into the Remarks field (#.091) of the Patient file (#2). If the
+5 ;Enrollment Status does not contain REJECTED, then the word
+6 ;"**REJECTED**" will be removed.
+7 ;Input:
+8 ; DGENRIEN - IEN of the enrollment record
+9 ; STATUS - enrollment status
+10 ;
+11 IF '$GET(DGENRIEN)
QUIT
+12 IF '$GET(STATUS)
QUIT
+13 ;
+14 NEW DFN,REM
+15 SET DFN=$PIECE($GET(^DGEN(27.11,DGENRIEN,0)),U,2)
+16 IF 'DFN
QUIT
IF $GET(^DPT(DFN,0))=""
QUIT
+17 LOCK +^DPT(DFN,0):5
IF '$TEST
QUIT
+18 SET REM=$PIECE(^DPT(DFN,0),U,10)
+19 ;The enrollment status contains REJECTED, set REMARKS
+20 IF "^11^12^13^14^22^"[(U_STATUS_U)
Begin DoDot:1
+21 ;Remarks already contain REJECTED
IF REM["**REJECTED**"
QUIT
+22 SET REM=REM_"**REJECTED**"
+23 SET $PIECE(^DPT(DFN,0),U,10)=REM
End DoDot:1
GOTO SETREMQ
+24 ;The enrollment status does not contain REJECTED, remove REMARKS
+25 IF REM'["**REJECTED**"
GOTO SETREMQ
+26 SET REM=$PIECE(REM,"**REJECTED**",1)_$PIECE(REM,"**REJECTED**",2,99)
+27 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 IF $GET(X)<$PIECE(^DPT(DFN,0),U,3)
DO EN^DDIOL(DGFLD_" cannot be before Date of Birth.")
KILL X
QUIT
+6 IF $PIECE($GET(^DPT(DFN,.35)),U)>0
IF ($GET(X)>$PIECE(^DPT(DFN,.35),U))
Begin DoDot:1
+7 DO EN^DDIOL(DGFLD_" cannot be after Date of Death.")
KILL X
End DoDot:1
+8 QUIT
