EASECSC2 ;ALB/PHH,LBD - LTC Copay Test Screen Insurance Information ;18 AUG 2001
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,40,45**;Mar 15, 2001
;
; Input -- DFN Patient IEN
; DGMTACT LTC Co-Pay Test Action
; DGVINI Veteran Individual Annual Income IEN
; DGVIRI Veteran Income Relation IEN
; DGVPRI Veteran Patient Relation IEN
; Output -- None
;
; ** For LTC Phase IV (EAS*1*40) this routine has been modified to
; display the patient's insurance information instead of
; eligibility
;
EN ;Entry point
D ^DGRPV
D EASECRP5
S X="^3"
S:$$PAUSE(0) X="^"
K DGRP,DGRPCM,DGRPLAST,DGRPNA,DGRPS,DGRPSCE1,DGRPTYPE,DGRPU,DGRPV,DGRPVV,DGRPW,DGRPX,Z1
G EN1^EASECSCR
Q
PAUSE(RESP) ; Prompt user for next page or quit
N DIR,DIRUT,DUOUT,DTOUT,I,X,Y
F I=$Y:1:20 W !
S DIR(0)="E"
D ^DIR
I 'Y S RESP=1
Q RESP
;
EASECRP5 ; Display the screen
; Note: This section was copied from ^DGRP5 and modified specifically
; to work with LTC.
;
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
W ! D DISP^DGIBDSP
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)
S Y=$P(DGRPX,"^",2) I Y X ^DD("DD") W " [last updated ",Y,"]"
;; *** Added for Medicaid information
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:"")
Q
IN Q ;
;
WW ;Write number on screens for display and/or edit (Z=number)
; NOTE: This section was copied from WW^DGRPV and modified specifically
; for LTC. The code calling ^DGRPV has been redirected here.
W:DGRPW !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECSC2 1851 printed Nov 22, 2024@17:04:18 Page 2
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
+2 ;
+3 ; Input -- DFN Patient IEN
+4 ; DGMTACT LTC Co-Pay Test Action
+5 ; DGVINI Veteran Individual Annual Income IEN
+6 ; DGVIRI Veteran Income Relation IEN
+7 ; DGVPRI Veteran Patient Relation IEN
+8 ; Output -- None
+9 ;
+10 ; ** For LTC Phase IV (EAS*1*40) this routine has been modified to
+11 ; display the patient's insurance information instead of
+12 ; eligibility
+13 ;
EN ;Entry point
+1 DO ^DGRPV
+2 DO EASECRP5
+3 SET X="^3"
+4 if $$PAUSE(0)
SET X="^"
+5 KILL DGRP,DGRPCM,DGRPLAST,DGRPNA,DGRPS,DGRPSCE1,DGRPTYPE,DGRPU,DGRPV,DGRPVV,DGRPW,DGRPX,Z1
+6 GOTO EN1^EASECSCR
+7 QUIT
PAUSE(RESP) ; Prompt user for next page or quit
+1 NEW DIR,DIRUT,DUOUT,DTOUT,I,X,Y
+2 FOR I=$Y:1:20
WRITE !
+3 SET DIR(0)="E"
+4 DO ^DIR
+5 IF 'Y
SET RESP=1
+6 QUIT RESP
+7 ;
EASECRP5 ; Display the screen
+1 ; Note: This section was copied from ^DGRP5 and modified specifically
+2 ; to work with LTC.
+3 ;
+4 SET DGRPW=1
SET (DGRPS,DGMTSCI)=2
DO HD^EASECSCU
SET Z=1
DO WW
WRITE " Covered by Health Insurance: "
SET Z=$SELECT($DATA(^DPT(DFN,.31)):$PIECE(^(.31),"^",11),1:"")
SET Z=$SELECT(Z="Y":"YES",Z="N":"NO",Z="U":"UNKNOWN",1:"NOT ANSWERED")
SET Z1=15
DO WW1^DGRPV
+5 WRITE !
DO DISP^DGIBDSP
+6 WRITE !
SET DGRPX=$GET(^DPT(DFN,.38))
SET Z=2
DO WW
WRITE " Eligible for MEDICAID: ",$SELECT(+DGRPX:"YES",$PIECE(DGRPX,"^",1)=0:"NO",1:DGRPU)
+7 SET Y=$PIECE(DGRPX,"^",2)
IF Y
XECUTE ^DD("DD")
WRITE " [last updated ",Y,"]"
+8 ;; *** Added for Medicaid information
+9 ;previous $S($P(DGRPX,U,3)>0:$P(DGRPX,U,3),1:"")
WRITE !
SET Z=3
DO WW
WRITE " Medicaid Number: ",$PIECE(DGRPX,U,3)
+10 QUIT
IN ;
QUIT
+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
+2 ; for LTC. The code calling ^DGRPV has been redirected here.
+3 if DGRPW
WRITE !
+4 QUIT
