DGMTE ;ALB/RMO,CAW,LD,SCG,BDB - Edit an Existing Means Test ;03 APR 2002 2:00 pm
;;5.3;Registration;**33,45,182,344,332,433,624,858**;Aug 13, 1993;Build 30
;
EN ;Entry point to edit an existing means test
N DGMDOD S DGMDOD=""
I DGMTYPT=1 S DIC("S")="I $P(^(0),U,14)"
I DGMTYPT=2!(DGMTYPT=4) S DIC("S")="I $D(^DGMT(408.31,""AID"",DGMTYPT,+Y))"
I $D(DGMTDFN)#2 D UNLOCK^DGMTUTL(DGMTDFN) K DGMTDFN
S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q:Y<0 S (DFN,DGMTDFN)=+Y
I $P($G(^DPT(DFN,.35)),U)'="" S DGMDOD=$P(^DPT(DFN,.35),U)
I $G(DGMDOD) W !,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D") Q
;
; check if income test upload in progress
D CKUPLOAD^IVMCUPL(DFN)
;
; obtain lock used to synchronize local MT/CT options with income test upload
I $$LOCK^DGMTUTL(DFN)
;
DT S DIC("A")="Select DATE OF TEST: "
N FUTFLG,VSITE,DGLSTDT S FUTFLG=0,VSITE=+$P($$SITE^VASITE(),U,3)
I $D(^DGMT(408.31,+$$FUT^DGMTU(DFN,"",DGMTYPT),0)),+$P($G(^(2)),U,5)=VSITE S DIC("B")=$P(^(0),"^"),FUTFLG=1
;cannot edit a means test that is more than 1 year old DG*5.3*858
I 'FUTFLG I $D(^DGMT(408.31,+$$LST^DGMTU(DFN,"",DGMTYPT),0)) S (DIC("B"),DGLSTDT)=$P(^(0),"^") I $$OLD^DGMTU4(DGLSTDT),(DGMTYPT=1) D K DIC G Q
. W !!,"Please use the Add a New Means Test Option.",!,"User may not edit a Means Test that is more than 1 year old."
S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,19)=DGMTYPT"
S:DGMTYPT'=4 DIC("S")=DIC("S")_" I $G(^(""PRIM""))!($P(^(0),U,1)>DT)"
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)
;
;If test is uneditable, print error message and allow user to view test
;or print 10-10EZ/EZR
;
I '$P($G(^DG(408.34,+$P(Y(0),U,23),0)),U,2) D D:$G(DGMTERR) VIEWPRT G EN
.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 DIR("A")="Would you like to view the "_$S(DGMTYPT=1:"means",1:"copay")_" test or print the 10-10EZR/EZ",DIR("B")="NO",DIR(0)="Y"
.D ^DIR K DIR S DGMTERR=Y I $D(DTOUT)!($D(DUOUT)) K DGMTERR,DTOUT,DUOUT
I "^3^10^"[("^"_$P(Y(0),"^",3)_"^") W !?3,*7,$S(DGMTYPT=1:"Means",1:"Copay")_" test is NO LONGER "_$S(DGMTYPT=1:"REQUIRED",1:"APPLICABLE")_", it cannot be edited." G EN
I DGMTYPT=4,$P($G(^DGMT(408.31,DGMTI,2)),U,8) D I $G(DGOUT) K DGOUT G EN
.N DGMT,DGT S DGMT=$P(^DGMT(408.31,DGMTI,2),U,8),DGT=$P($G(^DGMT(408.31,DGMT,0)),U,19)
.I DGT,DGT>2 Q
.W !!,?3,"This LTC copay exemption test is linked to the ",$$FTIME^DGMTUTL(+^DGMT(408.31,DGMT,0)),$S(DGT=1:" means",1:" RX copay")," test."
.W !,?3,"Changes should be made using the 'Edit an Existing ",$S(DGT=1:"Means",1:"Copay Exemption")," Test'"
.W !,?3,"menu option."
.S DGOUT=1
D DISPLAY^DGMTU23(DGMTI,DGMTYPT),PAUSE I $D(DTOUT)!($D(DUOUT)) K DTOUT,DUOUT G EN
;
;hardship determination, once granted, will remain unless deleted by
;hardship option
;I $P(DGMT0,"^",20),'$$EDIT() G EN ; if hardship
;
S DGMTACT="EDT",DGMTROU="EN^DGMTE" G EN^DGMTSC
;
Q K DFN,DGMTACT,DGMTDT,DGMTERR,DGMT0,DGMTI,DGMTROU,DGMTYPT,DGMTX,DGOUT,DTOUT,DUOUT,X,Y
;
; release lock used to synchronize local MT/CT options with income test upload
I $D(DGMTDFN)#2 D UNLOCK^DGMTUTL(DGMTDFN) K DGMTDFN
Q
;
PAUSE S DIR(0)="E" D ^DIR
Q
;
VIEWPRT ; Select 1 to view an uneditable means test or 2 to print a 10-10EZ/EZR
;
S DIR(0)="S^1:View Means Test;2:Print Means Test 10-10EZR/EZ",DIR("A")="Select Choice"
D ^DIR S DGMTANS=Y G:$D(DTOUT)!($D(DUOUT)) VIEWPRTQ
I DGMTANS=1 D EN1^DGMTV
I DGMTANS=2 D
.N RPTSEL,DGTASK
.D FULL^VALM1
.S (RPTSEL,DGTASK)=""
.I $D(DGFINOP) DO
..W !!,"Options for printing financial assessment information will follow."
..W !,"Generally, you should answer 'YES' to 'PRINT 10-10EZR?' after updating"
..W !,"patient demographic or financial information. Answer 'YES' to 'PRINT"
..W !,"10-10EZ?' after entering new patient demographic and financial information."
.S RPTSEL=$$SEL1010^DG1010P("EZR/EZ") ;*Select 1010EZ/R form to print
.S:RPTSEL'="-1" DGTASK=$$PRT1010^DG1010P(RPTSEL,DFN,DGMTI) ;*Print 1010EZ/R
;
VIEWPRTQ ;
K DGMTANS,DIR,DTOUT,DUOUT,Y
Q
;
EDIT() ; want to edit even though MT is hardship?
;
; Output: 1 if user wants to edit, 0 otherwise
;
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,I,X,Y
S DIR("?",1)="WARNING: You are about to access a means test for which a hardship has"
S DIR("?",2)=" been authorized. If you proceed, the hardship will be removed"
S DIR("?",3)=" and the means test category will be recalculated! To avoid"
S DIR("?",4)=" this problem, enter NO at the next prompt and use the 'View"
S DIR("?",5)=" a Past Means Test' option should you need to see details of"
S DIR("?",6)=" this means test."
S DIR("?",7)=" "
S DIR("?")="Enter NO to stop editing this means test. Enter YES to continue"
F I=1:1 Q:'$D(DIR("?",I)) W !,DIR("?",I)
S DIR("A")="Do you want to continue editing this means test? ",DIR("B")="NO",DIR(0)="YA"
D ^DIR
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTE 5163 printed Oct 16, 2024@18:45:31 Page 2
DGMTE ;ALB/RMO,CAW,LD,SCG,BDB - Edit an Existing Means Test ;03 APR 2002 2:00 pm
+1 ;;5.3;Registration;**33,45,182,344,332,433,624,858**;Aug 13, 1993;Build 30
+2 ;
EN ;Entry point to edit an existing means test
+1 NEW DGMDOD
SET DGMDOD=""
+2 IF DGMTYPT=1
SET DIC("S")="I $P(^(0),U,14)"
+3 IF DGMTYPT=2!(DGMTYPT=4)
SET DIC("S")="I $D(^DGMT(408.31,""AID"",DGMTYPT,+Y))"
+4 IF $DATA(DGMTDFN)#2
DO UNLOCK^DGMTUTL(DGMTDFN)
KILL DGMTDFN
+5 SET DIC="^DPT("
SET DIC(0)="AEMQ"
WRITE !
DO ^DIC
KILL DIC
if Y<0
GOTO Q
SET (DFN,DGMTDFN)=+Y
+6 IF $PIECE($GET(^DPT(DFN,.35)),U)'=""
SET DGMDOD=$PIECE(^DPT(DFN,.35),U)
+7 IF $GET(DGMDOD)
WRITE !,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D")
QUIT
+8 ;
+9 ; check if income test upload in progress
+10 DO CKUPLOAD^IVMCUPL(DFN)
+11 ;
+12 ; obtain lock used to synchronize local MT/CT options with income test upload
+13 IF $$LOCK^DGMTUTL(DFN)
+14 ;
DT SET DIC("A")="Select DATE OF TEST: "
+1 NEW FUTFLG,VSITE,DGLSTDT
SET FUTFLG=0
SET VSITE=+$PIECE($$SITE^VASITE(),U,3)
+2 IF $DATA(^DGMT(408.31,+$$FUT^DGMTU(DFN,"",DGMTYPT),0))
IF +$PIECE($GET(^(2)),U,5)=VSITE
SET DIC("B")=$PIECE(^(0),"^")
SET FUTFLG=1
+3 ;cannot edit a means test that is more than 1 year old DG*5.3*858
+4 IF 'FUTFLG
IF $DATA(^DGMT(408.31,+$$LST^DGMTU(DFN,"",DGMTYPT),0))
SET (DIC("B"),DGLSTDT)=$PIECE(^(0),"^")
IF $$OLD^DGMTU4(DGLSTDT)
IF (DGMTYPT=1)
Begin DoDot:1
+5 WRITE !!,"Please use the Add a New Means Test Option.",!,"User may not edit a Means Test that is more than 1 year old."
End DoDot:1
KILL DIC
GOTO Q
+6 SET DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,19)=DGMTYPT"
+7 if DGMTYPT'=4
SET DIC("S")=DIC("S")_" I $G(^(""PRIM""))!($P(^(0),U,1)>DT)"
+8 SET DIC="^DGMT(408.31,"
SET DIC(0)="EQZ"
WRITE !
DO EN^DGMTLK
KILL DIC
if Y<0
GOTO Q
+9 SET DGMTI=+Y
SET DGMTDT=$PIECE(Y,"^",2)
SET DGMT0=Y(0)
+10 ;
+11 ;If test is uneditable, print error message and allow user to view test
+12 ;or print 10-10EZ/EZR
+13 ;
+14 IF '$PIECE($GET(^DG(408.34,+$PIECE(Y(0),U,23),0)),U,2)
Begin DoDot:1
+15 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")
+16 WRITE !?12,"which has been flagged as an uneditable source.",!
+17 SET DIR("A")="Would you like to view the "_$SELECT(DGMTYPT=1:"means",1:"copay")_" test or print the 10-10EZR/EZ"
SET DIR("B")="NO"
SET DIR(0)="Y"
+18 DO ^DIR
KILL DIR
SET DGMTERR=Y
IF $DATA(DTOUT)!($DATA(DUOUT))
KILL DGMTERR,DTOUT,DUOUT
End DoDot:1
if $GET(DGMTERR)
DO VIEWPRT
GOTO EN
+19 IF "^3^10^"[("^"_$PIECE(Y(0),"^",3)_"^")
WRITE !?3,*7,$SELECT(DGMTYPT=1:"Means",1:"Copay")_" test is NO LONGER "_$SELECT(DGMTYPT=1:"REQUIRED",1:"APPLICABLE")_", it cannot be edited."
GOTO EN
+20 IF DGMTYPT=4
IF $PIECE($GET(^DGMT(408.31,DGMTI,2)),U,8)
Begin DoDot:1
+21 NEW DGMT,DGT
SET DGMT=$PIECE(^DGMT(408.31,DGMTI,2),U,8)
SET DGT=$PIECE($GET(^DGMT(408.31,DGMT,0)),U,19)
+22 IF DGT
IF DGT>2
QUIT
+23 WRITE !!,?3,"This LTC copay exemption test is linked to the ",$$FTIME^DGMTUTL(+^DGMT(408.31,DGMT,0)),$SELECT(DGT=1:" means",1:" RX copay")," test."
+24 WRITE !,?3,"Changes should be made using the 'Edit an Existing ",$SELECT(DGT=1:"Means",1:"Copay Exemption")," Test'"
+25 WRITE !,?3,"menu option."
+26 SET DGOUT=1
End DoDot:1
IF $GET(DGOUT)
KILL DGOUT
GOTO EN
+27 DO DISPLAY^DGMTU23(DGMTI,DGMTYPT)
DO PAUSE
IF $DATA(DTOUT)!($DATA(DUOUT))
KILL DTOUT,DUOUT
GOTO EN
+28 ;
+29 ;hardship determination, once granted, will remain unless deleted by
+30 ;hardship option
+31 ;I $P(DGMT0,"^",20),'$$EDIT() G EN ; if hardship
+32 ;
+33 SET DGMTACT="EDT"
SET DGMTROU="EN^DGMTE"
GOTO EN^DGMTSC
+34 ;
Q KILL DFN,DGMTACT,DGMTDT,DGMTERR,DGMT0,DGMTI,DGMTROU,DGMTYPT,DGMTX,DGOUT,DTOUT,DUOUT,X,Y
+1 ;
+2 ; release lock used to synchronize local MT/CT options with income test upload
+3 IF $DATA(DGMTDFN)#2
DO UNLOCK^DGMTUTL(DGMTDFN)
KILL DGMTDFN
+4 QUIT
+5 ;
PAUSE SET DIR(0)="E"
DO ^DIR
+1 QUIT
+2 ;
VIEWPRT ; Select 1 to view an uneditable means test or 2 to print a 10-10EZ/EZR
+1 ;
+2 SET DIR(0)="S^1:View Means Test;2:Print Means Test 10-10EZR/EZ"
SET DIR("A")="Select Choice"
+3 DO ^DIR
SET DGMTANS=Y
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO VIEWPRTQ
+4 IF DGMTANS=1
DO EN1^DGMTV
+5 IF DGMTANS=2
Begin DoDot:1
+6 NEW RPTSEL,DGTASK
+7 DO FULL^VALM1
+8 SET (RPTSEL,DGTASK)=""
+9 IF $DATA(DGFINOP)
Begin DoDot:2
+10 WRITE !!,"Options for printing financial assessment information will follow."
+11 WRITE !,"Generally, you should answer 'YES' to 'PRINT 10-10EZR?' after updating"
+12 WRITE !,"patient demographic or financial information. Answer 'YES' to 'PRINT"
+13 WRITE !,"10-10EZ?' after entering new patient demographic and financial information."
End DoDot:2
+14 ;*Select 1010EZ/R form to print
SET RPTSEL=$$SEL1010^DG1010P("EZR/EZ")
+15 ;*Print 1010EZ/R
if RPTSEL'="-1"
SET DGTASK=$$PRT1010^DG1010P(RPTSEL,DFN,DGMTI)
End DoDot:1
+16 ;
VIEWPRTQ ;
+1 KILL DGMTANS,DIR,DTOUT,DUOUT,Y
+2 QUIT
+3 ;
EDIT() ; want to edit even though MT is hardship?
+1 ;
+2 ; Output: 1 if user wants to edit, 0 otherwise
+3 ;
+4 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,I,X,Y
+5 SET DIR("?",1)="WARNING: You are about to access a means test for which a hardship has"
+6 SET DIR("?",2)=" been authorized. If you proceed, the hardship will be removed"
+7 SET DIR("?",3)=" and the means test category will be recalculated! To avoid"
+8 SET DIR("?",4)=" this problem, enter NO at the next prompt and use the 'View"
+9 SET DIR("?",5)=" a Past Means Test' option should you need to see details of"
+10 SET DIR("?",6)=" this means test."
+11 SET DIR("?",7)=" "
+12 SET DIR("?")="Enter NO to stop editing this means test. Enter YES to continue"
+13 FOR I=1:1
if '$DATA(DIR("?",I))
QUIT
WRITE !,DIR("?",I)
+14 SET DIR("A")="Do you want to continue editing this means test? "
SET DIR("B")="NO"
SET DIR(0)="YA"
+15 DO ^DIR
+16 QUIT Y
