| 1 | DGMTREM ;ALB/CAW - Comments for Means Test ; 04/28/2003 2:00 pm
|
|---|
| 2 | ;;5.3;Registration;**45,182,513**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;Entry point to place comments concerning a means test
|
|---|
| 5 | I DGMTYPT=1 S DIC("S")="I $P(^(0),U,14)"
|
|---|
| 6 | I DGMTYPT=2 S DIC("S")="I $D(^DGMT(408.31,""AID"",DGMTYPT,+Y))"
|
|---|
| 7 | S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q:Y<0 S DFN=+Y
|
|---|
| 8 | ;
|
|---|
| 9 | DT S DIC("A")="Select DATE OF TEST: "
|
|---|
| 10 | I $D(^DGMT(408.31,+$$LST^DGMTU(DFN,"",DGMTYPT),0)) S DIC("B")=$P(^(0),"^")
|
|---|
| 11 | S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,19)=DGMTYPT S MTDT=X,MTIEN=Y I $$PRIM^DGMTREM(MTDT,MTIEN)"
|
|---|
| 12 | S DIC="^DGMT(408.31,",DIC(0)="EQZ" W ! D EN^DGMTLK K DIC G Q:Y<0
|
|---|
| 13 | S DGMTI=+Y,DGMTDT=$P(Y,"^",2),DGMT0=Y(0)
|
|---|
| 14 | ;
|
|---|
| 15 | ;
|
|---|
| 16 | I '$P($G(^DG(408.34,+$P(Y(0),U,23),0)),U,2) D G:$G(DGERR) Q
|
|---|
| 17 | .W !!?3,*7,"Warning: Uneditable "_$S(DGMTYPT=1:"means",1:"copay")_" test. The source of this test is "_$S($$SR^DGMTAUD1(Y(0))]"":$$SR^DGMTAUD1(Y(0)),1:"UNKNOWN")
|
|---|
| 18 | .W !?12,"which has been flagged as an uneditable source.",! S DGERR=1
|
|---|
| 19 | D DISPLAY^DGMTU23(DGMTI,DGMTYPT),PAUSE I $D(DTOUT)!($D(DUOUT)) K DTOUT,DUOUT G EN
|
|---|
| 20 | ; Comment enter/edit
|
|---|
| 21 | S DA=DGMTI,DR="[DGMT COMMENTS]",DIE="^DGMT(408.31," D ^DIE
|
|---|
| 22 | ;
|
|---|
| 23 | Q K DFN,DGMTACT,DGMTDT,DGMTERR,DGMT0,DGMTI,DGMTROU,DGMTYPT,DGMTX,DTOUT,DUOUT,X,Y
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | PAUSE S DIR(0)="E" D ^DIR
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | PRIM(DGMTDT,DGMTIEN) ;
|
|---|
| 30 | ; Find Primary Test for Income Year, and allow for a Future Dated Test
|
|---|
| 31 | ;
|
|---|
| 32 | I ^DGMT(408.31,DGMTIEN,"PRIM")=1 Q 1
|
|---|
| 33 | I DGMTDT>DT,$O(^DGMT(408.31,"AD",1,DFN,DGMTDT,""),-1)=DGMTIEN Q 1
|
|---|
| 34 | ;
|
|---|
| 35 | Q 0
|
|---|
