- 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 Mar 13, 2025@20:58:51 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
