DGREGG ;ALB/MRL,LBD - CONTINUATION OF REGISTRATION PROCESS ; 3/10/11 4:32pm
;;5.3;Registration;**565,797**;Aug 13, 1993;Build 24
N DEF,DGDISTYP,DGSED,Y
S DEF=0 W !! I $D(^DPT(DFN,.15))#10,$P(^(.15),"^",2)?7N W !,"Patient is ineligible for benefits." S DEF(1)=1,DEF=1
;Get Military Service Data (DG*5.3*797)
D GETMSE
I DGDISTYP>1&(DGDISTYP<9) W $S($D(DEF)\10:", He",1:"Patient") W:$X>70 ! W " did not receive an honorable discharge." S DEF(3)=1,DEF=1
I DEF W !!
S Y=0 F I=1:1:3 I $G(DGSED(I)) S:(DGSED(I)'<2800908) Y=DGSED(I) I DGSED(I)<2800908 S Y=0 Q
I Y D
.X ^DD("DD") W !,"Entered Service ",Y
.W !,"Veteran must have completed at least 24 consecutive months of active"
.W !,"military service. If veteran meets an exception to minimum duty requirements"
.W !,"as listed on www.domain.ext/elig, veteran is eligible for VA health care."
.W !,"Otherwise, enter Ineligible Date and Reason on Screen 10 -- veteran is"
.W !,"eligible for care of SC conditions only.",!
.K A
Q
;
GETMSE ;Get Last Discharge Type and Service Entry Dates (DG*5.3*797)
N DGMSE,I,J
;Get MSE data from MSE sub-file #2.3216, if it exists
I $D(^DPT(DFN,.3216)) D Q
.D GETMSE^DGMSEUTL(DFN,.DGMSE)
.S DGDISTYP=$P($G(DGMSE(1)),U,6)
.F I=1:1:3 S DGSED(I)=$P($G(DGMSE(I)),U)
;otherwise, get MSE data from .32 node
S DGMSE=$G(^DPT(DFN,.32))
S DGDISTYP=$P(DGMSE,U,4)
F I=1:1:3 S J=5*I+1,DGSED(I)=$P(DGMSE,U,J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGREGG 1436 printed Oct 16, 2024@18:55:36 Page 2
DGREGG ;ALB/MRL,LBD - CONTINUATION OF REGISTRATION PROCESS ; 3/10/11 4:32pm
+1 ;;5.3;Registration;**565,797**;Aug 13, 1993;Build 24
+2 NEW DEF,DGDISTYP,DGSED,Y
+3 SET DEF=0
WRITE !!
IF $DATA(^DPT(DFN,.15))#10
IF $PIECE(^(.15),"^",2)?7N
WRITE !,"Patient is ineligible for benefits."
SET DEF(1)=1
SET DEF=1
+4 ;Get Military Service Data (DG*5.3*797)
+5 DO GETMSE
+6 IF DGDISTYP>1&(DGDISTYP<9)
WRITE $SELECT($DATA(DEF)\10:", He",1:"Patient")
if $X>70
WRITE !
WRITE " did not receive an honorable discharge."
SET DEF(3)=1
SET DEF=1
+7 IF DEF
WRITE !!
+8 SET Y=0
FOR I=1:1:3
IF $GET(DGSED(I))
if (DGSED(I)'<2800908)
SET Y=DGSED(I)
IF DGSED(I)<2800908
SET Y=0
QUIT
+9 IF Y
Begin DoDot:1
+10 XECUTE ^DD("DD")
WRITE !,"Entered Service ",Y
+11 WRITE !,"Veteran must have completed at least 24 consecutive months of active"
+12 WRITE !,"military service. If veteran meets an exception to minimum duty requirements"
+13 WRITE !,"as listed on www.domain.ext/elig, veteran is eligible for VA health care."
+14 WRITE !,"Otherwise, enter Ineligible Date and Reason on Screen 10 -- veteran is"
+15 WRITE !,"eligible for care of SC conditions only.",!
+16 KILL A
End DoDot:1
+17 QUIT
+18 ;
GETMSE ;Get Last Discharge Type and Service Entry Dates (DG*5.3*797)
+1 NEW DGMSE,I,J
+2 ;Get MSE data from MSE sub-file #2.3216, if it exists
+3 IF $DATA(^DPT(DFN,.3216))
Begin DoDot:1
+4 DO GETMSE^DGMSEUTL(DFN,.DGMSE)
+5 SET DGDISTYP=$PIECE($GET(DGMSE(1)),U,6)
+6 FOR I=1:1:3
SET DGSED(I)=$PIECE($GET(DGMSE(I)),U)
End DoDot:1
QUIT
+7 ;otherwise, get MSE data from .32 node
+8 SET DGMSE=$GET(^DPT(DFN,.32))
+9 SET DGDISTYP=$PIECE(DGMSE,U,4)
+10 FOR I=1:1:3
SET J=5*I+1
SET DGSED(I)=$PIECE(DGMSE,U,J)
+11 QUIT
