EASECSC2.m

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 ---EASECSC2   1851     printed  Apr 09, 2024@21:00:50                                                                                                                                                                                                    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