EASECDP1 ;ALB/LBD List One Dependent/Edit Effective Dates ;22 AUG 2001
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7**;Mar 15, 2001
;
LSTDEP(DGDEP) ;List Depentdents
N DEP,CNT S CNT=0
F S CNT=$O(DGDEP(CNT)) Q:'CNT D ONE(CNT)
Q
;
ONE(CNT) ; List one dependent
;
N DGLN S DGLN=1
;
S X="",X=$$SETSTR^VALM1("SSN: ",X,4,5)
S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,5),X,9,24)
S X=$$SETSTR^VALM1("Sex: ",X,52,5)
S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,3),X,58,7)
D SET(X)
;
S X="",X=$$SETSTR^VALM1("DOB: ",X,4,5)
S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,4),X,9,24)
D SET(X)
;
S DEP=""
F S DEP=$O(DGDEP(CNT,DEP)) Q:DEP']"" D
.S X="",X=$$SETSTR^VALM1("Status: ",X,1,8)
.S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U,2),X,9,24)
.S X=$$SETSTR^VALM1("Effective Date: ",X,41,16)
.S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U),X,58,20)
.D SET(X)
.D SET("")
S VALMCNT=DGLN-1
Q
;
SET(X) ;Set up array
S ^TMP("DGMTEP",$J,DGLN,0)=X
S DGLN=DGLN+1
Q
;
EXIT ;
K ^TMP("DGMTEP",$J)
Q
;
EN ; Effective Dates
S VALMBCK=""
I $D(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G ENQ
I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G ENQ
D EDIT
I DGW=1 D I $G(DGERR) W !,"Cannot inactivate veteran" K DGERR G EN
.S DATE=$O(DGDEP(1,""))
.S ACTIVE=$P(DGDEP(1,DATE),U,2)
.I ACTIVE="Inactive" S DGERR=1
ENQ S VALMBCK="R"
Q
;
EDIT ; Edit Effective Dates
; values for DGFLG:
; DGFLG = 1 IVM effective date
;
N DA,DR,DIE,DIC,DATE,DGEDIT,DGEE,Y
S DGFLG=0,DGEDIT=1
S DGPR=$S($G(DGW):$P(DGDEP(DGW),U,20),1:$P(DGDEP,U,20))
S DIE="^DGPR(408.12,",DA=DGPR,DR="75"
S DR(2,408.1275)="I $P($G(^DGPR(408.12,DGPR,""E"",DA,0)),U,3) S Y=0,DGFLG=1;S:$P($G(^DGPR(408.12,DGPR,""E"",DA,0)),U,2)']"""" DIE(""NO^"")="""";.01;.02"
D ^DIE
I DGFLG W !!,"Cannot edit date added by IVM." H 2 G EDITQ
S DATE=0,DATE=$O(^DGPR(408.12,$P(DGDEP(DGW),U,20),"E",DATE))
I 'DATE W !!,"There has to be an effective date for this person." H 2 G EDIT
EDITQ K DGDEP,DGFLG D INIT^EASECDEP
K ^TMP("DGMTEP",$J) D ONE(DGW)
Q
;
DOB(DA,X) ;CHECK EFFECTIVE DATE AGAINST DOB
N DGFILE,X1
S DGFILE=$P($G(^DGPR(408.12,DA,0)),U,3),X1=$P(DGFILE,";"),DGFILE=$S(DGFILE["DGPR":"^DGPR(408.13,",1:"^DPT(")
I X<$P($G(@(DGFILE_X1_",0)")),U,3) D
. W !," <<EFFECTIVE DATE may not precede Date Of Birth>>",$C(7)
. S X=0
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECDP1 2387 printed Dec 13, 2024@01:53:53 Page 2
EASECDP1 ;ALB/LBD List One Dependent/Edit Effective Dates ;22 AUG 2001
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7**;Mar 15, 2001
+2 ;
LSTDEP(DGDEP) ;List Depentdents
+1 NEW DEP,CNT
SET CNT=0
+2 FOR
SET CNT=$ORDER(DGDEP(CNT))
if 'CNT
QUIT
DO ONE(CNT)
+3 QUIT
+4 ;
ONE(CNT) ; List one dependent
+1 ;
+2 NEW DGLN
SET DGLN=1
+3 ;
+4 SET X=""
SET X=$$SETSTR^VALM1("SSN: ",X,4,5)
+5 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,5),X,9,24)
+6 SET X=$$SETSTR^VALM1("Sex: ",X,52,5)
+7 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,3),X,58,7)
+8 DO SET(X)
+9 ;
+10 SET X=""
SET X=$$SETSTR^VALM1("DOB: ",X,4,5)
+11 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,4),X,9,24)
+12 DO SET(X)
+13 ;
+14 SET DEP=""
+15 FOR
SET DEP=$ORDER(DGDEP(CNT,DEP))
if DEP']""
QUIT
Begin DoDot:1
+16 SET X=""
SET X=$$SETSTR^VALM1("Status: ",X,1,8)
+17 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT,DEP),U,2),X,9,24)
+18 SET X=$$SETSTR^VALM1("Effective Date: ",X,41,16)
+19 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT,DEP),U),X,58,20)
+20 DO SET(X)
+21 DO SET("")
End DoDot:1
+22 SET VALMCNT=DGLN-1
+23 QUIT
+24 ;
SET(X) ;Set up array
+1 SET ^TMP("DGMTEP",$JOB,DGLN,0)=X
+2 SET DGLN=DGLN+1
+3 QUIT
+4 ;
EXIT ;
+1 KILL ^TMP("DGMTEP",$JOB)
+2 QUIT
+3 ;
EN ; Effective Dates
+1 SET VALMBCK=""
+2 IF $DATA(DGMTI)
IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a LTC copay test."
HANG 2
GOTO ENQ
+3 IF '$DATA(DGMTI)
IF $GET(DGRPV)=1
WRITE !,"Not while viewing"
HANG 2
GOTO ENQ
+4 DO EDIT
+5 IF DGW=1
Begin DoDot:1
+6 SET DATE=$ORDER(DGDEP(1,""))
+7 SET ACTIVE=$PIECE(DGDEP(1,DATE),U,2)
+8 IF ACTIVE="Inactive"
SET DGERR=1
End DoDot:1
IF $GET(DGERR)
WRITE !,"Cannot inactivate veteran"
KILL DGERR
GOTO EN
ENQ SET VALMBCK="R"
+1 QUIT
+2 ;
EDIT ; Edit Effective Dates
+1 ; values for DGFLG:
+2 ; DGFLG = 1 IVM effective date
+3 ;
+4 NEW DA,DR,DIE,DIC,DATE,DGEDIT,DGEE,Y
+5 SET DGFLG=0
SET DGEDIT=1
+6 SET DGPR=$SELECT($GET(DGW):$PIECE(DGDEP(DGW),U,20),1:$PIECE(DGDEP,U,20))
+7 SET DIE="^DGPR(408.12,"
SET DA=DGPR
SET DR="75"
+8 SET DR(2,408.1275)="I $P($G(^DGPR(408.12,DGPR,""E"",DA,0)),U,3) S Y=0,DGFLG=1;S:$P($G(^DGPR(408.12,DGPR,""E"",DA,0)),U,2)']"""" DIE(""NO^"")="""";.01;.02"
+9 DO ^DIE
+10 IF DGFLG
WRITE !!,"Cannot edit date added by IVM."
HANG 2
GOTO EDITQ
+11 SET DATE=0
SET DATE=$ORDER(^DGPR(408.12,$PIECE(DGDEP(DGW),U,20),"E",DATE))
+12 IF 'DATE
WRITE !!,"There has to be an effective date for this person."
HANG 2
GOTO EDIT
EDITQ KILL DGDEP,DGFLG
DO INIT^EASECDEP
+1 KILL ^TMP("DGMTEP",$JOB)
DO ONE(DGW)
+2 QUIT
+3 ;
DOB(DA,X) ;CHECK EFFECTIVE DATE AGAINST DOB
+1 NEW DGFILE,X1
+2 SET DGFILE=$PIECE($GET(^DGPR(408.12,DA,0)),U,3)
SET X1=$PIECE(DGFILE,";")
SET DGFILE=$SELECT(DGFILE["DGPR":"^DGPR(408.13,",1:"^DPT(")
+3 IF X<$PIECE($GET(@(DGFILE_X1_",0)")),U,3)
Begin DoDot:1
+4 WRITE !," <<EFFECTIVE DATE may not precede Date Of Birth>>",$CHAR(7)
+5 SET X=0
End DoDot:1
+6 QUIT X
