- 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 Feb 19, 2025@00:10:55 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