DGDEP1 ;ALB/CAW,BAJ,ERC - List One Dependent/Edit Effective Dates ; 8/1/08 1:10pm
;;5.3;Registration;**45,60,624,653,688**;Aug 13, 1993;Build 29
;
LSTDEP(DGDEP) ;List Dependents
N DEP,CNT S CNT=0
F S CNT=$O(DGDEP(CNT)) Q:'CNT D ONE(CNT)
Q
;
ONE(CNT) ; List one dependent
; Modified for SSN VERFICIATION STATUS DG*5.3*688 BAJ 11/22/2005
;
N DGLN S DGLN=1
;
S X="",X=$$SETSTR^VALM1("DOB: ",X,5,5)
S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,4),X,10,14)
S X=$$SETSTR^VALM1("Sex: ",X,30,5)
S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,3),X,35,8)
S X=$$SETSTR^VALM1("SSN: ",X,52,5)
S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,5),X,57,14)
; Retrieve SSN VERIFICATION STATUS FROM ARRAY
S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,9),X,71,8)
D SET(X)
;
;* Output Spouse' Maiden Name, if defined (DG*5.3*624)
S X=""
I $P($G(DGDEP(CNT)),U,2)="SPOUSE" DO
. N DGMNTEXT
. S X=$$SETSTR^VALM1("Maiden: ",X,2,8)
. S DGMNTEXT=$P($G(DGDEP(CNT,"MNADD")),U,1)
. S:DGMNTEXT]"" X=$$SETSTR^VALM1(DGMNTEXT,X,10,30)
. S:DGMNTEXT']"" X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
;display PSSN Reason if SSN is a pseudo - DG*5.3*653
I $P($G(DGDEP(CNT)),U,2)'="SELF",($P(DGDEP(CNT),U,5)["P") D
. S X=$$SETSTR^VALM1("PSSN Reason: ",X,44,15)
. I $P(DGDEP(CNT),U,10)["Unk" S $P(DGDEP(CNT),U,10)="SSN Unkn/Follow-up Req"
. S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,10),X,57,22)
D SET(X)
S DEP=""
F S DEP=$O(DGDEP(CNT,DEP)) Q:DEP']"" D
.I DEP'="MNADD" DO
..S X="",X=$$SETSTR^VALM1("Status: ",X,2,8)
..S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U,2),X,10,24)
..S X=$$SETSTR^VALM1("Effective Date: ",X,41,15)
..S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U),X,57,20)
..D SET(X)
..I $P(DGDEP(CNT,DEP),U,3) D
...S X="",X=$$SETSTR^VALM1("Filed by IVM: ",X,43,14)
...S X=$$SETSTR^VALM1("Yes",X,57,20)
...D SET(X)
..D SET("")
S VALMCNT=DGLN-1
;
S X=""
S X=$$SETSTR^VALM1("Address: ",X,1,9)
S:($P($G(DGDEP(CNT,"MNADD")),U,2,7)="^^^^^") X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
S:($P($G(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,2),X,10,35)
S X=$$SETSTR^VALM1("Phone: ",X,50,7)
S:($P($G(DGDEP(CNT,"MNADD")),U,8)="") X=$$SETSTR^VALM1("UNANSWERED",X,57,10)
S:($P($G(DGDEP(CNT,"MNADD")),U,8)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,8),X,57,13)
D SET(X)
;
;* Output dependent address (DG*5.3*624)
I ($P($G(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^") DO
.S X=""
.S:($P($G(DGDEP(CNT,"MNADD")),U,3)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,3),X,10,30)
.S:($P($G(DGDEP(CNT,"MNADD")),U,3)="") X=$$SETSTR^VALM1(" ",X,10,1)
.D SET(X)
.S X=""
.S:($P($G(DGDEP(CNT,"MNADD")),U,4)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,4),X,10,30)
.S:($P($G(DGDEP(CNT,"MNADD")),U,4)="") X=$$SETSTR^VALM1(" ",X,10,1)
.D SET(X)
.S X=""
.I ($P($G(DGDEP(CNT,"MNADD")),U,5)'="") DO
..S X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,5),X,10,30)
..S X=$$SETSTR^VALM1(",",X,($L($P($G(DGDEP(CNT,"MNADD")),U,5))+10),1)
.S:($P($G(DGDEP(CNT,"MNADD")),U,5)="") X=$$SETSTR^VALM1(" ",X,10,1)
.N STATVAL,ZIPPOS
.S STATVAL=""
.I ($P($G(DGDEP(CNT,"MNADD")),U,6)'="") DO
..S STATVAL=$P(^DIC(5,$P($G(DGDEP(CNT,"MNADD")),U,6),0),"^",1)
..S X=$$SETSTR^VALM1(STATVAL,X,($L($P($G(DGDEP(CNT,"MNADD")),U,5))+12),30)
.S:($P($G(DGDEP(CNT,"MNADD")),U,6)="") X=$$SETSTR^VALM1(" ",X,41,1)
.;;D SET(X)
.;;S X=""
.I ($P($G(DGDEP(CNT,"MNADD")),U,7)'="") DO
..S ZIPPOS=($L($P($G(DGDEP(CNT,"MNADD")),U,5))+($L(STATVAL))+14)
..S X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,7),X,ZIPPOS,10)
.S:($P($G(DGDEP(CNT,"MNADD")),U,7)="") X=$$SETSTR^VALM1(" ",X,20,1)
.D SET(X)
;
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 means 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^DGDEP
K ^TMP("DGMTEP",$J) D ONE(DGW)
Q
;
DOB(DA,X) ;CHECK EFFECTIVE DATE AGAINST DOB
N DGFILE,X1,NODE
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 Q X
. W !," <<EFFECTIVE DATE may not precede Date Of Birth>>",*7
. S X=0
;
S NODE=$G(^DGPR(408.12,DA,0))
I ($P(NODE,U,2)>1),(X<$P($G(^DPT(+$P(NODE,U),0)),U,3)) D Q 0
. W !," <<EFFECTIVE DATE may not precede Veteran Date Of Birth>>",$C(7)
;
I $P(NODE,U,2)=2 D I X=0 Q X
. S X1=+$P($G(^DPT(+$P(NODE,U),.35)),U) ;Vet Date Of Death
. I (X1>0),(X>X1) D Q
. . W !," <<EFFECTIVE DATE may not be greater than Veteran Date Of Death>>",$C(7)
. . S X=0
. I '$$ACTIVE^DGMTU11(DA,X) D Q ;Only check inactive spouse
. . W !," <<EFFECTIVE DATE must be a date prior to Spouse Inactivation Date>>",$C(7)
. . S X=0
;
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGDEP1 5720 printed Apr 09, 2024@22:01:57 Page 2
DGDEP1 ;ALB/CAW,BAJ,ERC - List One Dependent/Edit Effective Dates ; 8/1/08 1:10pm
+1 ;;5.3;Registration;**45,60,624,653,688**;Aug 13, 1993;Build 29
+2 ;
LSTDEP(DGDEP) ;List Dependents
+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 ; Modified for SSN VERFICIATION STATUS DG*5.3*688 BAJ 11/22/2005
+2 ;
+3 NEW DGLN
SET DGLN=1
+4 ;
+5 SET X=""
SET X=$$SETSTR^VALM1("DOB: ",X,5,5)
+6 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,4),X,10,14)
+7 SET X=$$SETSTR^VALM1("Sex: ",X,30,5)
+8 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,3),X,35,8)
+9 SET X=$$SETSTR^VALM1("SSN: ",X,52,5)
+10 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,5),X,57,14)
+11 ; Retrieve SSN VERIFICATION STATUS FROM ARRAY
+12 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,9),X,71,8)
+13 DO SET(X)
+14 ;
+15 ;* Output Spouse' Maiden Name, if defined (DG*5.3*624)
+16 SET X=""
+17 IF $PIECE($GET(DGDEP(CNT)),U,2)="SPOUSE"
Begin DoDot:1
+18 NEW DGMNTEXT
+19 SET X=$$SETSTR^VALM1("Maiden: ",X,2,8)
+20 SET DGMNTEXT=$PIECE($GET(DGDEP(CNT,"MNADD")),U,1)
+21 if DGMNTEXT]""
SET X=$$SETSTR^VALM1(DGMNTEXT,X,10,30)
+22 if DGMNTEXT']""
SET X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
End DoDot:1
+23 ;display PSSN Reason if SSN is a pseudo - DG*5.3*653
+24 IF $PIECE($GET(DGDEP(CNT)),U,2)'="SELF"
IF ($PIECE(DGDEP(CNT),U,5)["P")
Begin DoDot:1
+25 SET X=$$SETSTR^VALM1("PSSN Reason: ",X,44,15)
+26 IF $PIECE(DGDEP(CNT),U,10)["Unk"
SET $PIECE(DGDEP(CNT),U,10)="SSN Unkn/Follow-up Req"
+27 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,10),X,57,22)
End DoDot:1
+28 DO SET(X)
+29 SET DEP=""
+30 FOR
SET DEP=$ORDER(DGDEP(CNT,DEP))
if DEP']""
QUIT
Begin DoDot:1
+31 IF DEP'="MNADD"
Begin DoDot:2
+32 SET X=""
SET X=$$SETSTR^VALM1("Status: ",X,2,8)
+33 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT,DEP),U,2),X,10,24)
+34 SET X=$$SETSTR^VALM1("Effective Date: ",X,41,15)
+35 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT,DEP),U),X,57,20)
+36 DO SET(X)
+37 IF $PIECE(DGDEP(CNT,DEP),U,3)
Begin DoDot:3
+38 SET X=""
SET X=$$SETSTR^VALM1("Filed by IVM: ",X,43,14)
+39 SET X=$$SETSTR^VALM1("Yes",X,57,20)
+40 DO SET(X)
End DoDot:3
+41 DO SET("")
End DoDot:2
End DoDot:1
+42 SET VALMCNT=DGLN-1
+43 ;
+44 SET X=""
+45 SET X=$$SETSTR^VALM1("Address: ",X,1,9)
+46 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,2,7)="^^^^^")
SET X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
+47 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^")
SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,2),X,10,35)
+48 SET X=$$SETSTR^VALM1("Phone: ",X,50,7)
+49 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,8)="")
SET X=$$SETSTR^VALM1("UNANSWERED",X,57,10)
+50 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,8)'="")
SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,8),X,57,13)
+51 DO SET(X)
+52 ;
+53 ;* Output dependent address (DG*5.3*624)
+54 IF ($PIECE($GET(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^")
Begin DoDot:1
+55 SET X=""
+56 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,3)'="")
SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,3),X,10,30)
+57 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,3)="")
SET X=$$SETSTR^VALM1(" ",X,10,1)
+58 DO SET(X)
+59 SET X=""
+60 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,4)'="")
SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,4),X,10,30)
+61 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,4)="")
SET X=$$SETSTR^VALM1(" ",X,10,1)
+62 DO SET(X)
+63 SET X=""
+64 IF ($PIECE($GET(DGDEP(CNT,"MNADD")),U,5)'="")
Begin DoDot:2
+65 SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,5),X,10,30)
+66 SET X=$$SETSTR^VALM1(",",X,($LENGTH($PIECE($GET(DGDEP(CNT,"MNADD")),U,5))+10),1)
End DoDot:2
+67 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,5)="")
SET X=$$SETSTR^VALM1(" ",X,10,1)
+68 NEW STATVAL,ZIPPOS
+69 SET STATVAL=""
+70 IF ($PIECE($GET(DGDEP(CNT,"MNADD")),U,6)'="")
Begin DoDot:2
+71 SET STATVAL=$PIECE(^DIC(5,$PIECE($GET(DGDEP(CNT,"MNADD")),U,6),0),"^",1)
+72 SET X=$$SETSTR^VALM1(STATVAL,X,($LENGTH($PIECE($GET(DGDEP(CNT,"MNADD")),U,5))+12),30)
End DoDot:2
+73 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,6)="")
SET X=$$SETSTR^VALM1(" ",X,41,1)
+74 ;;D SET(X)
+75 ;;S X=""
+76 IF ($PIECE($GET(DGDEP(CNT,"MNADD")),U,7)'="")
Begin DoDot:2
+77 SET ZIPPOS=($LENGTH($PIECE($GET(DGDEP(CNT,"MNADD")),U,5))+($LENGTH(STATVAL))+14)
+78 SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,7),X,ZIPPOS,10)
End DoDot:2
+79 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,7)="")
SET X=$$SETSTR^VALM1(" ",X,20,1)
+80 DO SET(X)
End DoDot:1
+81 ;
+82 SET VALMCNT=DGLN-1
+83 QUIT
+84 ;
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 means 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^DGDEP
+1 KILL ^TMP("DGMTEP",$JOB)
DO ONE(DGW)
+2 QUIT
+3 ;
DOB(DA,X) ;CHECK EFFECTIVE DATE AGAINST DOB
+1 NEW DGFILE,X1,NODE
+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>>",*7
+5 SET X=0
End DoDot:1
QUIT X
+6 ;
+7 SET NODE=$GET(^DGPR(408.12,DA,0))
+8 IF ($PIECE(NODE,U,2)>1)
IF (X<$PIECE($GET(^DPT(+$PIECE(NODE,U),0)),U,3))
Begin DoDot:1
+9 WRITE !," <<EFFECTIVE DATE may not precede Veteran Date Of Birth>>",$CHAR(7)
End DoDot:1
QUIT 0
+10 ;
+11 IF $PIECE(NODE,U,2)=2
Begin DoDot:1
+12 ;Vet Date Of Death
SET X1=+$PIECE($GET(^DPT(+$PIECE(NODE,U),.35)),U)
+13 IF (X1>0)
IF (X>X1)
Begin DoDot:2
+14 WRITE !," <<EFFECTIVE DATE may not be greater than Veteran Date Of Death>>",$CHAR(7)
+15 SET X=0
End DoDot:2
QUIT
+16 ;Only check inactive spouse
IF '$$ACTIVE^DGMTU11(DA,X)
Begin DoDot:2
+17 WRITE !," <<EFFECTIVE DATE must be a date prior to Spouse Inactivation Date>>",$CHAR(7)
+18 SET X=0
End DoDot:2
QUIT
End DoDot:1
IF X=0
QUIT X
+19 ;
+20 QUIT X
