- 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
