- 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 Feb 18, 2025@23:20:46 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
