| 1 | DGRPU ;ALB/MRL,TMK - REGISTRATION UTILITY ROUTINE ;12/25/06 18:28
|
|---|
| 2 | ;;5.3;Registration;**33,114,489,624,672,689,634**;Aug 13, 1993;Build 30
|
|---|
| 3 | ; Modified from FOIA VISTA,
|
|---|
| 4 | ; Copyright (C) 2007 WorldVistA
|
|---|
| 5 | ;
|
|---|
| 6 | ; This program is free software; you can redistribute it and/or modify
|
|---|
| 7 | ; it under the terms of the GNU General Public License as published by
|
|---|
| 8 | ; the Free Software Foundation; either version 2 of the License, or
|
|---|
| 9 | ; (at your option) any later version.
|
|---|
| 10 | ;
|
|---|
| 11 | ; This program is distributed in the hope that it will be useful,
|
|---|
| 12 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 13 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 14 | ; GNU General Public License for more details.
|
|---|
| 15 | ;
|
|---|
| 16 | ; You should have received a copy of the GNU General Public License
|
|---|
| 17 | ; along with this program; if not, write to the Free Software
|
|---|
| 18 | ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
|---|
| 19 | H ;Screen Header
|
|---|
| 20 | 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
|
|---|
| 21 | 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
|
|---|
| 22 | S X=$$SSNNM(DFN)
|
|---|
| 23 | I '$D(DGRPH) W !,X S X=$S($D(DGRPTYPE):$P(DGRPTYPE,"^",1),1:"PATIENT TYPE UNKNOWN"),X1=79-$L(X) W ?X1,X
|
|---|
| 24 | S X="",$P(X,"=",80)="" W !,X Q
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | AL(DGLEN) ;DGLEN= Available length of line
|
|---|
| 28 | A ;Format address(es)
|
|---|
| 29 | I '$D(DGLEN) N DGLEN S DGLEN=29
|
|---|
| 30 | N DGX
|
|---|
| 31 | F I=DGA1:1:DGA1+2 I $P(DGRP(DGAD),U,I)]"" S DGA(DGA2)=$P(DGRP(DGAD),U,I),DGA2=DGA2+2
|
|---|
| 32 | I DGA2=1 S DGA(1)="STREET ADDRESS UNKNOWN",DGA2=DGA2+2
|
|---|
| 33 | 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")
|
|---|
| 34 | I ".33^.34^.211^.331^.311^.25^.21"[DGAD D
|
|---|
| 35 | .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)
|
|---|
| 36 | E D
|
|---|
| 37 | .I DGAD=.141 S DGX=$P(DGRP(.141),U,6) Q
|
|---|
| 38 | .S DGX=$P(DGRP(DGAD),U,DGA1+11)
|
|---|
| 39 | S:$L(DGX)>5 DGX=$E(DGX,1,5)_"-"_$E(DGX,6,9)
|
|---|
| 40 | 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
|
|---|
| 41 | F I=0:0 S I=$O(DGA(I)) Q:'I S DGA(I)=$E(DGA(I),1,DGLEN)
|
|---|
| 42 | K DGA1,I,J
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | W I IOST="C-QUME",$L(DGVI)'=2 W ?X,Z Q
|
|---|
| 46 | W ?X,@DGVI,Z,@DGVO
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | H1 ;
|
|---|
| 50 | ;;PATIENT DEMOGRAPHIC DATA
|
|---|
| 51 | ;;PATIENT DATA
|
|---|
| 52 | ;;EMERGENCY CONTACT DATA
|
|---|
| 53 | ;;APPLICANT/SPOUSE EMPLOYMENT DATA
|
|---|
| 54 | ;;INSURANCE DATA
|
|---|
| 55 | ;;MILITARY SERVICE DATA
|
|---|
| 56 | ;;ELIGIBILITY STATUS DATA
|
|---|
| 57 | ;;FAMILY DEMOGRAPHIC DATA
|
|---|
| 58 | ;;INCOME SCREENING DATA
|
|---|
| 59 | ;;INELIGIBLE/MISSING DATA
|
|---|
| 60 | ;;ELIGIBILITY VERIFICATION DATA
|
|---|
| 61 | ;;ADMISSION INFORMATION
|
|---|
| 62 | ;;APPLICATION INFORMATION
|
|---|
| 63 | ;;APPOINTMENT INFORMATION
|
|---|
| 64 | ;;SPONSOR DEMOGRAPHIC INFORMATION
|
|---|
| 65 | ;
|
|---|
| 66 | ;
|
|---|
| 67 | INCOME(DFN,DGDT) ; compute income for veteran...if not in 408.21, pass back file 2 data
|
|---|
| 68 | ; (called by PTF)
|
|---|
| 69 | ;
|
|---|
| 70 | ;
|
|---|
| 71 | ; Input: DFN as IEN of PATIENT file
|
|---|
| 72 | ; DGDT as date to return income as of
|
|---|
| 73 | ;
|
|---|
| 74 | ; Output: total income (computed function)
|
|---|
| 75 | ; (from 408.21 if available...otherwise from file 2)
|
|---|
| 76 | ;
|
|---|
| 77 | ;
|
|---|
| 78 | N DGDEP,DGINC,DGREL,DGTOT,DGX,I S DGTOT=0
|
|---|
| 79 | D ALL^DGMTU21(DFN,"V",DGDT,"I")
|
|---|
| 80 | S DGX=$G(^DGMT(408.21,+$G(DGINC("V")),0)) I DGX]"" F I=8:1:17 S DGTOT=DGTOT+$P(DGX,"^",I)
|
|---|
| 81 | I DGX']"" S DGTOT=$P($G(^DPT(DFN,.362)),U,20)
|
|---|
| 82 | Q DGTOT
|
|---|
| 83 | ;
|
|---|
| 84 | ;
|
|---|
| 85 | MTCOMP(DFN,DGDT) ; is current means test OR COPAY complete?
|
|---|
| 86 | ;
|
|---|
| 87 | ; Input: DFN as IEN of PATIENT file
|
|---|
| 88 | ; DGDT as 'as of' date
|
|---|
| 89 | ;
|
|---|
| 90 | ; Output: 1 if means test/COPAY for year prior to DT passed is complete
|
|---|
| 91 | ; 0 otherwise
|
|---|
| 92 | ; DGMTYPT 1=MT;2=CP;0=NONE
|
|---|
| 93 | ;
|
|---|
| 94 | N COMP,MT,X,YR
|
|---|
| 95 | S YR=$$LYR^DGMTSCU1(DGDT),MT=$$LST^DGMTCOU1(DFN,DGDT)
|
|---|
| 96 | S DGMTYPT=+$P(MT,U,5)
|
|---|
| 97 | S COMP=1
|
|---|
| 98 | I DGMTYPT=1 D ;MT
|
|---|
| 99 | .I $P(MT,"^",4)']""!("^R^N^"[("^"_$P(MT,"^",4)_"^")) S COMP=0
|
|---|
| 100 | I DGMTYPT=2 D ;CP
|
|---|
| 101 | .I $P(MT,"^",4)']""!("^I^L^"[("^"_$P(MT,"^",4)_"^")) S COMP=0
|
|---|
| 102 | S X=+$P(MT,"^",2) I ($E(X,1,3)-1)*10000<YR S COMP=0
|
|---|
| 103 | Q COMP
|
|---|
| 104 | ;
|
|---|
| 105 | HLP1010 ;* This is called by the Executable Help for Patient field #1010.159
|
|---|
| 106 | ; (APPOINTMENT REQUEST ON 1010EZ)
|
|---|
| 107 | W !!," Enter a 'Y' if the veteran applicant has requested an"
|
|---|
| 108 | W !," appointment with a VA doctor or provider and wants to be"
|
|---|
| 109 | W !," seen as soon as one becomes available Enter a 'N'"
|
|---|
| 110 | W !," if the veteran applicant has not requested an appointment."
|
|---|
| 111 | W !!," This question may ONLY be entered ONCE for the veteran."
|
|---|
| 112 | W !," The answer to this question CANNOT be changed after the"
|
|---|
| 113 | W !," initial entry.",!
|
|---|
| 114 | Q
|
|---|
| 115 | ;
|
|---|
| 116 | HLPCS ; * This is called by the Executable Help for Income Relation field #.1
|
|---|
| 117 | Q:X="?"
|
|---|
| 118 | N DIR,DGRDVAR
|
|---|
| 119 | W !?8,"Enter in this field a Yes or No to indicate whether the veteran"
|
|---|
| 120 | W !?8,"contributed any dollar amount to the child's support last calendar"
|
|---|
| 121 | W !?8,"year. The contributions do not have to be in regular set amounts."
|
|---|
| 122 | W !?8,"For example, a veteran who paid a child's school tuition or"
|
|---|
| 123 | W !?8,"medical bills would be contributing to the child's support.",!
|
|---|
| 124 | W !,"Enter RETURN to continue:" R DGRDVAR:DTIME W !
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | HLP1823 ;*This is called by the Executable Help for Patient Relation field #.18
|
|---|
| 128 | N DIR,DGRDVAR
|
|---|
| 129 | W !?7,"Enter 'Y' if the child is currently 18 to 23 years old and the child"
|
|---|
| 130 | W !?7,"attended school last calendar year. Enter 'N' if the child is currently"
|
|---|
| 131 | W !?7,"18 to 23 years old but the child did not attend school last calendar"
|
|---|
| 132 | W !?7,"year. Enter 'N' if the child is not currently 18 to 23 years old.",!
|
|---|
| 133 | I $G(DA) W !,"Enter RETURN to continue:" R DGRDVAR:DTIME W !
|
|---|
| 134 | Q
|
|---|
| 135 | ;
|
|---|
| 136 | HLPMLDS ;* This is called by the Executable Help for Patient field #.362
|
|---|
| 137 | ; (DISABILITY RET. FROM MILITARY?)
|
|---|
| 138 | N X,Y,DIR
|
|---|
| 139 | W !!," Enter '0' or 'NO' if the veteran:"
|
|---|
| 140 | W !," -- Is NOT retired from the military OR"
|
|---|
| 141 | W !," -- Is retired from the military due to length of service AND"
|
|---|
| 142 | W !," does NOT have a disability confirmed by the Military Branch"
|
|---|
| 143 | W !," to have been incurred in or aggravated while on active duty."
|
|---|
| 144 | W !!," Enter '1' or 'YES, RECEIVING MILITARY RETIREMENT' if the veteran:"
|
|---|
| 145 | W !," -- Is confirmed by the Military Branch to have been discharged"
|
|---|
| 146 | W !," or released due to a disability incurred in or aggravated"
|
|---|
| 147 | W !," while on active duty AND"
|
|---|
| 148 | W !," -- Has NOT filed a claim for VA compensation benefits OR"
|
|---|
| 149 | W !," -- Has been rated by the VA to be NSC OR"
|
|---|
| 150 | W !," -- Has been rated by the VA to have noncompensable 0%"
|
|---|
| 151 | W !," SC conditions."
|
|---|
| 152 | S DIR(0)="E" D ^DIR Q:+Y<1
|
|---|
| 153 | W !!," Enter '2' or 'YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA"
|
|---|
| 154 | W !," COMPENSATION' if the veteran:"
|
|---|
| 155 | W !," -- Is confirmed by the Military Branch to have been discharged"
|
|---|
| 156 | W !," or released due to a disability incurred in or aggravated"
|
|---|
| 157 | W !," while on active duty AND"
|
|---|
| 158 | W !," -- Is receiving military disability retirement pay AND"
|
|---|
| 159 | W !," -- Has been rated by VA to have compensable SC conditions"
|
|---|
| 160 | W !," but is NOT receiving compensation from the VA"
|
|---|
| 161 | W !!," Once eligibility has been verified, this field will no longer"
|
|---|
| 162 | W !," be editable to any user who does not hold the designated security"
|
|---|
| 163 | W !," key."
|
|---|
| 164 | Q
|
|---|
| 165 | HLP3602 ;help text for field .3602, Rec'ing Disability in Lieu of VA Comp
|
|---|
| 166 | W !," Enter 'Y' if this veteran applicant is receiving disability"
|
|---|
| 167 | W !," retirement pay from the Military instead of VA compensation."
|
|---|
| 168 | W !," Enter 'N' if this veteran applicant is not receiving disability"
|
|---|
| 169 | W !," retirement pay from the Military instead of VA compensation."
|
|---|
| 170 | W !," Once eligibility has been verified by HEC this field will no longer "
|
|---|
| 171 | W !," be editable by VistA users. Send updates and/or requests to HEC."
|
|---|
| 172 | Q
|
|---|
| 173 | HLP3603 ;help text for field .3603, Discharge Due to LOD Disability
|
|---|
| 174 | W !," Enter 'Y' if this veteran applicant was discharged from the"
|
|---|
| 175 | W !," military for a disability incurred or aggravated in the line "
|
|---|
| 176 | W !," of duty. Enter 'N' if this veteran applicant was not discharged"
|
|---|
| 177 | W !," from the military for a disability incurred or aggravated in the"
|
|---|
| 178 | W !," line of duty. Once eligibility has been verified by HEC this field"
|
|---|
| 179 | W !," will no longer be editable by VistA users. Send updates and/or requests"
|
|---|
| 180 | W !," to HEC."
|
|---|
| 181 | Q
|
|---|
| 182 | SSNNM(DFN) ; SSN and name on first line of screen
|
|---|
| 183 | ;
|
|---|
| 184 | ; ** start of VOE change: DAOU/JLG 2/1/2005,VA/CJS,WV/TOAD 5/9/2006 **
|
|---|
| 185 | ;
|
|---|
| 186 | ; Change code so it will display HRN if SSN is null
|
|---|
| 187 | ;
|
|---|
| 188 | ; before:
|
|---|
| 189 | ;
|
|---|
| 190 | ; N X,SSN
|
|---|
| 191 | ; 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)
|
|---|
| 192 | ;
|
|---|
| 193 | ; after:
|
|---|
| 194 | ;
|
|---|
| 195 | ; Social Security Number field (.09) in Patient file (2)
|
|---|
| 196 | N X,SSN,HRN
|
|---|
| 197 | S X=$S($D(^DPT(+DFN,0)):^(0),1:""),SSN=$P(X,"^",9)
|
|---|
| 198 | I SSN S SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,10)
|
|---|
| 199 | ;
|
|---|
| 200 | ID S SSN=$$ID^DGLBPID(DFN) ;**GFT/VW
|
|---|
| 201 | ; for IHS or EHR, replace SSN with HRN
|
|---|
| 202 | I $G(DUZ("AG"))'="V" D
|
|---|
| 203 | . Q:SSN]""
|
|---|
| 204 | . S HRN=$$HRN^AUPNPAT3(+DFN,DUZ(2))
|
|---|
| 205 | . I HRN S SSN="HRN-"_HRN
|
|---|
| 206 | ;
|
|---|
| 207 | ; ** end of VOE change **
|
|---|
| 208 | ;
|
|---|
| 209 | S X=$P(X,U)_"; "_SSN
|
|---|
| 210 | Q X
|
|---|
| 211 | ;
|
|---|
