DGDEP ;ALB/CAW,BAJ - Dependent Driver ; 8/1/08 12:55pm
;;5.3;Registration;**45,688,1015,1016**;Aug 13, 1993;Build 20
;
EN ;
S VALMBCK=""
D WAIT^DICD,EN^VALM("DGMT DEPENDENTS")
S VALMBCK="R"
ENQ K DEP,DGCNT,DGDEP,DGIR0,DGINI,DGLN,DGPRI,DGREL,^TMP("DGDEP",$J)
Q
;
PAT ; Patient Lookup
N DIC,Y
S DIC="^DPT(",DIC(0)="AEMQZ" D ^DIC I Y'>0 G PATQ
I ($G(DTOUT)!$G(DUOUT)) G PATQ
S DFN=+Y
PATQ Q
;
HDR ; Header
N VA,VAERR,SSNV
D PID^VADPT
; Capture and display SSN Verification Status with SSN BAJ DG*5.3*688 11/22/2005
D GETSTAT^DGRP1(.SSNV)
I $G(DGSCR8) D G HDRQ
.S X="",VALMHDR(1)=" FAMILY DEMOGRAPHIC DATA, SCREEN <8>"
.S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),80-$L(X),$L(X))
.S VALMHDR(2)=$E($P("Patient: "_$G(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("PID")_")"_" "_SSNV
.S X=$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
.S VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),80-$L(X),$L(X))
S X="",VALMHDR(1)=" MARITAL STATUS/DEPENDENTS, SCREEN <1>"
S VALMHDR(2)=$E($P("Patient: "_$G(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("PID")_")"_" "_SSNV
S X=$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
S VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),80-$L(X),$L(X))
HDRQ Q
;
INIT ; Find all dependents
K DGDEP("DGDEP",$J),^TMP("DGDEP",$J)
N CNT,DGDATE,DGDDEP0,DGINCP,DGINI,DGIRI,DGWHERE
D NEW^DGRPEIS1 ; Sets up veteran in person file
; Get all active dependents
D ALL^DGMTU21(DFN,"VSD",$S($G(DGMTDT):DGMTDT,1:DT),"IPR",$G(DGMTI))
;
; Get all dependents active and inactive
S (CNT,DGDEP)=0,DGLN=1
F S DGDEP=$O(^DGPR(408.12,"B",DFN,DGDEP)) Q:'DGDEP D
.N DGDEP0 S CNT=CNT+1
.S DGDEP0=^DGPR(408.12,DGDEP,0)
.D GETIENS^DGMTU2(DFN,+DGDEP,$S($G(DGMTDT):DGMTDT,1:DT)) ;Get Annual Income IEN and Income Person IEN
.S DGWHERE=$P(DGDEP0,U,3)
.S DGINCP=$G(@("^"_$P(DGWHERE,";",2)_+DGWHERE_",0)"))
.S DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT)=DGINCP
.S $P(DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT),U,20)=DGDEP
.S $P(DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT),U,21)=$S($G(DGINI):DGINI,1:$G(DGINC))
.S $P(DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT),U,22)=$S($G(DGIRI):DGIRI,1:$G(DGINR))
.N DGEDATE S DGEDATE=0
.F S DGEDATE=$O(^DGPR(408.12,DGDEP,"E",DGEDATE)) Q:'DGEDATE D
..S DGDATE=^DGPR(408.12,DGDEP,"E",DGEDATE,0)
..S DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT,-$P(DGDATE,U))=DGDATE
D RETDEP^DGDEP0
S VALMCNT=DGLN-1
Q
;
SET(X) ; Set in array
;
S ^TMP("DGDEP",$J,DGLN,0)=X,^TMP("DGDEP",$J,"IDX",CNT,CNT)=""
S DGLN=DGLN+1
Q
DGDEP ;ALB/CAW,BAJ - Dependent Driver ; 8/1/08 12:55pm
+1 ;;5.3;Registration;**45,688,1015,1016**;Aug 13, 1993;Build 20
+2 ;
EN ;
+1 SET VALMBCK=""
+2 DO WAIT^DICD
DO EN^VALM("DGMT DEPENDENTS")
+3 SET VALMBCK="R"
ENQ KILL DEP,DGCNT,DGDEP,DGIR0,DGINI,DGLN,DGPRI,DGREL,^TMP("DGDEP",$JOB)
+1 QUIT
+2 ;
PAT ; Patient Lookup
+1 NEW DIC,Y
+2 SET DIC="^DPT("
SET DIC(0)="AEMQZ"
DO ^DIC
IF Y'>0
GOTO PATQ
+3 IF ($GET(DTOUT)!$GET(DUOUT))
GOTO PATQ
+4 SET DFN=+Y
PATQ QUIT
+1 ;
HDR ; Header
+1 NEW VA,VAERR,SSNV
+2 DO PID^VADPT
+3 ; Capture and display SSN Verification Status with SSN BAJ DG*5.3*688 11/22/2005
+4 DO GETSTAT^DGRP1(.SSNV)
+5 IF $GET(DGSCR8)
Begin DoDot:1
+6 SET X=""
SET VALMHDR(1)=" FAMILY DEMOGRAPHIC DATA, SCREEN <8>"
+7 SET VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),80-$LENGTH(X),$LENGTH(X))
+8 SET VALMHDR(2)=$EXTRACT($PIECE("Patient: "_$GET(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("PID")_")"_" "_SSNV
+9 SET X=$SELECT($DATA(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
+10 SET VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),80-$LENGTH(X),$LENGTH(X))
End DoDot:1
GOTO HDRQ
+11 SET X=""
SET VALMHDR(1)=" MARITAL STATUS/DEPENDENTS, SCREEN <1>"
+12 SET VALMHDR(2)=$EXTRACT($PIECE("Patient: "_$GET(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("PID")_")"_" "_SSNV
+13 SET X=$SELECT($DATA(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
+14 SET VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),80-$LENGTH(X),$LENGTH(X))
HDRQ QUIT
+1 ;
INIT ; Find all dependents
+1 KILL DGDEP("DGDEP",$JOB),^TMP("DGDEP",$JOB)
+2 NEW CNT,DGDATE,DGDDEP0,DGINCP,DGINI,DGIRI,DGWHERE
+3 ; Sets up veteran in person file
DO NEW^DGRPEIS1
+4 ; Get all active dependents
+5 DO ALL^DGMTU21(DFN,"VSD",$SELECT($GET(DGMTDT):DGMTDT,1:DT),"IPR",$GET(DGMTI))
+6 ;
+7 ; Get all dependents active and inactive
+8 SET (CNT,DGDEP)=0
SET DGLN=1
+9 FOR
SET DGDEP=$ORDER(^DGPR(408.12,"B",DFN,DGDEP))
IF 'DGDEP
QUIT
Begin DoDot:1
+10 NEW DGDEP0
SET CNT=CNT+1
+11 SET DGDEP0=^DGPR(408.12,DGDEP,0)
+12 ;Get Annual Income IEN and Income Person IEN
DO GETIENS^DGMTU2(DFN,+DGDEP,$SELECT($GET(DGMTDT):DGMTDT,1:DT))
+13 SET DGWHERE=$PIECE(DGDEP0,U,3)
+14 SET DGINCP=$GET(@("^"_$PIECE(DGWHERE,";",2)_+DGWHERE_",0)"))
+15 SET DGDEP("DGDEP",$JOB,$PIECE(DGDEP0,U,2),CNT)=DGINCP
+16 SET $PIECE(DGDEP("DGDEP",$JOB,$PIECE(DGDEP0,U,2),CNT),U,20)=DGDEP
+17 SET $PIECE(DGDEP("DGDEP",$JOB,$PIECE(DGDEP0,U,2),CNT),U,21)=$SELECT($GET(DGINI):DGINI,1:$GET(DGINC))
+18 SET $PIECE(DGDEP("DGDEP",$JOB,$PIECE(DGDEP0,U,2),CNT),U,22)=$SELECT($GET(DGIRI):DGIRI,1:$GET(DGINR))
+19 NEW DGEDATE
SET DGEDATE=0
+20 FOR
SET DGEDATE=$ORDER(^DGPR(408.12,DGDEP,"E",DGEDATE))
IF 'DGEDATE
QUIT
Begin DoDot:2
+21 SET DGDATE=^DGPR(408.12,DGDEP,"E",DGEDATE,0)
+22 SET DGDEP("DGDEP",$JOB,$PIECE(DGDEP0,U,2),CNT,-$PIECE(DGDATE,U))=DGDATE
End DoDot:2
End DoDot:1
+23 DO RETDEP^DGDEP0
+24 SET VALMCNT=DGLN-1
+25 QUIT
+26 ;
SET(X) ; Set in array
+1 ;
+2 SET ^TMP("DGDEP",$JOB,DGLN,0)=X
SET ^TMP("DGDEP",$JOB,"IDX",CNT,CNT)=""
+3 SET DGLN=DGLN+1
+4 QUIT
