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

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

initial load of FOIAVistA 6/30/08 version

File size: 7.4 KB
Line 
1DGRPU ;ALB/MRL,TMK - REGISTRATION UTILITY ROUTINE ;19 OCT 2005
2 ;;5.3;Registration;**33,114,489,624,672,689**;Aug 13, 1993;Build 1
3H ;Screen Header
4 I DGRPS'=1.1 W @IOF S Z=$P($T(H1+DGRPS),";;",2)_", SCREEN <"_DGRPS_">"_$S($D(DGRPH):" HELP",1:""),X=79-$L(Z)\2 D W
5 I DGRPS=1.1 W @IOF S Z="ADDITIONAL PATIENT DEMOGRAPHIC DATA, SCREEN <"_DGRPS_">"_$S($D(DGRPH):" HELP",1:""),X=79-$L(Z)\2 D W
6 S X=$$SSNNM(DFN)
7 I '$D(DGRPH) W !,X S X=$S($D(DGRPTYPE):$P(DGRPTYPE,"^",1),1:"PATIENT TYPE UNKNOWN"),X1=79-$L(X) W ?X1,X
8 S X="",$P(X,"=",80)="" W !,X Q
9 Q
10 ;
11AL(DGLEN) ;DGLEN= Available length of line
12A ;Format address(es)
13 I '$D(DGLEN) N DGLEN S DGLEN=29
14 N DGX
15 F I=DGA1:1:DGA1+2 I $P(DGRP(DGAD),U,I)]"" S DGA(DGA2)=$P(DGRP(DGAD),U,I),DGA2=DGA2+2
16 I DGA2=1 S DGA(1)="STREET ADDRESS UNKNOWN",DGA2=DGA2+2
17 S J=$S('$D(^DIC(5,+$P(DGRP(DGAD),U,DGA1+4),0)):"",('$L($P(^(0),U,2))):$P(^(0),U,1),1:$P(^(0),U,2)),J(1)=$P(DGRP(DGAD),U,DGA1+3),J(2)=$P(DGRP(DGAD),U,DGA1+5),DGA(DGA2)=$S(J(1)]""&(J]""):J(1)_","_J,J(1)]"":J(1),J]"":J,1:"UNK. CITY/STATE")
18 I ".33^.34^.211^.331^.311^.25^.21"[DGAD D
19 .F I=1:1:7 I $P(".33^.34^.211^.331^.311^.25^.21",U,I)=DGAD S DGX=$P($G(^DPT(DFN,.22)),U,I)
20 E D
21 .I DGAD=.141 S DGX=$P(DGRP(.141),U,6) Q
22 .S DGX=$P(DGRP(DGAD),U,DGA1+11)
23 S:$L(DGX)>5 DGX=$E(DGX,1,5)_"-"_$E(DGX,6,9)
24 S DGA(DGA2)=$E($P(DGA(DGA2),",",1),1,(DGLEN-($L(DGX)+4)))_$S($L($P(DGA(DGA2),",",2)):",",1:"")_$P(DGA(DGA2),",",2)_" "_DGX
25 F I=0:0 S I=$O(DGA(I)) Q:'I S DGA(I)=$E(DGA(I),1,DGLEN)
26 K DGA1,I,J
27 Q
28 ;
29W I IOST="C-QUME",$L(DGVI)'=2 W ?X,Z Q
30 W ?X,@DGVI,Z,@DGVO
31 Q
32 ;
33H1 ;
34 ;;PATIENT DEMOGRAPHIC DATA
35 ;;PATIENT DATA
36 ;;EMERGENCY CONTACT DATA
37 ;;APPLICANT/SPOUSE EMPLOYMENT DATA
38 ;;INSURANCE DATA
39 ;;MILITARY SERVICE DATA
40 ;;ELIGIBILITY STATUS DATA
41 ;;FAMILY DEMOGRAPHIC DATA
42 ;;INCOME SCREENING DATA
43 ;;INELIGIBLE/MISSING DATA
44 ;;ELIGIBILITY VERIFICATION DATA
45 ;;ADMISSION INFORMATION
46 ;;APPLICATION INFORMATION
47 ;;APPOINTMENT INFORMATION
48 ;;SPONSOR DEMOGRAPHIC INFORMATION
49 ;
50 ;
51INCOME(DFN,DGDT) ; compute income for veteran...if not in 408.21, pass back file 2 data
52 ; (called by PTF)
53 ;
54 ;
55 ; Input: DFN as IEN of PATIENT file
56 ; DGDT as date to return income as of
57 ;
58 ; Output: total income (computed function)
59 ; (from 408.21 if available...otherwise from file 2)
60 ;
61 ;
62 N DGDEP,DGINC,DGREL,DGTOT,DGX,I S DGTOT=0
63 D ALL^DGMTU21(DFN,"V",DGDT,"I")
64 S DGX=$G(^DGMT(408.21,+$G(DGINC("V")),0)) I DGX]"" F I=8:1:17 S DGTOT=DGTOT+$P(DGX,"^",I)
65 I DGX']"" S DGTOT=$P($G(^DPT(DFN,.362)),U,20)
66 Q DGTOT
67 ;
68 ;
69MTCOMP(DFN,DGDT) ; is current means test OR COPAY complete?
70 ;
71 ; Input: DFN as IEN of PATIENT file
72 ; DGDT as 'as of' date
73 ;
74 ; Output: 1 if means test/COPAY for year prior to DT passed is complete
75 ; 0 otherwise
76 ; DGMTYPT 1=MT;2=CP;0=NONE
77 ;
78 N COMP,MT,X,YR
79 S YR=$$LYR^DGMTSCU1(DGDT),MT=$$LST^DGMTCOU1(DFN,DGDT)
80 S DGMTYPT=+$P(MT,U,5)
81 S COMP=1
82 I DGMTYPT=1 D ;MT
83 .I $P(MT,"^",4)']""!("^R^N^"[("^"_$P(MT,"^",4)_"^")) S COMP=0
84 I DGMTYPT=2 D ;CP
85 .I $P(MT,"^",4)']""!("^I^L^"[("^"_$P(MT,"^",4)_"^")) S COMP=0
86 S X=+$P(MT,"^",2) I ($E(X,1,3)-1)*10000<YR S COMP=0
87 Q COMP
88 ;
89HLP1010 ;* This is called by the Executable Help for Patient field #1010.159
90 ; (APPOINTMENT REQUEST ON 1010EZ)
91 W !!," Enter a 'Y' if the veteran applicant has requested an"
92 W !," appointment with a VA doctor or provider and wants to be"
93 W !," seen as soon as one becomes available Enter a 'N'"
94 W !," if the veteran applicant has not requested an appointment."
95 W !!," This question may ONLY be entered ONCE for the veteran."
96 W !," The answer to this question CANNOT be changed after the"
97 W !," initial entry.",!
98 Q
99 ;
100HLPCS ; * This is called by the Executable Help for Income Relation field #.1
101 Q:X="?"
102 N DIR,DGRDVAR
103 W !?8,"Enter in this field a Yes or No to indicate whether the veteran"
104 W !?8,"contributed any dollar amount to the child's support last calendar"
105 W !?8,"year. The contributions do not have to be in regular set amounts."
106 W !?8,"For example, a veteran who paid a child's school tuition or"
107 W !?8,"medical bills would be contributing to the child's support.",!
108 W !,"Enter RETURN to continue:" R DGRDVAR:DTIME W !
109 Q
110 ;
111HLP1823 ;*This is called by the Executable Help for Patient Relation field #.18
112 N DIR,DGRDVAR
113 W !?7,"Enter 'Y' if the child is currently 18 to 23 years old and the child"
114 W !?7,"attended school last calendar year. Enter 'N' if the child is currently"
115 W !?7,"18 to 23 years old but the child did not attend school last calendar"
116 W !?7,"year. Enter 'N' if the child is not currently 18 to 23 years old.",!
117 I $G(DA) W !,"Enter RETURN to continue:" R DGRDVAR:DTIME W !
118 Q
119 ;
120HLPMLDS ;* This is called by the Executable Help for Patient field #.362
121 ; (DISABILITY RET. FROM MILITARY?)
122 N X,Y,DIR
123 W !!," Enter '0' or 'NO' if the veteran:"
124 W !," -- Is NOT retired from the military OR"
125 W !," -- Is retired from the military due to length of service AND"
126 W !," does NOT have a disability confirmed by the Military Branch"
127 W !," to have been incurred in or aggravated while on active duty."
128 W !!," Enter '1' or 'YES, RECEIVING MILITARY RETIREMENT' if the veteran:"
129 W !," -- Is confirmed by the Military Branch to have been discharged"
130 W !," or released due to a disability incurred in or aggravated"
131 W !," while on active duty AND"
132 W !," -- Has NOT filed a claim for VA compensation benefits OR"
133 W !," -- Has been rated by the VA to be NSC OR"
134 W !," -- Has been rated by the VA to have noncompensable 0%"
135 W !," SC conditions."
136 S DIR(0)="E" D ^DIR Q:+Y<1
137 W !!," Enter '2' or 'YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA"
138 W !," COMPENSATION' if the veteran:"
139 W !," -- Is confirmed by the Military Branch to have been discharged"
140 W !," or released due to a disability incurred in or aggravated"
141 W !," while on active duty AND"
142 W !," -- Is receiving military disability retirement pay AND"
143 W !," -- Has been rated by VA to have compensable SC conditions"
144 W !," but is NOT receiving compensation from the VA"
145 W !!," Once eligibility has been verified, this field will no longer"
146 W !," be editable to any user who does not hold the designated security"
147 W !," key."
148 Q
149HLP3602 ;help text for field .3602, Rec'ing Disability in Lieu of VA Comp
150 W !," Enter 'Y' if this veteran applicant is receiving disability"
151 W !," retirement pay from the Military instead of VA compensation."
152 W !," Enter 'N' if this veteran applicant is not receiving disability"
153 W !," retirement pay from the Military instead of VA compensation."
154 W !," Once eligibility has been verified by HEC this field will no longer "
155 W !," be editable by VistA users. Send updates and/or requests to HEC."
156 Q
157HLP3603 ;help text for field .3603, Discharge Due to LOD Disability
158 W !," Enter 'Y' if this veteran applicant was discharged from the"
159 W !," military for a disability incurred or aggravated in the line "
160 W !," of duty. Enter 'N' if this veteran applicant was not discharged"
161 W !," from the military for a disability incurred or aggravated in the"
162 W !," line of duty. Once eligibility has been verified by HEC this field"
163 W !," will no longer be editable by VistA users. Send updates and/or requests"
164 W !," to HEC."
165 Q
166SSNNM(DFN) ; SSN and name on first line of screen
167 N X,SSN
168 S X=$S($D(^DPT(+DFN,0)):^(0),1:""),SSN=$P(X,"^",9),SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,10)
169 S X=$P(X,U)_"; "_SSN
170 Q X
171 ;
Note: See TracBrowser for help on using the repository browser.