source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECDEP.m@ 901

Last change on this file since 901 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1EASECDEP ;ALB/LBD Dependent Driver ;18 AUG 2001
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5**;Mar 15, 2001
3 ;This routine was modified from DGDEP for LTC Co-pay
4EN ;
5 S VALMBCK=""
6 D WAIT^DICD,EN^VALM("EASEC DEPENDENTS")
7 S VALMBCK="R"
8ENQ K DEP,DGCNT,DGDEP,DGIR0,DGINI,DGLN,DGPRI,DGREL,^TMP("DGDEP",$J)
9 Q
10 ;
11PAT ; Patient Lookup
12 N DIC,Y
13 S DIC="^DPT(",DIC(0)="AEMQZ" D ^DIC I Y'>0 G PATQ
14 I ($G(DTOUT)!$G(DUOUT)) G PATQ
15 S DFN=+Y
16PATQ Q
17 ;
18HDR ; Header
19 N VA,VAERR
20 D PID^VADPT
21 S X="",VALMHDR(1)=" MARITAL STATUS/DEPENDENTS, SCREEN <3>"
22 S VALMHDR(2)=$E($P("Patient: "_$G(^DPT(DFN,0)),"^",1),1,30)_" ("_VA("PID")_")"
23 S X=$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient")
24 S VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),80-$L(X),$L(X))
25HDRQ Q
26 ;
27INIT ; Find all dependents
28 K DGDEP("DGDEP",$J),^TMP("DGDEP",$J)
29 N CNT,DGDATE,DGDDEP0,DGINCP,DGINI,DGIRI,DGWHERE
30 D NEW^EASECED1 ; Sets up veteran in person file
31 ; Get all active dependents
32 D ALL^EASECU21(DFN,"VSD",$S($G(DGMTDT):DGMTDT,1:DT),"IPR",$G(DGMTI))
33 ;
34 ; Get all dependents active and inactive
35 S (CNT,DGDEP)=0,DGLN=1
36 F S DGDEP=$O(^DGPR(408.12,"B",DFN,DGDEP)) Q:'DGDEP D
37 .N DGDEP0 S CNT=CNT+1
38 .S DGDEP0=^DGPR(408.12,DGDEP,0)
39 .D GETIENS^EASECU2(DFN,+DGDEP,$S($G(DGMTDT):DGMTDT,1:DT)) ;Get Annual Income IEN and Income Person IEN
40 .S DGWHERE=$P(DGDEP0,U,3)
41 .S DGINCP=$G(@("^"_$P(DGWHERE,";",2)_+DGWHERE_",0)"))
42 .S DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT)=DGINCP
43 .S $P(DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT),U,20)=DGDEP
44 .S $P(DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT),U,21)=$S($G(DGINI):DGINI,1:$G(DGINC))
45 .S $P(DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT),U,22)=$S($G(DGIRI):DGIRI,1:$G(DGINR))
46 .N DGEDATE S DGEDATE=0
47 .F S DGEDATE=$O(^DGPR(408.12,DGDEP,"E",DGEDATE)) Q:'DGEDATE D
48 ..S DGDATE=^DGPR(408.12,DGDEP,"E",DGEDATE,0)
49 ..S DGDEP("DGDEP",$J,$P(DGDEP0,U,2),CNT,-$P(DGDATE,U))=DGDATE
50 D RETDEP^EASECDP0
51 S VALMCNT=DGLN-1
52 Q
53 ;
54SET(X) ; Set in array
55 ;
56 S ^TMP("DGDEP",$J,DGLN,0)=X,^TMP("DGDEP",$J,"IDX",CNT,CNT)=""
57 S DGLN=DGLN+1
58 Q
Note: See TracBrowser for help on using the repository browser.