source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECED1.m@ 846

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1EASECED1 ;ALB/LBD - CALLS TO ADD NEW PATIENT RELATIONS AND INCOME PERSONS ;18 AUG 2001
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5**;Mar 15, 2001
3 ;NOTE: This routine was modified from DGRPEIS1 for LTC Co-pay
4 ;Adds entries to FILES #408.12 & 408.13
5 ;
6NEW ;check if data in FILE #408.12
7 ;out - DGPRI=IFN of #408.12
8 ; DGFL [-1='^'/-2=time-out]
9 N DGRPDOB,DGRP0ND
10 I '$D(DGTSTDT) N DGTSTDT S DGTSTDT=$S($D(DGMTDT):DGMTDT,1:DT)
11 S DGPRI=$O(^DGPR(408.12,"C",DFN_";DPT(",0)),DGFL=$G(DGFL)
12 I '$D(^DGPR(408.12,+DGPRI,0)) S DGRP0ND=DFN_"^"_1_"^"_DFN_";DPT(",DGRPDOB=$P($G(^DPT(+DFN,0)),"^",3) D NEWPR
13 S DGIRI=$O(^DGMT(408.22,"B",DFN,0))
14 I '$D(^DGMT(408.22,+DGIRI,0)) D GETIENS^EASECU2(DFN,+DGPRI,DGTSTDT)
15 Q
16NEWIP ;Add relation to #408.13 file
17 ; In - DFN=IEN of File #2
18 ; DGRP0ND=0 node of 408.13
19 ;Out - DGIPI=408.13 IEN
20 K DINUM N DGRPDOB,DGSEX,I,X
21 S DGRPDOB=$P(DGRP0ND,"^",3),DGSEX=$P(DGRP0ND,"^",2)
22 S (DIK,DIC)="^DGPR(408.13,",DIC(0)="L",DLAYGO=408.13,X=$P(DGRP0ND,"^",1) K DD,DO D FILE^DICN S (DGIPI,DA)=+Y K DLAYGO
23 L +^DGPR(408.13,+DGIPI) S ^DGPR(408.13,+DGIPI,0)=DGRP0ND D IX1^DIK L -^DGPR(408.13,+DGIPI)
24 S Y=DGIPI,DGRP0ND=DFN_"^"_$S(SPOUSE:2,1:"")_"^"_+Y_";DGPR(408.13,"
25 ;FALLS THRU!
26NEWPR ;Add entry to file #408.12
27 ;In - DGRP0ND=0 node of 408.12
28 ; DGRPDOB=DOB of relation
29 ;Out - DGPRI=IFN of new 408.12 entry
30 K DINUM N DOB,X
31 I '$D(DGTSTDT) N DGTSTDT S DGTSTDT=$S($D(DGMTDT):DGMTDT,1:DT)
32 S DOB=$G(DGRPDOB) I 'DOB S DOB=$E(DGTSTDT,1,3)-1_"0101" ; use dob for effective date...default = Jan 1 of prior year
33DIC I $P(DGRP0ND,"^",2)']"" S DIC="^DG(408.11,",DIC(0)="AEQMZ",DIC("A")="RELATIONSHIP: ",DIC("S")="I Y>2,""E""_DGSEX[$P(^(0),""^"",3),$S(DGTYPE=""D"":1,Y<7:1,1:0)" D ^DIC I '$D(DTOUT),(Y'>0) W $C(7)," Required!!" G DIC
34 I $D(DTOUT) K DTOUT S DGFL=-2 G NEWPRQ
35 I $P(DGRP0ND,"^",2)']"" S $P(DGRP0ND,"^",2)=+Y
36 D ACT^EASECED2 I DGFL<0 D G NEWPRQ
37 .W !?3,$C(7),"Entry incomplete...deleted",!
38 .Q:'$G(DA)!($G(DIK)'="^DGPR(408.13,") ;defined for deps in newip
39 .D ^DIK
40 S (DIK,DIC)="^DGPR(408.12,",DIC(0)="L",DLAYGO=408.12,X=+DGRP0ND K DD,DO D FILE^DICN S DGPRI=+Y K DLAYGO
41 S DA=+DGPRI L +^DGPR(408.12,+DGPRI) S ^DGPR(408.12,+DGPRI,0)=DGRP0ND,^DGPR(408.12,+DGPRI,"E",0)="^408.1275D^1^1",^(1,0)=DGACT_"^"_1 D IX1^DIK L -^DGPR(408.12,+DGPRI)
42 D RESET^DGMTU11(DFN,DGTSTDT,$G(DGMTI))
43 S Y=DGPRI
44NEWPRQ K DGACT,DGSEX,DGRPDOB,DA,DIC,DIK,DIRUT,DTOUT,DUOUT,X,Y
45 Q
46SETUP ; called from SPINACT / sets vars for ASOF tag
47 N FNAME S FNAME=$P($$NAME^DGMTU1(+X),",",2)
48 S ACT=$O(^DGPR(408.12,+X,"E","AID","")),ACT=$O(^(+ACT,0)),ACT=$G(^DGPR(408.12,+X,"E",+ACT,0))
49 I $P(ACT,"^",2)']"" Q ; never active
50 I '$P(ACT,U,2) D Q
51 .W !,"Dependent has been inactivated as of "
52 .S Y=+ACT
53 .D DD^%DT W Y H 3
54 S IEN=+X
55ASOF ;ask as of date
56 N LYR,SPOUSE,DGXDT
57 I '$D(DGTSTDT) N DGTSTDT S DGTSTDT=$S($D(DGMTDT):DGMTDT,1:DT)
58 S SPOUSE=$S($P($G(^DGPR(408.12,+IEN,0)),"^",2)=2:1,1:0)
59 S LYR=$E($$LYR^DGMTSCU1(DGTSTDT),1,3)_1231
60 ;I 'SPOUSE S LYR=$E($$LYR^DGMTSCU1(LYR),1,3)_1231
61 K DIR S DIR(0)="D^"_+ACT_":"_LYR_":AEP",DIR("A")="Date "_FNAME_" no longer a dependent"
62 S DIR("?",1)="Enter the date this person was no longer a dependent of the veteran.",DIR("?",2)="This could include a date of death or the date a child turned 18 for"
63 S DIR("?",3)="children. For a spouse, this would be the date of divorce or date ",DIR("?",4)="of death of the spouse. Date must be after the person became a"
64 S DIR("?",5)="dependent, but prior to 12/31/"_($E(LYR,1,3)+1700)_"."
65 I 'SPOUSE S DIR("?",6)=" ",DIR("?",7)="A person should only be inactivated if the individual was not a",DIR("?",8)="dependent at any time during the prior calendar year."
66 S DIR("?")=" "
67 I SPOUSE S DIR("?",6)=" ",DIR("?",7)="A spouse should be inactivated if the spouse and veteran were not",DIR("?",8)="married as of 12/31/"_($E(LYR,1,3)+1700)_"."
68 D ^DIR K DIR
69 I $D(DTOUT)!$D(DUOUT) S DGFL=$S($D(DTOUT):-2,1:-1) Q
70 S DGXDT=Y
71 I $E(Y,1,3)=$E(LYR,1,3) D Q:'$G(Y)
72 .N DIR,DIRUT,DIROUT,DTOUT,DUOUT
73 .W !!,"Warning: Data will be used if dependent was active at least one day in a"
74 .W !,"year. Data will not be used if inactivation is prior to 1/1/"_($E(LYR,1,3)+1700)_" or it"
75 .W !,"is equal to the activation date."
76 .S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to inactivate this dependent on the selected date?"
77 .D ^DIR
78 S DA(1)=IEN,DIC="^DGPR(408.12,"_DA(1)_",""E"",",X=DGXDT,DIC(0)="L",DLAYGO=408.1275 D ^DIC S DIE=DIC,DA=+Y,DR=".02////0" D ^DIE
79 D RESET^DGMTU11(DFN)
80ASOFQ K DA,DIC,DIE,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
81 Q
Note: See TracBrowser for help on using the repository browser.