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

EASECSC2.m

Go to the documentation of this file.
  1. EASECSC2 ;ALB/PHH,LBD - LTC Copay Test Screen Insurance Information ;18 AUG 2001
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,40,45**;Mar 15, 2001
  1. ;
  1. ; Input -- DFN Patient IEN
  1. ; DGMTACT LTC Co-Pay Test Action
  1. ; DGVINI Veteran Individual Annual Income IEN
  1. ; DGVIRI Veteran Income Relation IEN
  1. ; DGVPRI Veteran Patient Relation IEN
  1. ; Output -- None
  1. ;
  1. ; ** For LTC Phase IV (EAS*1*40) this routine has been modified to
  1. ; display the patient's insurance information instead of
  1. ; eligibility
  1. ;
  1. EN ;Entry point
  1. D ^DGRPV
  1. D EASECRP5
  1. S X="^3"
  1. S:$$PAUSE(0) X="^"
  1. K DGRP,DGRPCM,DGRPLAST,DGRPNA,DGRPS,DGRPSCE1,DGRPTYPE,DGRPU,DGRPV,DGRPVV,DGRPW,DGRPX,Z1
  1. G EN1^EASECSCR
  1. Q
  1. PAUSE(RESP) ; Prompt user for next page or quit
  1. N DIR,DIRUT,DUOUT,DTOUT,I,X,Y
  1. F I=$Y:1:20 W !
  1. S DIR(0)="E"
  1. D ^DIR
  1. I 'Y S RESP=1
  1. Q RESP
  1. ;
  1. EASECRP5 ; Display the screen
  1. ; Note: This section was copied from ^DGRP5 and modified specifically
  1. ; to work with LTC.
  1. ;
  1. S DGRPW=1,(DGRPS,DGMTSCI)=2 D HD^EASECSCU S Z=1 D WW W " Covered by Health Insurance: " S Z=$S($D(^DPT(DFN,.31)):$P(^(.31),"^",11),1:""),Z=$S(Z="Y":"YES",Z="N":"NO",Z="U":"UNKNOWN",1:"NOT ANSWERED"),Z1=15 D WW1^DGRPV
  1. W ! D DISP^DGIBDSP
  1. W ! S DGRPX=$G(^DPT(DFN,.38)),Z=2 D WW W " Eligible for MEDICAID: ",$S(+DGRPX:"YES",$P(DGRPX,"^",1)=0:"NO",1:DGRPU)
  1. S Y=$P(DGRPX,"^",2) I Y X ^DD("DD") W " [last updated ",Y,"]"
  1. ;; *** Added for Medicaid information
  1. W ! S Z=3 D WW W " Medicaid Number: ",$P(DGRPX,U,3) ;previous $S($P(DGRPX,U,3)>0:$P(DGRPX,U,3),1:"")
  1. Q
  1. IN Q ;
  1. ;
  1. WW ;Write number on screens for display and/or edit (Z=number)
  1. ; NOTE: This section was copied from WW^DGRPV and modified specifically
  1. ; for LTC. The code calling ^DGRPV has been redirected here.
  1. W:DGRPW !
  1. Q