source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECDP4.m@ 1200

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1EASECDP4 ;ALB/LBD - Dependents Utilities (con't) ;19 AUG 2001
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7**;Mar 15, 2001
3 ; NOTE: This routine was modified from DGDEP4 for LTC Copay
4 ;
5EN ; Spouse Demographics
6 N BEG,CNT,END,FLAG,QUIT,DGERR S CNT=0
7 I $G(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G ENQ
8 I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G ENQ
9 F S CNT=$O(DGDEP(CNT)) Q:'CNT D
10 .I $P(DGDEP(CNT),U,2)="SPOUSE" S FLAG=$G(FLAG)+1
11 I '$G(FLAG) W !,"There is no spouse to choose from." H 2 G ENQ
12 I $G(FLAG)>1 D G:'$G(DGERR) EN1
13 .S BEG=2,END=FLAG+1 D SEL^DGDEPU Q:$G(DGERR)
14 .S DGREL("S")=$P(DGDEP(DGW),U,20)_U_$P(^DGPR(408.12,+$P(DGDEP(DGW),U,20),0),U,3)
15 I $G(DGERR) G ENQ
16 I '$G(DGREL("S")) S DGREL("S")=$P(DGDEP(2),U,20)_U_$P(^DGPR(408.12,+$P(DGDEP(2),U,20),0),U,3)
17EN1 S DGPRI=$P(DGDEP(1),U,20),DGIRI=$P(DGDEP(1),U,22) D SPOUSE1^EASECSC3
18ENQ D INIT^EASECDEP
19 Q
20 ;
21 ;
22ADDEP ; Add a new dependent
23 ;
24 N DGANS
25 S VALMBCK=""
26 I $G(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G ADDEPQ
27 I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G ADDEPQ
28 S DIR(0)="S^S:Spouse;D:Dependent",DIR("A")="Do you want to add (S)pouse or (D)ependent"
29 D ^DIR S DGANS=Y K DIR,Y I DGANS="D",$G(DGMTI) S DGANS="C"
30 I $D(DIRUT) G ADDEPQ
31 D GETREL^DGMTU11(DFN,"S",$S($G(DGMTD):DGMTD,1:DT))
32 I DGANS="S",$G(DGREL("S")) W !,"An active spouse is currently on file. Use the 'ES - Edit Spouse'",!,"action to edit." H 3 G ADDEPQ
33 I DGANS="S",$G(DGMTI) S CNT=0 F S CNT=$O(DGDEP(CNT)) Q:'CNT I $P(DGDEP(CNT),U,2)="SPOUSE" D REMOVE^EASECDP2(DFN,DGDEP(CNT),DGMTI)
34 D CLEAR^VALM1
35 D ADD^EASECED(DFN,DGANS,$S($G(DGMTI):$P(^DGMT(408.31,DGMTI,0),U),1:DT))
36 S PERSON=DGPRI
37 I DGFL=-1!(DGFL=-2) G ADDEPQ
38 D INIT^EASECDEP
39 I $G(DGMTI) D
40 .N CNT
41 .S CNT=0
42 .F S CNT=$O(DGDEP(CNT)) Q:'CNT I $P(DGDEP(CNT),U,20)=PERSON D
43 ..D ADD^EASECDP2(DFN,DGDEP(CNT),DGMTI)
44 ..D EDITD^EASECDP2(DFN,DGDEP(CNT),CNT,DGMTI)
45ADDEPQ S VALMBCK="R"
46 D INIT^EASECDEP
47 K DGFL Q
48 ;
49EDITDEP ; Edit dependent demo
50 ;
51 S VALMBCK=""
52 N DGSAVE1,DGSAVE2,DGMTD,DGBEG,I
53 I $G(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G EDITDEPQ
54 I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G EDITDEPQ
55 S I=0 F S I=$O(DGDEP(I)) Q:'I!($G(DGBEG)) I $P(DGDEP(I),U,2)'="SELF",$P(DGDEP(I),U,2)'="SPOUSE" S DGBEG=I
56 S VALMBCK="",DGSAVE1=VALMBG,DGSAVE2=VALMLST,VALMBG=$S($G(DGBEG):DGBEG,1:0)
57 S VALMLST=DGCNT D SEL^VALM2 S VALMBG=DGSAVE1,VALMLST=DGSAVE2 G EDITDEPQ:'$O(VALMY(0))
58 N CTR S CTR=0 F S CTR=$O(VALMY(CTR)) Q:'CTR D
59 .D EDITC(DFN,DGDEP(CTR),CTR,$G(DGMTI))
60EDITDEPQ S VALMBCK="R"
61 K DGDEP D INIT^EASECDEP
62 Q
63 ;
64EDITC(DFN,DGDEP,DGW,DGMTI) ; Edit
65 N DA,DR,DIE,DGMTDT,DEP,DGSAVE
66 S DGMTDT=$S($G(DGMTI):$P(^DGMT(408.31,+DGMTI,0),U),1:DT)
67 I $G(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G EDITCQ
68 S DEP=$S($G(DGMTI):"C",1:"D"),DGSAVE=DGDEP
69 D GETREL^DGMTU11(DFN,DEP,$S($G(DGMTDT):DGMTDT,1:DT),$G(DGMTI))
70 S DGDEP=DGSAVE
71 N CNTR
72 S CNTR=0
73 F S CNTR=$O(DGREL(DEP,CNTR)) Q:'CNTR I $P(DGDEP,U,20)=+DGREL(DEP,CNTR) D
74 .D EDIT^EASECED(DGREL(DEP,CNTR),DEP)
75EDITCQ ;
76 K ^TMP("DGMTEP",$J)
77 Q
Note: See TracBrowser for help on using the repository browser.