source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTAUD2.m@ 834

Last change on this file since 834 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 2.0 KB
RevLine 
[613]1DGMTAUD2 ;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 ;
4DIS ;Display changes pertaining to a means test for a vet
5 ;
6LKP ;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 ;
11LKM ;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 ;
26KIL K D,DGDASH,DGMTAI,DGMTAIZ,DGMTD,DGMTI,DGMTYPT,DGNAM,DFN,DIC,DTOUT,DUOUT,X,Y
27 Q
28CR I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR W:'Y @IOF D:Y HDR^DGMTAUD1
29 Q
Note: See TracBrowser for help on using the repository browser.