DGDEP0 ;ALB/CAW,JAN,BAJ,ERC - Dependent Driver (con't) ; 8/1/08 1:08pm
;;5.3;Registration;**45,60,395,624,653,688**;Aug 13, 1993;Build 29
;
RETDEP ;Return printable data of dependents
Q:'$D(DGDEP("DGDEP",$J))
N ACT,ACTIVE,CNT,CNTR,DEP,DGII,DGX,EDATE,INCOME,INCPER,MORE,NAME,RELATE
F DGII=0:0 S DGII=$O(DGDEP(DGII)) Q:'DGII K DGDEP(DGII) ; clear dependent array
S RELATE=0,CNT=1
;
F S RELATE=$O(DGDEP("DGDEP",$J,RELATE)) Q:'RELATE D
.;
.S MORE=0
.F S MORE=$O(DGDEP("DGDEP",$J,RELATE,MORE)) Q:'MORE S DEP=DGDEP("DGDEP",$J,RELATE,MORE) D S CNT=CNT+1,DGCNT=CNT-1
..;
..S $P(DGDEP(CNT),U,2)=$P($G(^DG(408.11,RELATE,0)),U)
..S NAME=$P(DEP,U),$P(DGDEP(CNT),U)=$P(DEP,U)
..S $P(DGDEP(CNT),U,3)=$S($P(DEP,U,2)="M":"Male",$P(DEP,U,2)="F":"Female",1:"Unknown"),$P(DGDEP(CNT),U,20)=$P(DEP,U,20)
..S $P(DGDEP(CNT),U,21)=$P(DEP,U,21),$P(DGDEP(CNT),U,22)=$P(DEP,U,22)
..N Y S Y=$P(DEP,U,3) D DD^%DT S $P(DGDEP(CNT),U,4)=Y
..;
..;SSN and SSN Verification status modifications DG*5.3*688 BAJ 11/22/2005
..;format SSN for display
..I $P(DEP,U,9) D
... N T S $P(DGDEP(CNT),U,5)=$E($P(DEP,U,9),1,3)_"-"_$E($P(DEP,U,9),4,5)_"-"_$E($P(DEP,U,9),6,10)
... S T=$P(DEP,U,11)
... S $P(DGDEP(CNT),U,9)=$S(T=4:"VERIFIED",T=2:"INVALID",1:"")
...;set 10th piece to value of Pseudo SSN Reason, if there is one
...;for DG*5.3*653 - ERC
...S $P(DGDEP(CNT),U,10)=$S($P(DEP,U,10)="R":"Refused to Provide",$P(DEP,U,10)="S":"SSN Unknown/Follow-up Required",$P(DEP,U,10)="N":"NO SSN ASSIGNED",1:"")
..;
..S INCOME=$P(DGDEP("DGDEP",$J,RELATE,MORE),U,21)
..S INCPER=$P(DGDEP("DGDEP",$J,RELATE,MORE),U,22)
..I RELATE>1 S DGDEP(CNT,"MNADD")=$$SPDEPADD(INCPER)
..I RELATE=1 D SELF("",NAME,RELATE,"",DGDEP(1),$G(DGMTI),CNT)
..S ACT=$O(DGDEP("DGDEP",$J,RELATE,MORE,"")) Q:'ACT S ACT=DGDEP("DGDEP",$J,RELATE,MORE,+ACT)
..I RELATE=1 D SELF(INCPER,NAME,RELATE,ACT,DGDEP(1),$G(DGMTI),CNT)
..I RELATE=2 D DEP(INCPER,NAME,RELATE,ACT,DGDEP(CNT),$G(DGMTI),$G(DGMTACT),CNT)
..I RELATE>2 D DEP(INCPER,NAME,RELATE,ACT,DGDEP(CNT),$G(DGMTI),$G(DGMTACT),CNT)
..S EDATE="",CNTR=0
..F S EDATE=$O(DGDEP("DGDEP",$J,RELATE,MORE,EDATE)) Q:EDATE']"" S ACTIVE=DGDEP("DGDEP",$J,RELATE,MORE,EDATE) D
...;
...N Y S Y=+ACTIVE D DD^%DT S DGDEP(CNT,EDATE)=Y
...S $P(DGDEP(CNT,EDATE),U,2)=$S($P(ACTIVE,U,2)=1:"Active",1:"Inactive")
...S $P(DGDEP(CNT,EDATE),U,3)=$P(ACTIVE,U,3)
K DGDEP("DGDEP",$J)
Q
;
SELF(INCPER,NAME,RELATE,ACT,DGDEP,DGMTI,CNT) ;
I $G(DGMTI),$G(DGMTACT)="VEW" G SELFQ
I $G(DGMTI) D ADD^DGDEP2(DFN,DGDEP,DGMTI)
SELFQ I INCPER>0 D SELF^DGDEP3(INCPER,NAME,RELATE,ACT,$G(DGMTI),CNT)
Q
;
DEP(INCPER,NAME,RELATE,ACT,DGDEP,DGMTI,DGMTACT,CNT) ;
;
I $G(DGMTI),$G(DGMTACT)="VEW" G DEP1
I $G(DGMTI),$P(ACT,U,2),$G(DGMTACT)="ADD",'$G(DGREMOVE) D ADD^DGDEP2(DFN,DGDEP,DGMTI)
DEP1 I RELATE=2 D SELF^DGDEP3(INCPER,NAME,RELATE,ACT,$G(DGMTI),CNT) G DEPQ
I INCPER>0 D CHILD^DGDEP3(INCPER,NAME,RELATE,ACT,$G(DGMTI),$G(DGMTACT),CNT)
DEPQ Q
;
SPDEPADD(INCPER) ;Return Spouse/Dependent Maiden Name and Address info
N ADDCKVAL,INDAIIEN,PRIEN,IPIEN,SPDEPINF
S INDAIIEN=$P($G(^DGMT(408.22,INCPER,0)),"^",2)
S PRIEN=$P($G(^DGMT(408.21,INDAIIEN,0)),"^",2)
S IPIEN=$P($G(^DGPR(408.12,PRIEN,0)),"^",3)
I IPIEN["DGPR(408.13" DO
. S IPIEN=$P(IPIEN,";",1)
. S SPDEPINF=$P($G(^DGPR(408.13,IPIEN,1)),"^",1,8)
Q SPDEPINF
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGDEP0 3370 printed Dec 13, 2024@02:41:53 Page 2
DGDEP0 ;ALB/CAW,JAN,BAJ,ERC - Dependent Driver (con't) ; 8/1/08 1:08pm
+1 ;;5.3;Registration;**45,60,395,624,653,688**;Aug 13, 1993;Build 29
+2 ;
RETDEP ;Return printable data of dependents
+1 if '$DATA(DGDEP("DGDEP",$JOB))
QUIT
+2 NEW ACT,ACTIVE,CNT,CNTR,DEP,DGII,DGX,EDATE,INCOME,INCPER,MORE,NAME,RELATE
+3 ; clear dependent array
FOR DGII=0:0
SET DGII=$ORDER(DGDEP(DGII))
if 'DGII
QUIT
KILL DGDEP(DGII)
+4 SET RELATE=0
SET CNT=1
+5 ;
+6 FOR
SET RELATE=$ORDER(DGDEP("DGDEP",$JOB,RELATE))
if 'RELATE
QUIT
Begin DoDot:1
+7 ;
+8 SET MORE=0
+9 FOR
SET MORE=$ORDER(DGDEP("DGDEP",$JOB,RELATE,MORE))
if 'MORE
QUIT
SET DEP=DGDEP("DGDEP",$JOB,RELATE,MORE)
Begin DoDot:2
+10 ;
+11 SET $PIECE(DGDEP(CNT),U,2)=$PIECE($GET(^DG(408.11,RELATE,0)),U)
+12 SET NAME=$PIECE(DEP,U)
SET $PIECE(DGDEP(CNT),U)=$PIECE(DEP,U)
+13 SET $PIECE(DGDEP(CNT),U,3)=$SELECT($PIECE(DEP,U,2)="M":"Male",$PIECE(DEP,U,2)="F":"Female",1:"Unknown")
SET $PIECE(DGDEP(CNT),U,20)=$PIECE(DEP,U,20)
+14 SET $PIECE(DGDEP(CNT),U,21)=$PIECE(DEP,U,21)
SET $PIECE(DGDEP(CNT),U,22)=$PIECE(DEP,U,22)
+15 NEW Y
SET Y=$PIECE(DEP,U,3)
DO DD^%DT
SET $PIECE(DGDEP(CNT),U,4)=Y
+16 ;
+17 ;SSN and SSN Verification status modifications DG*5.3*688 BAJ 11/22/2005
+18 ;format SSN for display
+19 IF $PIECE(DEP,U,9)
Begin DoDot:3
+20 NEW T
SET $PIECE(DGDEP(CNT),U,5)=$EXTRACT($PIECE(DEP,U,9),1,3)_"-"_$EXTRACT($PIECE(DEP,U,9),4,5)_"-"_$EXTRACT($PIECE(DEP,U,9),6,10)
+21 SET T=$PIECE(DEP,U,11)
+22 SET $PIECE(DGDEP(CNT),U,9)=$SELECT(T=4:"VERIFIED",T=2:"INVALID",1:"")
+23 ;set 10th piece to value of Pseudo SSN Reason, if there is one
+24 ;for DG*5.3*653 - ERC
+25 SET $PIECE(DGDEP(CNT),U,10)=$SELECT($PIECE(DEP,U,10)="R":"Refused to Provide",$PIECE(DEP,U,10)="S":"SSN Unknown/Follow-up Required",$PIECE(DEP,U,10)="N":"NO SSN ASSIGNED",1:"")
End DoDot:3
+26 ;
+27 SET INCOME=$PIECE(DGDEP("DGDEP",$JOB,RELATE,MORE),U,21)
+28 SET INCPER=$PIECE(DGDEP("DGDEP",$JOB,RELATE,MORE),U,22)
+29 IF RELATE>1
SET DGDEP(CNT,"MNADD")=$$SPDEPADD(INCPER)
+30 IF RELATE=1
DO SELF("",NAME,RELATE,"",DGDEP(1),$GET(DGMTI),CNT)
+31 SET ACT=$ORDER(DGDEP("DGDEP",$JOB,RELATE,MORE,""))
if 'ACT
QUIT
SET ACT=DGDEP("DGDEP",$JOB,RELATE,MORE,+ACT)
+32 IF RELATE=1
DO SELF(INCPER,NAME,RELATE,ACT,DGDEP(1),$GET(DGMTI),CNT)
+33 IF RELATE=2
DO DEP(INCPER,NAME,RELATE,ACT,DGDEP(CNT),$GET(DGMTI),$GET(DGMTACT),CNT)
+34 IF RELATE>2
DO DEP(INCPER,NAME,RELATE,ACT,DGDEP(CNT),$GET(DGMTI),$GET(DGMTACT),CNT)
+35 SET EDATE=""
SET CNTR=0
+36 FOR
SET EDATE=$ORDER(DGDEP("DGDEP",$JOB,RELATE,MORE,EDATE))
if EDATE']""
QUIT
SET ACTIVE=DGDEP("DGDEP",$JOB,RELATE,MORE,EDATE)
Begin DoDot:3
+37 ;
+38 NEW Y
SET Y=+ACTIVE
DO DD^%DT
SET DGDEP(CNT,EDATE)=Y
+39 SET $PIECE(DGDEP(CNT,EDATE),U,2)=$SELECT($PIECE(ACTIVE,U,2)=1:"Active",1:"Inactive")
+40 SET $PIECE(DGDEP(CNT,EDATE),U,3)=$PIECE(ACTIVE,U,3)
End DoDot:3
End DoDot:2
SET CNT=CNT+1
SET DGCNT=CNT-1
End DoDot:1
+41 KILL DGDEP("DGDEP",$JOB)
+42 QUIT
+43 ;
SELF(INCPER,NAME,RELATE,ACT,DGDEP,DGMTI,CNT) ;
+1 IF $GET(DGMTI)
IF $GET(DGMTACT)="VEW"
GOTO SELFQ
+2 IF $GET(DGMTI)
DO ADD^DGDEP2(DFN,DGDEP,DGMTI)
SELFQ IF INCPER>0
DO SELF^DGDEP3(INCPER,NAME,RELATE,ACT,$GET(DGMTI),CNT)
+1 QUIT
+2 ;
DEP(INCPER,NAME,RELATE,ACT,DGDEP,DGMTI,DGMTACT,CNT) ;
+1 ;
+2 IF $GET(DGMTI)
IF $GET(DGMTACT)="VEW"
GOTO DEP1
+3 IF $GET(DGMTI)
IF $PIECE(ACT,U,2)
IF $GET(DGMTACT)="ADD"
IF '$GET(DGREMOVE)
DO ADD^DGDEP2(DFN,DGDEP,DGMTI)
DEP1 IF RELATE=2
DO SELF^DGDEP3(INCPER,NAME,RELATE,ACT,$GET(DGMTI),CNT)
GOTO DEPQ
+1 IF INCPER>0
DO CHILD^DGDEP3(INCPER,NAME,RELATE,ACT,$GET(DGMTI),$GET(DGMTACT),CNT)
DEPQ QUIT
+1 ;
SPDEPADD(INCPER) ;Return Spouse/Dependent Maiden Name and Address info
+1 NEW ADDCKVAL,INDAIIEN,PRIEN,IPIEN,SPDEPINF
+2 SET INDAIIEN=$PIECE($GET(^DGMT(408.22,INCPER,0)),"^",2)
+3 SET PRIEN=$PIECE($GET(^DGMT(408.21,INDAIIEN,0)),"^",2)
+4 SET IPIEN=$PIECE($GET(^DGPR(408.12,PRIEN,0)),"^",3)
+5 IF IPIEN["DGPR(408.13"
Begin DoDot:1
+6 SET IPIEN=$PIECE(IPIEN,";",1)
+7 SET SPDEPINF=$PIECE($GET(^DGPR(408.13,IPIEN,1)),"^",1,8)
End DoDot:1
+8 QUIT SPDEPINF
