source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECED.m@ 1042

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

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1EASECED ;ALB/LBD - INCOME SCREENING DATA FOR EDIT ; 19 AUG 2001
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5**;Mar 15, 2001
3 ; Handles editing of dependent info
4 ; CHANGES TO THIS ROUTINE SHOULD BE COORDINATED WITH THE MEANS TEST
5 ; DEVELOPER. MANY CALLS IN THIS ROUTINE (ADD, EDIT, INACT, ETC.) ARE
6 ; CALLED FROM MEANS TEST OR ARE MIMICKED THERE.
7 ;
8 ; NOTE: This routine was modified from DGRPEIS for LTC Co-pay
9 ; In: DFN as IEN of PATIENT file
10 ; DGDR as string of items selected for editing
11 ;Out: DGFL as -2 if time-out, -1 if up-arrow
12EN S DGFL=0
13 S DGISDT=$E(DT,1,3)_"0000"
14 S DGRP(0)=$G(^DPT(DFN,0)) D NEW^EASECED1,GETREL^DGMTU11(DFN,"VSD",DGISDT)
15 I DGDR[801 D SPOUSE^EASECED2 S DGPREF=$G(DGREL("S")) G Q:DGFL I DGSPFL D:DGPREF EDIT(DGPREF,"S") I 'DGPREF D ADD(DFN,"S")
16 K DGSPFL,DGPREF
17Q Q
18 ;
19ADD(DFN,DGTYPE,DGTSTDT) ; subroutine to add to files 408.12 & 408.13
20 ; In -- DFN as the IEN of file 2 for the vet
21 ; DGTYPE as C for mt children or D for all deps
22 ; S for spouse (default spouse)
23 ; DGTSTDT - optional test date
24 ;Out -- DGPRI as patient relation IEN
25 ; DGIPI as income person IEN
26 ; DGFL as -2 if time-out, -1 if '^', 0 otherwise
27 N ANS,DA,PROMPT,SPOUSE,TYPE
28 I '$D(DGTSTDT) N DGTSTDT S DGTSTDT=$S($D(DGMTDT):DGMTDT,1:DT)
29 S DGFL=$G(DGFL)
30 S DGTYPE=$G(DGTYPE),SPOUSE=$S(DGTYPE']"":1,DGTYPE="C":0,DGTYPE="D":0,1:1)
31 S DGFL=$G(DGFL),PROMPT="NAME^SEX^DATE OF BIRTH^^^^^^SSN",TYPE=$S(SPOUSE:"SPOUSE'S ",DGTYPE="D":"DEPENDENT'S ",1:"CHILD'S ")
32 F DGRPI=.01:.01:.03,.09 D I DGFL Q
33 . K DIR S DIR(0)="408.13,"_DGRPI I DGRPI=.01 S DIR(0)=DIR(0)_"O"
34 . I DGRPI=.02,SPOUSE S X=$P($G(^DPT(DFN,0)),"^",2) I X]"" S DIR("B")=$S(X="F":"MALE",1:"FEMALE") ; default spouse sex
35 . S:DGRPI=.03 DIR(0)=DIR(0)_"^^"_"S %DT=""EP"" D ^%DT S X=Y K:($E(DGTSTDT,1,3)_1231)<X X"
36 . S DIR("A")=TYPE_$P(PROMPT,"^",DGRPI*100)
37 . D ^DIR
38 . I $D(DTOUT)!$D(DUOUT) S DGFL=$S($D(DUOUT):$S(DGRPI=.09:"",1:-1),1:-2) Q
39 . I DGRPI=.01,(Y']"") S DGFL=-1 Q
40 . S ANS(DGRPI)=Y
41 . I DGRPI=.03,$D(ANS(.03)) S X2=ANS(.03),X1=DT D ^%DTC I 'SPOUSE S AGE=(X/365.25) W ?62,"(AGE: "_$P(AGE,".")_")" I AGE>17 D WRT^EASECED3
42 I '$D(ANS(.01)) S DGFL=0 G ADDQ
43 I DGFL=-2!'$D(ANS(.03)) W !?3,$C(7),"Incomplete Entry...Deleted" G ADDQ
44 S DGRP0ND=ANS(.01)_"^"_ANS(.02)_"^"_ANS(.03)_"^^^^^^"_$G(ANS(.09)) D NEWIP^EASECED1
45ADDQ K DGRP0ND,DGRPI,DIR,DIRUT,DTOUT,DUOUT
46 Q
47INACT ; prompt to inactivate a patient relation
48 ; Input -- DGREL("D") array of dependents
49 ; DGDEP as number of deps (from GETREL call)
50 N ACT,DGDT,IEN,X
51 S DGFL=$G(DGFL)
52 I 'DGDEP W !!,"No dependents to inactivate!" Q
53 W !!,"Enter a number 1-",DGDEP," to indicate the dependent you wish to inactivate: " R X:DTIME
54 I '$T S DGFL=-2 Q
55 I X["^" S DGFL=-1 Q
56 I X']"" Q
57 I X["?" W !!,"Enter a number 1-",DGDEP," indicating the number of the dependent you wish to inactivate" G INACT
58 I $D(DGREL("D",X)) S X=DGREL("D",X) D SETUP^EASECED1 Q ; check for IVM dependents
59 S X=$G(DGREL("C",X)) I 'X G INACT ; check for MT deps
60 D SETUP^EASECED1
61 Q
62EDIT(DGPREF,DGTYPE,DATE) ; edit demographic data for a dep
63 ; Input -- DGPREF as returned by GETREL^DGMTU11 for dep to edit
64 ; DGTYPE as D if all deps or C if MT children only
65 ; S for spouse (optional - spouse if not defined)
66 ; DATE [optional] as income screening year/default= last yr
67 ; Output -- DGFL as -2 if timeout, -1 if '^', or 0 o/w
68 N DOB,DGACT,RELATION,UPARROW,X,Y,DGEDDEP
69 D EDIT^EASECED3
70 Q
Note: See TracBrowser for help on using the repository browser.