Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGRPU

DGRPU.m

Go to the documentation of this file. 
  1. DGRPU ;ALB/MRL,TMK - REGISTRATION UTILITY ROUTINE ;19 OCT 2005
  1.  ;;5.3;Registration;**33,114,489,624,672,689,1015**;Aug 13, 1993;Build 20
  1. H ;Screen Header
  1.  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
  1.  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
  1.  S X=$$SSNNM(DFN)
  1.  I '$D(DGRPH) W !,X S X=$S($D(DGRPTYPE):$P(DGRPTYPE,"^",1),1:"PATIENT TYPE UNKNOWN"),X1=79-$L(X) W ?X1,X
  1.  S X="",$P(X,"=",80)="" W !,X Q
  1.  Q
  1.  ;
  1. AL(DGLEN) ;DGLEN= Available length of line
  1. A ;Format address(es)
  1.  I '$D(DGLEN) N DGLEN S DGLEN=29
  1.  N DGX
  1.  F I=DGA1:1:DGA1+2 I $P(DGRP(DGAD),U,I)]"" S DGA(DGA2)=$P(DGRP(DGAD),U,I),DGA2=DGA2+2
  1.  I DGA2=1 S DGA(1)="STREET ADDRESS UNKNOWN",DGA2=DGA2+2
  1.  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")
  1.  I ".33^.34^.211^.331^.311^.25^.21"[DGAD D
  1.  .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)
  1.  E  D
  1.  .I DGAD=.141 S DGX=$P(DGRP(.141),U,6) Q
  1.  .S DGX=$P(DGRP(DGAD),U,DGA1+11)
  1.  S:$L(DGX)>5 DGX=$E(DGX,1,5)_"-"_$E(DGX,6,9)
  1.  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
  1.  F I=0:0 S I=$O(DGA(I)) Q:'I  S DGA(I)=$E(DGA(I),1,DGLEN)
  1.  K DGA1,I,J
  1.  Q
  1.  ;
  1. W I IOST="C-QUME",$L(DGVI)'=2 W ?X,Z Q
  1.  W ?X,@DGVI,Z,@DGVO
  1.  Q
  1.  ;
  1. H1 ;
  1.  ;;PATIENT DEMOGRAPHIC DATA
  1.  ;;PATIENT DATA
  1.  ;;EMERGENCY CONTACT DATA
  1.  ;;APPLICANT/SPOUSE EMPLOYMENT DATA
  1.  ;;INSURANCE DATA
  1.  ;;MILITARY SERVICE DATA
  1.  ;;ELIGIBILITY STATUS DATA
  1.  ;;FAMILY DEMOGRAPHIC DATA
  1.  ;;INCOME SCREENING DATA
  1.  ;;INELIGIBLE/MISSING DATA
  1.  ;;ELIGIBILITY VERIFICATION DATA
  1.  ;;ADMISSION INFORMATION
  1.  ;;APPLICATION INFORMATION
  1.  ;;APPOINTMENT INFORMATION
  1.  ;;SPONSOR DEMOGRAPHIC INFORMATION
  1.  ;
  1.  ;
  1. INCOME(DFN,DGDT) ; compute income for veteran...if not in 408.21, pass back file 2 data
  1.  ; (called by PTF)
  1.  ;
  1.  ;
  1.  ;  Input:  DFN as IEN of PATIENT file
  1.  ;          DGDT as date to return income as of
  1.  ;
  1.  ; Output:  total income (computed function)
  1.  ;          (from 408.21 if available...otherwise from file 2)
  1.  ;
  1.  ;
  1.  N DGDEP,DGINC,DGREL,DGTOT,DGX,I S DGTOT=0
  1.  D ALL^DGMTU21(DFN,"V",DGDT,"I")
  1.  S DGX=$G(^DGMT(408.21,+$G(DGINC("V")),0)) I DGX]"" F I=8:1:17 S DGTOT=DGTOT+$P(DGX,"^",I)
  1.  I DGX']"" S DGTOT=$P($G(^DPT(DFN,.362)),U,20)
  1.  Q DGTOT
  1.  ;
  1.  ;
  1. MTCOMP(DFN,DGDT) ; is current means test OR COPAY complete?
  1.  ;
  1.  ;  Input:  DFN as IEN of PATIENT file
  1.  ;          DGDT as 'as of' date
  1.  ;
  1.  ; Output:  1 if means test/COPAY for year prior to DT passed is complete
  1.  ;          0 otherwise
  1.  ;          DGMTYPT 1=MT;2=CP;0=NONE
  1.  ;
  1.  N COMP,MT,X,YR
  1.  S YR=$$LYR^DGMTSCU1(DGDT),MT=$$LST^DGMTCOU1(DFN,DGDT)
  1.  S DGMTYPT=+$P(MT,U,5)
  1.  S COMP=1
  1.  I DGMTYPT=1 D  ;MT
  1.  .I $P(MT,"^",4)']""!("^R^N^"[("^"_$P(MT,"^",4)_"^")) S COMP=0
  1.  I DGMTYPT=2 D  ;CP
  1.  .I $P(MT,"^",4)']""!("^I^L^"[("^"_$P(MT,"^",4)_"^")) S COMP=0
  1.  S X=+$P(MT,"^",2) I ($E(X,1,3)-1)*10000<YR S COMP=0
  1.  Q COMP
  1.  ;
  1. HLP1010 ;* This is called by the Executable Help for Patient field #1010.159
  1.  ;   (APPOINTMENT REQUEST ON 1010EZ)
  1.  W !!,"    Enter a 'Y' if the veteran applicant has requested an"
  1.  W !,"    appointment with a VA doctor or provider and wants to be"
  1.  W !,"    seen as soon as one becomes available  Enter a 'N'"
  1.  W !,"    if the veteran applicant has not requested an appointment."
  1.  W !!,"    This question may ONLY be entered ONCE for the veteran."
  1.  W !,"    The answer to this question CANNOT be changed after the"
  1.  W !,"    initial entry.",!
  1.  Q
  1.  ;
  1. HLPCS ; * This is called by the Executable Help for Income Relation field #.1
  1.  Q:X="?"
  1.  N DIR,DGRDVAR
  1.  W !?8,"Enter in this field a Yes or No to indicate whether the veteran"
  1.  W !?8,"contributed any dollar amount to the child's support last calendar"
  1.  W !?8,"year.  The contributions do not have to be in regular set amounts."
  1.  W !?8,"For example, a veteran who paid a child's school tuition or"
  1.  W !?8,"medical bills would be contributing to the child's support.",!
  1.  W !,"Enter RETURN to continue:" R DGRDVAR:DTIME W !
  1.  Q
  1.  ;
  1. HLP1823 ;*This is called by the Executable Help for Patient Relation field #.18
  1.  N DIR,DGRDVAR
  1.  W !?7,"Enter 'Y' if the child is currently 18 to 23 years old and the child"
  1.  W !?7,"attended school last calendar year.  Enter 'N' if the child is currently"
  1.  W !?7,"18 to 23 years old but the child did not attend school last calendar"
  1.  W !?7,"year.  Enter 'N' if the child is not currently 18 to 23 years old.",!
  1.  I $G(DA) W !,"Enter RETURN to continue:" R DGRDVAR:DTIME W !
  1.  Q
  1.  ;
  1. HLPMLDS ;* This is called by the Executable Help for Patient field #.362
  1.  ;   (DISABILITY RET. FROM MILITARY?)
  1.  N X,Y,DIR
  1.  W !!,"  Enter '0' or 'NO' if the veteran:"
  1.  W !,"    -- Is NOT retired from the military OR"
  1.  W !,"    -- Is retired from the military due to length of service AND"
  1.  W !,"       does NOT have a disability confirmed by the Military Branch"
  1.  W !,"       to have been incurred in or aggravated while on active duty."
  1.  W !!,"  Enter '1' or 'YES, RECEIVING MILITARY RETIREMENT' if the veteran:"
  1.  W !,"    -- Is confirmed by the Military Branch to have been discharged"
  1.  W !,"       or released due to a disability incurred in or aggravated"
  1.  W !,"       while on active duty AND"
  1.  W !,"       -- Has NOT filed a claim for VA compensation benefits OR"
  1.  W !,"       -- Has been rated by the VA to be NSC OR"
  1.  W !,"       -- Has been rated by the VA to have noncompensable 0%"
  1.  W !,"          SC conditions."
  1.  S DIR(0)="E" D ^DIR Q:+Y<1
  1.  W !!,"  Enter '2' or 'YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA"
  1.  W !,"                COMPENSATION' if the veteran:"
  1.  W !,"       -- Is confirmed by the Military Branch to have been discharged"
  1.  W !,"          or released due to a disability incurred in or aggravated"
  1.  W !,"          while on active duty AND"
  1.  W !,"       -- Is receiving military disability retirement pay AND"
  1.  W !,"       -- Has been rated by VA to have compensable SC conditions"
  1.  W !,"          but is NOT receiving compensation from the VA"
  1.  W !!,"          Once eligibility has been verified, this field will no longer"
  1.  W !,"          be editable to any user who does not hold the designated security"
  1.  W !,"          key."
  1.  Q
  1. HLP3602 ;help text for field .3602, Rec'ing Disability in Lieu of VA Comp
  1.  W !,"     Enter 'Y' if this veteran applicant is receiving disability"
  1.  W !,"     retirement pay from the Military instead of VA compensation."
  1.  W !,"     Enter 'N' if this veteran applicant is not receiving disability"
  1.  W !,"     retirement pay from the Military instead of VA compensation."
  1.  W !,"     Once eligibility has been verified by HEC this field will no longer "
  1.  W !,"     be editable by VistA users. Send updates and/or requests to HEC."
  1.  Q
  1. HLP3603 ;help text for field .3603, Discharge Due to LOD Disability
  1.  W !,"     Enter 'Y' if this veteran applicant was discharged from the"
  1.  W !,"     military for a disability incurred or aggravated in the line "
  1.  W !,"     of duty.  Enter 'N' if this veteran applicant was not discharged"
  1.  W !,"     from the military for a disability incurred or aggravated in the"
  1.  W !,"     line of duty. Once eligibility has been verified by HEC this field"
  1.  W !,"     will no longer be editable by VistA users. Send updates and/or requests"
  1.  W !,"     to HEC."
  1.  Q
  1. SSNNM(DFN) ; SSN and name on first line of screen
  1.  N X,SSN
  1.  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)
  1.  S X=$P(X,U)_"; "_SSN
  1.  Q X
  1.  ;