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

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1DGMTREM ;ALB/CAW - Comments for Means Test ; 04/28/2003 2:00 pm
2 ;;5.3;Registration;**45,182,513**;Aug 13, 1993
3 ;
4EN ;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 ;
9DT 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 ;
23Q K DFN,DGMTACT,DGMTDT,DGMTERR,DGMT0,DGMTI,DGMTROU,DGMTYPT,DGMTX,DTOUT,DUOUT,X,Y
24 Q
25 ;
26PAUSE S DIR(0)="E" D ^DIR
27 Q
28 ;
29PRIM(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
Note: See TracBrowser for help on using the repository browser.