source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTSCU2.m@ 686

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1DGMTSCU2 ;ALB/RMO,CAW,LBD,CKN - Means Test Screen Variable Utilities ;6 FEB 1992 7:45 am
2 ;;5.3;Registration;**45,130,433,460,456,490**;Aug 13, 1993
3 ;
4SET ;Set required means test variables
5 ; Input -- DFN Patient file IEN
6 ; DGMTDT Date of Test
7 ; DGMTYPT Type of Test 1=MT 2=COPAY
8 ; DGMTI Annual Means Test IEN
9 ; DGMTPAR Annual Means Test Parameters
10 ; DGVIRI Veteran Income Relation IEN
11 ; DGVINI Veteran Individual Annual Income IEN
12 ; Output -- All output variables in tags DEP, INC^DGMTSCU3, CAT and STA
13 D DEP,INC^DGMTSCU3,CAT,STA
14 Q
15 ;
16DEP ;Determine dependent data
17 ; Input -- DFN Patient file IEN
18 ; DGMTDT Date of Test
19 ; DGVIRI Veteran Income Relation IEN
20 ; Output -- DGVIR0 Veteran Income Relation 0th node
21 ; DGSP Spouse 1=YES and 0=NO (mt income)
22 ; DGDC Dependent children 1=YES and 0=NO (mt income)
23 ; DGNC Number of dependent children
24 ; DGND Total number of dependents
25 N DGCNT,DGDEP,DGINR,DGREL,Y
26 S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)) D ALL^DGMTU21(DFN,"SC",DGMTDT,"PR",$S($G(DGMTI):DGMTI,1:""))
27 S DGSP=$S('$P(DGVIR0,"^",5)!('$G(DGREL("S"))):0,$P(DGVIR0,"^",6):1,$P(DGVIR0,"^",7)>599:1,1:0)
28 S DGDC=+$P(DGVIR0,"^",8) I DGDC S (DGDC,DGCNT)=0 F S DGCNT=$O(DGINR("C",DGCNT)) Q:'DGCNT!(DGDC) D CHK S:Y DGDC=1
29 S DGNC=+$P(DGVIR0,"^",13)
30 S DGND=DGSP+DGNC
31 Q
32 ;
33CHK ;Check if child has income which is available to the veteran
34 S Y=0
35 I $D(^DGMT(408.22,+$G(DGINR("C",DGCNT)),0)),$P(^(0),"^",11),$P(^(0),"^",12) S Y=1
36 Q
37 ;
38CAT ;Determine means test thresholds and category
39 ; Input -- DGMTDT Date of Test
40 ; DGND Total number of dependents
41 ; DGINT Total income
42 ; DGDET Total deductible expenses
43 ; DGMTPAR Annual Means Test Parameters
44 ; DGMTGMT GMT Thresholds
45 ; Output -- DGTHA MT threshold
46 ; DGTHB Category B threshold (NO LONGER USED)
47 ; DGTHG GMT threshold
48 ; DGCAT Means/Copay test category code
49 N DGCOST,DGCOPS,PCT S DGCAT=""
50 ; Added for LTC Copay Phase II - DG*5.3*433
51 I DGMTYPT=4 D Q
52 .N Y S DGTHA=""
53 .I $D(DGREF1),$D(DGREF) S DGCAT=1 Q ;Vet declined to give income info
54 .S Y=$$THRES^EASECMT(DFN,DGMTDT) Q:Y=-1
55 .S DGCAT=$S(Y:0,1:1)
56 I $$ACT^DGMTDD(4,DGMTDT) S DGTHA=$P(DGMTPAR,"^",2)+$S(DGND:$P(DGMTPAR,"^",3),1:0)+$S((DGND-1)>0:($P(DGMTPAR,"^",4)*(DGND-1)),1:0) S:(DGINT-DGDET)'>DGTHA DGCAT="A"
57 I $$ACT^DGMTDD(5,DGMTDT) S DGTHB=$P(DGMTPAR,"^",5)+$S(DGND:$P(DGMTPAR,"^",6),1:0)+$S((DGND-1)>0:($P(DGMTPAR,"^",7)*(DGND-1)),1:0) I DGCAT']"",(DGINT-DGDET)'>DGTHB S DGCAT="B"
58 ; Determine the GMT Threshold
59 ; The DGMTGMT variable stores the GMT Thresholds for households of
60 ; 1-8 persons. If a household (veteran + dependents) has more than 8
61 ; the GMT Threshold will be calculated. For each person in excess of
62 ; 8, 8% of the base (4-person household) will be added to the 8-person
63 ; income limit. Income limits are rounded to the next $50.
64 S DGTHG=""
65 I $$ACT^DGMTDD(16,DGMTDT) D
66 .I '$G(DGMTGMT) S DGTHG=0 Q
67 .;If GMT Threshold already calculated, don't recalculate
68 .S DGTHG="" I $G(DGMTI) S DGTHG=$P($G(^DGMT(408.31,DGMTI,0)),"^",27)
69 .I 'DGTHG D
70 ..I DGND+1<9 S DGTHG=$P(DGMTGMT,"^",(DGND+1))
71 ..E S PCT=((DGND+1)-8)*8+132/100,DGTHG=$P(DGMTGMT,"^",4)*PCT,DGTHG=$S(DGTHG#50=0:DGTHG,1:DGTHG+(50-(DGTHG#50)))
72 .I DGTHG<DGTHA Q
73 .I DGCAT="",(DGINT-DGDET)'>DGTHG S DGCAT="G"
74 I DGCAT="",$$ACT^DGMTDD(6,DGMTDT) S DGCAT="C"
75 I $D(DGREF),DGMTYPT=1,$D(DGREF1) S DGCAT="C"
76 I DGMTYPT=2 D
77 .S DGCOST=DGMTDT_U_DFN_U_U_DGINT_U_DGNWT,$P(DGCOST,U,14)=$S($D(DGREF):1,1:0),$P(DGCOST,U,15)=DGDET,$P(DGCOST,U,18)=DGND,$P(DGCOST,U,19)=2
78 .S DGCOPS=$$INCDT^IBARXEU1(DGCOST)
79 .S DGCAT=$S(+DGCOPS=1:"E",+DGCOPS=2:"M",+DGCOPS=3:"P",1:"I")
80 .S (DGTHA,DGTHB)=""
81 Q
82 ;
83STA ;Determine means test status and type of care
84 ; Input -- DGCAT Means test category code
85 ; DGMTYPT Type of Test 1=MT 2=COPAY
86 ; Output -- DGMTS Means test status IEN
87 ; DGTYC Type of care
88 S DGMTS=+$O(^DG(408.32,"AC",DGMTYPT,DGCAT,0))
89 S DGTYC=$P($G(^DG(408.32,DGMTS,0)),"^",3)
90 Q
Note: See TracBrowser for help on using the repository browser.