- 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 Jan 18, 2025@03:46:26 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