EASECV ;ALB/PHH - View an LTC Co-Pay Test ; 20 AUG 2001
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7**;Mar 15, 2001
;
EN ;Entry point to view an LTC Co-Pay test
S DIC("S")="I $D(^DGMT(408.31,""AID"",3,+Y))"
S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q:Y<0 S DFN=+Y
;
DT S DIC("A")="Select DATE OF TEST: "
I $D(^DGMT(408.31,+$$LST^EASECU(DFN,"",DGMTYPT),0)) S DIC("B")=$P(^(0),"^")
S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,19)=DGMTYPT"
S DIC="^DGMT(408.31,",DIC(0)="EQZ" W ! D EN^DGMTLK K DIC G Q:Y<0
S DGMTI=+Y,DGMTDT=$P(Y,"^",2),DGMT0=Y(0)
;
EN1 ;Entry point to view an uneditable test
;JAN;12/13/00;DG*5.3*346;Change G EN to G EN1Q. This allowed the code to quit back to VIEWPRT+4^EASECE, then back to DT+9^EASECE then GO to EN^EASECE.
D DIS I $D(DTOUT)!($D(DUOUT))!($G(DGERR)) K DGERR,DTOUT,DUOUT G EN1Q
S DGMTACT="VEW",DGMTROU=$S($G(DGMTERR):"EN1Q^EASECV",1:"EN^EASECV") G EN^EASECSC
;
Q K DFN,DGMTACT,DGMTDT,DGMTERR,DGMTI,DGMT0,DGMTROU,DGMTYPT,DTOUT,DUOUT,X,Y
EN1Q Q
;
DIS ;Display LTC Co-Pay test data
N DA,DGCONTOT,DGDEP,DGINC,DGINR,DGREL,DIC,DIR,DR,Y
D ALL^EASECU21(DFN,"VSC",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
D DISPLAY^EASECU23(DGMTI,DGMTYPT)
I '$D(DGREL("V"))!('$D(DGINC("V")))!('$D(DGINR("V"))) D
.W !?2,*7,"** DETAILED LTC COPAY TEST INCOME INFORMATION IS NOT "
.I $P(DGMT0,U,3)=12!($P(DGMT0,U,14))=1 W "REQUIRED **",!
.E W "AVAILABLE **",1
.S DGERR=1
I '$G(DGERR),$D(^DGMT(408.21,+$G(DGINC("V")),"TOT")),$P(DGMT0,"^",4)]"" S DGCONTOT=^("TOT") D CHK
I '$G(DGERR),$P(DGMT0,"^",3)=12 W !?2,*7,"** LTC COPAY TEST IS NO LONGER REQUIRED, INCOME INFORMATION MAY NOT BE ACCURATE **",!
S DIR(0)="E" D ^DIR
Q
;
CHK ;Check for spouse and children totals NOT converted
N DGCTOT,DGSTOT,DGVIR0
S DGVIR0=$G(^DGMT(408.22,+$G(DGINR("V")),0))
I '$D(DGINC("S")),$P(DGVIR0,"^",5),($P(DGCONTOT,"^")]""!($P(DGCONTOT,"^",2)]"")) S DGSTOT=$P(DGCONTOT,"^",1,2)
I '$D(DGINC("C")),$P(DGVIR0,"^",8),($P(DGCONTOT,"^",3)]""!($P(DGCONTOT,"^",4)]"")) S DGCTOT=$P(DGCONTOT,"^",3,4)
D WRT:$D(DGSTOT)!($D(DGCTOT))
Q
;
WRT ;Write spouse and children totals NOT converted
W !?2,*7,"DETAILED LTC COPAY TEST INCOME INFORMATION COULD NOT BE CONVERTED FOR THE",!?2,"FOLLOWING RELATIONS ASSOCIATED WITH THIS LTC COPAY TEST:"
W !!?27,"INCOME",?37,"NET WORTH",!?27,"------",?37,"---------"
W:$D(DGSTOT) !?2,"SPOUSE",?22,$J($$AMT^DGMTSCU1($P(DGSTOT,"^")),11),?35,$J($$AMT^DGMTSCU1($P(DGSTOT,"^",2)),11)
W:$D(DGCTOT) !?2,"CHILDREN",?22,$J($$AMT^DGMTSCU1($P(DGCTOT,"^")),11),?35,$J($$AMT^DGMTSCU1($P(DGCTOT,"^",2)),11)
W !!?2,"TO COLLECT THE NEW DETAILED DEPENDENT DEMOGRAPHIC AND INCOME INFORMATION",!?2,"THE LTC COPAY TEST WOULD HAVE TO BE EDITED.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECV 2721 printed Apr 09, 2024@20:58:55 Page 2
EASECV ;ALB/PHH - View an LTC Co-Pay Test ; 20 AUG 2001
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7**;Mar 15, 2001
+2 ;
EN ;Entry point to view an LTC Co-Pay test
+1 SET DIC("S")="I $D(^DGMT(408.31,""AID"",3,+Y))"
+2 SET DIC="^DPT("
SET DIC(0)="AEMQ"
WRITE !
DO ^DIC
KILL DIC
if Y<0
GOTO Q
SET DFN=+Y
+3 ;
DT SET DIC("A")="Select DATE OF TEST: "
+1 IF $DATA(^DGMT(408.31,+$$LST^EASECU(DFN,"",DGMTYPT),0))
SET DIC("B")=$PIECE(^(0),"^")
+2 SET DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,19)=DGMTYPT"
+3 SET DIC="^DGMT(408.31,"
SET DIC(0)="EQZ"
WRITE !
DO EN^DGMTLK
KILL DIC
if Y<0
GOTO Q
+4 SET DGMTI=+Y
SET DGMTDT=$PIECE(Y,"^",2)
SET DGMT0=Y(0)
+5 ;
EN1 ;Entry point to view an uneditable test
+1 ;JAN;12/13/00;DG*5.3*346;Change G EN to G EN1Q. This allowed the code to quit back to VIEWPRT+4^EASECE, then back to DT+9^EASECE then GO to EN^EASECE.
+2 DO DIS
IF $DATA(DTOUT)!($DATA(DUOUT))!($GET(DGERR))
KILL DGERR,DTOUT,DUOUT
GOTO EN1Q
+3 SET DGMTACT="VEW"
SET DGMTROU=$SELECT($GET(DGMTERR):"EN1Q^EASECV",1:"EN^EASECV")
GOTO EN^EASECSC
+4 ;
Q KILL DFN,DGMTACT,DGMTDT,DGMTERR,DGMTI,DGMT0,DGMTROU,DGMTYPT,DTOUT,DUOUT,X,Y
EN1Q QUIT
+1 ;
DIS ;Display LTC Co-Pay test data
+1 NEW DA,DGCONTOT,DGDEP,DGINC,DGINR,DGREL,DIC,DIR,DR,Y
+2 DO ALL^EASECU21(DFN,"VSC",DGMTDT,"IPR",$SELECT($GET(DGMTI):DGMTI,1:""))
+3 DO DISPLAY^EASECU23(DGMTI,DGMTYPT)
+4 IF '$DATA(DGREL("V"))!('$DATA(DGINC("V")))!('$DATA(DGINR("V")))
Begin DoDot:1
+5 WRITE !?2,*7,"** DETAILED LTC COPAY TEST INCOME INFORMATION IS NOT "
+6 IF $PIECE(DGMT0,U,3)=12!($PIECE(DGMT0,U,14))=1
WRITE "REQUIRED **",!
+7 IF '$TEST
WRITE "AVAILABLE **",1
+8 SET DGERR=1
End DoDot:1
+9 IF '$GET(DGERR)
IF $DATA(^DGMT(408.21,+$GET(DGINC("V")),"TOT"))
IF $PIECE(DGMT0,"^",4)]""
SET DGCONTOT=^("TOT")
DO CHK
+10 IF '$GET(DGERR)
IF $PIECE(DGMT0,"^",3)=12
WRITE !?2,*7,"** LTC COPAY TEST IS NO LONGER REQUIRED, INCOME INFORMATION MAY NOT BE ACCURATE **",!
+11 SET DIR(0)="E"
DO ^DIR
+12 QUIT
+13 ;
CHK ;Check for spouse and children totals NOT converted
+1 NEW DGCTOT,DGSTOT,DGVIR0
+2 SET DGVIR0=$GET(^DGMT(408.22,+$GET(DGINR("V")),0))
+3 IF '$DATA(DGINC("S"))
IF $PIECE(DGVIR0,"^",5)
IF ($PIECE(DGCONTOT,"^")]""!($PIECE(DGCONTOT,"^",2)]""))
SET DGSTOT=$PIECE(DGCONTOT,"^",1,2)
+4 IF '$DATA(DGINC("C"))
IF $PIECE(DGVIR0,"^",8)
IF ($PIECE(DGCONTOT,"^",3)]""!($PIECE(DGCONTOT,"^",4)]""))
SET DGCTOT=$PIECE(DGCONTOT,"^",3,4)
+5 if $DATA(DGSTOT)!($DATA(DGCTOT))
DO WRT
+6 QUIT
+7 ;
WRT ;Write spouse and children totals NOT converted
+1 WRITE !?2,*7,"DETAILED LTC COPAY TEST INCOME INFORMATION COULD NOT BE CONVERTED FOR THE",!?2,"FOLLOWING RELATIONS ASSOCIATED WITH THIS LTC COPAY TEST:"
+2 WRITE !!?27,"INCOME",?37,"NET WORTH",!?27,"------",?37,"---------"
+3 if $DATA(DGSTOT)
WRITE !?2,"SPOUSE",?22,$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGSTOT,"^")),11),?35,$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGSTOT,"^",2)),11)
+4 if $DATA(DGCTOT)
WRITE !?2,"CHILDREN",?22,$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGCTOT,"^")),11),?35,$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGCTOT,"^",2)),11)
+5 WRITE !!?2,"TO COLLECT THE NEW DETAILED DEPENDENT DEMOGRAPHIC AND INCOME INFORMATION",!?2,"THE LTC COPAY TEST WOULD HAVE TO BE EDITED.",!
+6 QUIT
