- DGMTREM ;ALB/CAW - Comments for Means Test ; 04/28/2003 2:00 pm
- ;;5.3;Registration;**45,182,513,1015**;Aug 13, 1993;Build 21
- ;
- EN ;Entry point to place comments concerning a 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 MTDT=X,MTIEN=Y I $$PRIM^DGMTREM(MTDT,MTIEN)"
- 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)
- ;
- ;
- I '$P($G(^DG(408.34,+$P(Y(0),U,23),0)),U,2) D G:$G(DGERR) Q
- .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")
- .W !?12,"which has been flagged as an uneditable source.",! S DGERR=1
- D DISPLAY^DGMTU23(DGMTI,DGMTYPT),PAUSE I $D(DTOUT)!($D(DUOUT)) K DTOUT,DUOUT G EN
- ; Comment enter/edit
- S DA=DGMTI,DR="[DGMT COMMENTS]",DIE="^DGMT(408.31," D ^DIE
- ;
- Q K DFN,DGMTACT,DGMTDT,DGMTERR,DGMT0,DGMTI,DGMTROU,DGMTYPT,DGMTX,DTOUT,DUOUT,X,Y
- Q
- ;
- PAUSE S DIR(0)="E" D ^DIR
- Q
- ;
- PRIM(DGMTDT,DGMTIEN) ;
- ; Find Primary Test for Income Year, and allow for a Future Dated Test
- ;
- I ^DGMT(408.31,DGMTIEN,"PRIM")=1 Q 1
- I DGMTDT>DT,$O(^DGMT(408.31,"AD",1,DFN,DGMTDT,""),-1)=DGMTIEN Q 1
- ;
- Q 0
- DGMTREM ;ALB/CAW - Comments for Means Test ; 04/28/2003 2:00 pm
- +1 ;;5.3;Registration;**45,182,513,1015**;Aug 13, 1993;Build 21
- +2 ;
- EN ;Entry point to place comments concerning a 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 S MTDT=X,MTIEN=Y I $$PRIM^DGMTREM(MTDT,MTIEN)"
- +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 ;
- +6 ;
- +7 IF '$PIECE($GET(^DG(408.34,+$PIECE(Y(0),U,23),0)),U,2)
- Begin DoDot:1
- +8 WRITE !!?3,*7,"Warning: Uneditable "_$SELECT(DGMTYPT=1:"means",1:"copay")_" test. The source of this test is "_$SELECT($$SR^DGMTAUD1(Y(0))]"":$$SR^DGMTAUD1(Y(0)),1:"UNKNOWN")
- +9 WRITE !?12,"which has been flagged as an uneditable source.",!
- SET DGERR=1
- End DoDot:1
- IF $GET(DGERR)
- GOTO Q
- +10 DO DISPLAY^DGMTU23(DGMTI,DGMTYPT)
- DO PAUSE
- IF $DATA(DTOUT)!($DATA(DUOUT))
- KILL DTOUT,DUOUT
- GOTO EN
- +11 ; Comment enter/edit
- +12 SET DA=DGMTI
- SET DR="[DGMT COMMENTS]"
- SET DIE="^DGMT(408.31,"
- DO ^DIE
- +13 ;
- Q KILL DFN,DGMTACT,DGMTDT,DGMTERR,DGMT0,DGMTI,DGMTROU,DGMTYPT,DGMTX,DTOUT,DUOUT,X,Y
- +1 QUIT
- +2 ;
- PAUSE SET DIR(0)="E"
- DO ^DIR
- +1 QUIT
- +2 ;
- PRIM(DGMTDT,DGMTIEN) ;
- +1 ; Find Primary Test for Income Year, and allow for a Future Dated Test
- +2 ;
- +3 IF ^DGMT(408.31,DGMTIEN,"PRIM")=1
- QUIT 1
- +4 IF DGMTDT>DT
- IF $ORDER(^DGMT(408.31,"AD",1,DFN,DGMTDT,""),-1)=DGMTIEN
- QUIT 1
- +5 ;
- +6 QUIT 0
