DGMTV ;ALB/RMO/CAW/LD/JAN - View a Past Means Test ;12/13/2000
;;5.3;Registration;**33,45,346**;Aug 13, 1993
;
EN ;Entry point to view a past means test
I DGMTYPT=1 S DIC("S")="I $P(^(0),U,14)"
I DGMTYPT=2 S DIC("S")="I $D(^DGMT(408.31,""AID"",DGMTYPT,+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^DGMTU(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^DGMTE, then back to DT+9^DGMTE then GO to EN^DGMTE.
D DIS I $D(DTOUT)!($D(DUOUT))!($G(DGERR)) K DGERR,DTOUT,DUOUT G EN1Q
S DGMTACT="VEW",DGMTROU=$S($G(DGMTERR):"EN1Q^DGMTV",1:"EN^DGMTV") G EN^DGMTSC
;
Q K DFN,DGMTACT,DGMTDT,DGMTERR,DGMTI,DGMT0,DGMTROU,DGMTYPT,DTOUT,DUOUT,X,Y
EN1Q Q
;
DIS ;Display means test data
N DA,DGCONTOT,DGDEP,DGINC,DGINR,DGREL,DIC,DIR,DR,Y
D ALL^DGMTU21(DFN,"VSC",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
D DISPLAY^DGMTU23(DGMTI,DGMTYPT)
I '$D(DGREL("V"))!('$D(DGINC("V")))!('$D(DGINR("V"))) W !?2,*7,"** DETAILED "_$S(DGMTYPT=1:"MEANS",1:"COPAY")_" TEST INCOME INFORMATION IS NOT AVAILABLE **",! 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)=3 W !?2,*7,"** MEANS TEST IS NO LONGER REQUIRED INCOME INFORMATION MAY NOT BE ACCURATE **",!
I '$G(DGERR),$P(DGMT0,"^",3)=10 W !?2,*7,"** COPAY TEST IS NO LONGER APPLICABLE 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 MEANS TEST INCOME INFORMATION COULD NOT BE CONVERTED FOR THE",!?2,"FOLLOWING RELATIONS ASSOCIATED WITH THIS MEANS 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 MEANS TEST WOULD HAVE TO BE EDITED.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTV 2820 printed Oct 16, 2024@18:46:23 Page 2
DGMTV ;ALB/RMO/CAW/LD/JAN - View a Past Means Test ;12/13/2000
+1 ;;5.3;Registration;**33,45,346**;Aug 13, 1993
+2 ;
EN ;Entry point to view a past means test
+1 IF DGMTYPT=1
SET DIC("S")="I $P(^(0),U,14)"
+2 IF DGMTYPT=2
SET DIC("S")="I $D(^DGMT(408.31,""AID"",DGMTYPT,+Y))"
+3 SET DIC="^DPT("
SET DIC(0)="AEMQ"
WRITE !
DO ^DIC
KILL DIC
if Y<0
GOTO Q
SET DFN=+Y
+4 ;
DT SET DIC("A")="Select DATE OF TEST: "
+1 IF $DATA(^DGMT(408.31,+$$LST^DGMTU(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^DGMTE, then back to DT+9^DGMTE then GO to EN^DGMTE.
+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^DGMTV",1:"EN^DGMTV")
GOTO EN^DGMTSC
+4 ;
Q KILL DFN,DGMTACT,DGMTDT,DGMTERR,DGMTI,DGMT0,DGMTROU,DGMTYPT,DTOUT,DUOUT,X,Y
EN1Q QUIT
+1 ;
DIS ;Display means test data
+1 NEW DA,DGCONTOT,DGDEP,DGINC,DGINR,DGREL,DIC,DIR,DR,Y
+2 DO ALL^DGMTU21(DFN,"VSC",DGMTDT,"IPR",$SELECT($GET(DGMTI):DGMTI,1:""))
+3 DO DISPLAY^DGMTU23(DGMTI,DGMTYPT)
+4 IF '$DATA(DGREL("V"))!('$DATA(DGINC("V")))!('$DATA(DGINR("V")))
WRITE !?2,*7,"** DETAILED "_$SELECT(DGMTYPT=1:"MEANS",1:"COPAY")_" TEST INCOME INFORMATION IS NOT AVAILABLE **",!
SET DGERR=1
+5 IF '$GET(DGERR)
IF $DATA(^DGMT(408.21,+$GET(DGINC("V")),"TOT"))
IF $PIECE(DGMT0,"^",4)]""
SET DGCONTOT=^("TOT")
DO CHK
+6 IF '$GET(DGERR)
IF $PIECE(DGMT0,"^",3)=3
WRITE !?2,*7,"** MEANS TEST IS NO LONGER REQUIRED INCOME INFORMATION MAY NOT BE ACCURATE **",!
+7 IF '$GET(DGERR)
IF $PIECE(DGMT0,"^",3)=10
WRITE !?2,*7,"** COPAY TEST IS NO LONGER APPLICABLE INCOME INFORMATION MAY NOT BE ACCURATE **",!
+8 SET DIR(0)="E"
DO ^DIR
+9 QUIT
+10 ;
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 MEANS TEST INCOME INFORMATION COULD NOT BE CONVERTED FOR THE",!?2,"FOLLOWING RELATIONS ASSOCIATED WITH THIS MEANS 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 MEANS TEST WOULD HAVE TO BE EDITED.",!
+6 QUIT
