| 1 | DGMTAUD2 ;ALB/CAW,BRM - Means test audit delete ; 12/20/01 9:22am
|
|---|
| 2 | ;;5.3;Registration;**45,166,182,300,433**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | DIS ;Display changes pertaining to a means test for a vet
|
|---|
| 5 | ;
|
|---|
| 6 | LKP ;Vet lookup
|
|---|
| 7 | S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G:$D(DTOUT)!($D(DUOUT))!(+Y<0) KIL
|
|---|
| 8 | I '$O(^DGMT(408.31,"AD",DGMTYPT,+Y,0)) W !?5,$P(Y(0),U)," has no "_$P("means^copay^^LTC exemption","^",DGMTYPT)_" test on file." K DIC,Y G LKP
|
|---|
| 9 | S DFN=+Y,DGNAM=$P(Y(0),U) K DIC,Y
|
|---|
| 10 | ;
|
|---|
| 11 | LKM ;Means test lookup
|
|---|
| 12 | S DIC("W")="W ?27,$P(""MEANS^COPAY^^LTC EXEMPTION"",""^"",DGMTYPT)_"" TEST "",?42,$S($G(^DGMT(408.31,+Y,""PRIM""))=1:"" **PRIMARY** "",1:""""),?60,$$SR^DGMTAUD1($G(^DGMT(408.31,+Y,0)),+Y)",DIC("S")="I $P(^(0),U,2)=DFN&($P(^(0),U,19)=DGMTYPT)"
|
|---|
| 13 | S DIC="^DGMT(408.31,",DIC(0)="EQZ",X=DFN,D="C" D IX^DIC K DIC I X["?" W !,"Enter appropriate corresponding number." G LKM
|
|---|
| 14 | I $D(DTOUT)!($D(DUOUT)) D KIL Q
|
|---|
| 15 | I +Y<0 G LKP
|
|---|
| 16 | S DGMTI=+Y,DGMTD=$P(Y(0),U) K DIC,Y
|
|---|
| 17 | S DGDASH="",$P(DGDASH,"=",79)="" D HDR^DGMTAUD1 I '$O(^DGMT(408.41,"AM",DGMTYPT,DFN,DGMTI,0)) W !?5,"There are no changes to the "_$P("means^copay^^LTC exemption","^",DGMTYPT)_" test.",! G KIL
|
|---|
| 18 | ;
|
|---|
| 19 | ;Loop thru xref;write data
|
|---|
| 20 | S DGMTAI=0 F S DGMTAI=$O(^DGMT(408.41,"AM",DGMTYPT,DFN,DGMTI,DGMTAI)) Q:'DGMTAI S DGMTAIZ=$G(^DGMT(408.41,DGMTAI,0)) I DGMTAIZ]"" D:IOSL'>($Y+4) CR G:$D(DTOUT)!($D(DUOUT)) KIL D
|
|---|
| 21 | .W !?2,$$D^DGMTAUD1($P(DGMTAIZ,U)),?23,$$C^DGMTAUD1($P(DGMTAIZ,U,2)),?57,$E($$U^DGMTAUD1($P(DGMTAIZ,U,7)),1,20)
|
|---|
| 22 | .I $P(DGMTAIZ,U,5,6)'="^" W !?23,"OLD STATUS VALUE: ",$S($P(DGMTAIZ,U,5)']"":"<Nothing>",1:$P(DGMTAIZ,U,5)),!?23,"NEW STATUS VALUE: ",$S($P(DGMTAIZ,U,6)']"":"<Nothing>",1:$P(DGMTAIZ,U,6))
|
|---|
| 23 | .I $P(DGMTAIZ,U,8,9)'="^" W !?23,"OLD SOURCE OF TEST: ",$S($P(DGMTAIZ,U,8)']"":"<Nothing>",1:$P(DGMTAIZ,U,8)),!?23,"NEW SOURCE OF TEST: ",$S($P(DGMTAIZ,U,9)']"":"<Nothing>",1:$P(DGMTAIZ,U,9))
|
|---|
| 24 | G LKP
|
|---|
| 25 | ;
|
|---|
| 26 | KIL K D,DGDASH,DGMTAI,DGMTAIZ,DGMTD,DGMTI,DGMTYPT,DGNAM,DFN,DIC,DTOUT,DUOUT,X,Y
|
|---|
| 27 | Q
|
|---|
| 28 | CR I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR W:'Y @IOF D:Y HDR^DGMTAUD1
|
|---|
| 29 | Q
|
|---|
