DGMTSC ;ALB/RMO,CAW,RTK,PDJ,LBD,EG - Means Test Screen Driver ;05/02/2006
;;5.3;Registration;**182,327,372,433,463,540,566,611**;Aug 13, 1993;Build 3
;
;A series of screens used to collect the means test data
; Input -- DFN Patient IEN
; DGMTACT Means Test Action (ie, ADD to Add a Means Test)
; DGMTDT Date of Test
; DGMTI Annual Means Test IEN
; DTMTYPT Type of Test 1=MT 2=COPAY
; DGMTROU Option Routine Return
; Output -- None
;
;DG*5.3*540 - set 408.21 (Idiv. Ann. Income) ien to 0 to prevent from
; linking to old test incomes for IVM converted cases.
;
EN ;Entry point for means test screen driver
D PRIOR^DGMTEVT:DGMTACT'="VEW",HOME^%ZIS,SETUP^DGMTSCU I DGERR D MG G Q1
N DGREF,DTOUT,DUOUT,DGCAT,DGREF,ANSPFIN,PROVS
S ANSPFIN="N"
I DGMTACT="ADD"!(DGMTACT="EDT")!(DGMTACT="COM") D DISCF Q:$D(DTOUT)!$D(DUOUT) I $D(DGREF) D Q Q
;
EN1 ;Entry point to edit means test if incomplete
S DGMTSCI=+$O(DGMTSC(0))
I DGMTI,$$GET1^DIQ(408.31,DGMTI,.23)["IVM" S DGVINI=0 ;DG*5.3*540
G @($$ROU^DGMTSCU(DGMTSCI))
;
;
Q I DGMTACT'="VEW" D EN^DGMTSCC I DGERR G EN1:$$EDT
; Added for LTC Co-pay Phase II - DG*5.3*433
I DGMTACT'="VEW",DGMTYPT=4 D G K
.Q:$P($G(^DGMT(408.31,DGMTI,0)),U,3)="" ; LTC 4 test is incomplete
.D AFTER^DGMTEVT S DGMTINF=0
.D EN^DGMTAUD,EN^IVMPMTE
.D DATETIME^DGMTU4(DGMTI)
.; If LTC copay exemption test is edited, update LTC copay test
.I DGMTACT="EDT" D UPLTC3^EASECMT(DGMTI)
Q1 I DGMTACT'="VEW" D AFTER^DGMTEVT S DGMTINF=0 D EN^DGMTEVT
;
;If the veteran has agreed to pay copay after previously refusing,
;automatically update their Primary Eligibility (327-Ineligible Project)
I $D(DGMTP),$D(DGMTA) D
.I $D(^DPT(DFN,.3)),$P(DGMTP,U,11)=0,$P(DGMTA,U,11)=1 D
..N DATA
..I $P(^DPT(DFN,.3),U)="Y" S DATA(.361)=$O(^DIC(8,"B","SC LESS THAN 50%",""))
..E S DATA(.361)=$O(^DIC(8,"B","NSC",""))
..I $$UPD^DGENDBS(2,DFN,.DATA)
.;If the veteran has refused to pay copay, update ENROLLMENT
.;PRIORITY to null.
.I $P(DGMTA,U,11)=0 D
..S CUR=$$FINDCUR^DGENA(DFN)
..N DATA S DATA(.07)="@" I $$UPD^DGENDBS(27.11,CUR,.DATA)
;
; Added for LTC Copay Phase II (DG*5.2*433)
; If means test or copay test is edited and has a LTC copay exemption
; test associated with it, update the LTC copay exemption test.
I DGMTACT="EDT",$O(^DGMT(408.31,"AT",DGMTI,0)) D LTC4^EASECMT(DGMTI)
;
K K %,DGBL,DGDC,DGDEP,DGDR,DGFCOL,DGFL,DGMT0,DGMTA,DGMTINF,DGMTOUT,DGMTP,DGMTPAR,DGMTSC,DGMTSCI,DGREL,DGRNG,DGRPPR,DGSCOL,DGSEL,DGSELTY,DGVI,DGVINI,DGVIRI,DGVO,DGVPRI,DGX,DGY,DTOUT,DUOUT,Y,Z
;
; Validate record with consistency checks, when adding, editing, or
; completing either a means or copay test.
; For DG*5.3*566 - added a check for Status field to be defined before
; calling the consistency check API (INCON^DGMTUTL1).
K IVMERR,IVMAR,IVMAR2
;don't apply consistency checks if user elects to not provide financial information
I DGMTACT'="VEW",$P($G(^DGMT(408.31,DGMTI,0)),U,3),'$D(DGREF) D INCON^DGMTUTL1(DFN,DGMTDT,DGMTI,DGMTYPT,.IVMERR),PROB^IVMCMFB(DGMTDT,.IVMERR,1)
;
;Update the TEST-DETERMINED STATUS field (#2.03) in the ANNUAL MEANS
;TEST file (408.31) when adding a means or copay test, completing a
;means test, or editing a means or copay test.
I "ADDCOMEDT"[DGMTACT D SAVESTAT^DGMTU4(DGMTI,DGERR)
K DGERR,IVMERR,ARRAY,ZIC,ZIR,ZMT,ZDP,IVMAR,IVMAR2,DGREF
;
G @(DGMTROU)
;
MG ;Print set-up error messages
I $D(DGVPRI),DGVPRI'>0 W !!?3,"Patient Relation cannot be setup for patient."
I $D(DGVINI),DGVINI'>0 W !!?3,"Individual Annual Income cannot be setup for patient."
I $D(DGMTPAR),DGMTPAR']"",DGMTYPT=1 W !!?3,"Means Test Thresholds are not defined."
W !?3,*7,"Please contact your site manager."
Q
;
EDT() ;Edit means/copay test if incomplete
N DIR,Y
S DIR("A")="Do you wish to edit the "_$S(DGMTYPT=1:"means",1:"copay exemption")_" test"
S DIR("B")="YES",DIR(0)="Y" D ^DIR
Q +$G(Y)
;
DEDUCT() ;
N DIR,Y
S DIR("A")="Agreed to pay deductible",DIR(0)="Y"
D ^DIR
Q +$G(Y)
;
DISCF ;Check if patient declines to provide income information
;similar to module REF in program DGMTSCC, but the questions
;are negatives of each other
N DIR,Y,U,MSG
S U="^"
S MSG(1)=""
S MSG(2)="PROVIDE SPECIFIC INCOME AND/OR ASSET INFORMATION"
S MSG(3)="TO HAVE ELIGIBILITY FOR CARE DETERMINED. <YES>"
S MSG(4)="Continue, and complete the test with last calendar year's information."
S MSG(5)=""
S MSG(6)="PROVIDE MY DETAILED FINANCIAL INFORMATION. <NO>"
S MSG(7)="The appropriate enrollment priority based on nondisclosure of"
S MSG(8)="my financial information will be assigned."
S MSG(9)=""
D BMES^XPDUTL(.MSG)
S DIR("A")="Do you wish to provide financial information? "
;piece 14 says declines to give income info yes or no
;if the user declines to give income info, then provide financial information is no
I $P($G(^DGMT(408.31,DGMTI,0)),"^",14)]"" S DIR("B")=$S($P(^DGMT(408.31,DGMTI,0),"^",14):"N",1:"Y")
I '$D(DIR("B")) S DIR("B")="YES"
S DIR(0)="408.31,.14" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) Q
S:'Y DGREF="" S ANSPFIN="Y" Q:'$D(DGREF)!($D(DGREF1))!(DGMTYPT'=1) S DGCAT="C" D STA^DGMTSCU2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTSC 5282 printed Oct 16, 2024@18:45:54 Page 2
DGMTSC ;ALB/RMO,CAW,RTK,PDJ,LBD,EG - Means Test Screen Driver ;05/02/2006
+1 ;;5.3;Registration;**182,327,372,433,463,540,566,611**;Aug 13, 1993;Build 3
+2 ;
+3 ;A series of screens used to collect the means test data
+4 ; Input -- DFN Patient IEN
+5 ; DGMTACT Means Test Action (ie, ADD to Add a Means Test)
+6 ; DGMTDT Date of Test
+7 ; DGMTI Annual Means Test IEN
+8 ; DTMTYPT Type of Test 1=MT 2=COPAY
+9 ; DGMTROU Option Routine Return
+10 ; Output -- None
+11 ;
+12 ;DG*5.3*540 - set 408.21 (Idiv. Ann. Income) ien to 0 to prevent from
+13 ; linking to old test incomes for IVM converted cases.
+14 ;
EN ;Entry point for means test screen driver
+1 if DGMTACT'="VEW"
DO PRIOR^DGMTEVT
DO HOME^%ZIS
DO SETUP^DGMTSCU
IF DGERR
DO MG
GOTO Q1
+2 NEW DGREF,DTOUT,DUOUT,DGCAT,DGREF,ANSPFIN,PROVS
+3 SET ANSPFIN="N"
+4 IF DGMTACT="ADD"!(DGMTACT="EDT")!(DGMTACT="COM")
DO DISCF
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
IF $DATA(DGREF)
DO Q
QUIT
+5 ;
EN1 ;Entry point to edit means test if incomplete
+1 SET DGMTSCI=+$ORDER(DGMTSC(0))
+2 ;DG*5.3*540
IF DGMTI
IF $$GET1^DIQ(408.31,DGMTI,.23)["IVM"
SET DGVINI=0
+3 GOTO @($$ROU^DGMTSCU(DGMTSCI))
+4 ;
+5 ;
Q IF DGMTACT'="VEW"
DO EN^DGMTSCC
IF DGERR
if $$EDT
GOTO EN1
+1 ; Added for LTC Co-pay Phase II - DG*5.3*433
+2 IF DGMTACT'="VEW"
IF DGMTYPT=4
Begin DoDot:1
+3 ; LTC 4 test is incomplete
if $PIECE($GET(^DGMT(408.31,DGMTI,0)),U,3)=""
QUIT
+4 DO AFTER^DGMTEVT
SET DGMTINF=0
+5 DO EN^DGMTAUD
DO EN^IVMPMTE
+6 DO DATETIME^DGMTU4(DGMTI)
+7 ; If LTC copay exemption test is edited, update LTC copay test
+8 IF DGMTACT="EDT"
DO UPLTC3^EASECMT(DGMTI)
End DoDot:1
GOTO K
Q1 IF DGMTACT'="VEW"
DO AFTER^DGMTEVT
SET DGMTINF=0
DO EN^DGMTEVT
+1 ;
+2 ;If the veteran has agreed to pay copay after previously refusing,
+3 ;automatically update their Primary Eligibility (327-Ineligible Project)
+4 IF $DATA(DGMTP)
IF $DATA(DGMTA)
Begin DoDot:1
+5 IF $DATA(^DPT(DFN,.3))
IF $PIECE(DGMTP,U,11)=0
IF $PIECE(DGMTA,U,11)=1
Begin DoDot:2
+6 NEW DATA
+7 IF $PIECE(^DPT(DFN,.3),U)="Y"
SET DATA(.361)=$ORDER(^DIC(8,"B","SC LESS THAN 50%",""))
+8 IF '$TEST
SET DATA(.361)=$ORDER(^DIC(8,"B","NSC",""))
+9 IF $$UPD^DGENDBS(2,DFN,.DATA)
End DoDot:2
+10 ;If the veteran has refused to pay copay, update ENROLLMENT
+11 ;PRIORITY to null.
+12 IF $PIECE(DGMTA,U,11)=0
Begin DoDot:2
+13 SET CUR=$$FINDCUR^DGENA(DFN)
+14 NEW DATA
SET DATA(.07)="@"
IF $$UPD^DGENDBS(27.11,CUR,.DATA)
End DoDot:2
End DoDot:1
+15 ;
+16 ; Added for LTC Copay Phase II (DG*5.2*433)
+17 ; If means test or copay test is edited and has a LTC copay exemption
+18 ; test associated with it, update the LTC copay exemption test.
+19 IF DGMTACT="EDT"
IF $ORDER(^DGMT(408.31,"AT",DGMTI,0))
DO LTC4^EASECMT(DGMTI)
+20 ;
K KILL %,DGBL,DGDC,DGDEP,DGDR,DGFCOL,DGFL,DGMT0,DGMTA,DGMTINF,DGMTOUT,DGMTP,DGMTPAR,DGMTSC,DGMTSCI,DGREL,DGRNG,DGRPPR,DGSCOL,DGSEL,DGSELTY,DGVI,DGVINI,DGVIRI,DGVO,DGVPRI,DGX,DGY,DTOUT,DUOUT,Y,Z
+1 ;
+2 ; Validate record with consistency checks, when adding, editing, or
+3 ; completing either a means or copay test.
+4 ; For DG*5.3*566 - added a check for Status field to be defined before
+5 ; calling the consistency check API (INCON^DGMTUTL1).
+6 KILL IVMERR,IVMAR,IVMAR2
+7 ;don't apply consistency checks if user elects to not provide financial information
+8 IF DGMTACT'="VEW"
IF $PIECE($GET(^DGMT(408.31,DGMTI,0)),U,3)
IF '$DATA(DGREF)
DO INCON^DGMTUTL1(DFN,DGMTDT,DGMTI,DGMTYPT,.IVMERR)
DO PROB^IVMCMFB(DGMTDT,.IVMERR,1)
+9 ;
+10 ;Update the TEST-DETERMINED STATUS field (#2.03) in the ANNUAL MEANS
+11 ;TEST file (408.31) when adding a means or copay test, completing a
+12 ;means test, or editing a means or copay test.
+13 IF "ADDCOMEDT"[DGMTACT
DO SAVESTAT^DGMTU4(DGMTI,DGERR)
+14 KILL DGERR,IVMERR,ARRAY,ZIC,ZIR,ZMT,ZDP,IVMAR,IVMAR2,DGREF
+15 ;
+16 GOTO @(DGMTROU)
+17 ;
MG ;Print set-up error messages
+1 IF $DATA(DGVPRI)
IF DGVPRI'>0
WRITE !!?3,"Patient Relation cannot be setup for patient."
+2 IF $DATA(DGVINI)
IF DGVINI'>0
WRITE !!?3,"Individual Annual Income cannot be setup for patient."
+3 IF $DATA(DGMTPAR)
IF DGMTPAR']""
IF DGMTYPT=1
WRITE !!?3,"Means Test Thresholds are not defined."
+4 WRITE !?3,*7,"Please contact your site manager."
+5 QUIT
+6 ;
EDT() ;Edit means/copay test if incomplete
+1 NEW DIR,Y
+2 SET DIR("A")="Do you wish to edit the "_$SELECT(DGMTYPT=1:"means",1:"copay exemption")_" test"
+3 SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
+4 QUIT +$GET(Y)
+5 ;
DEDUCT() ;
+1 NEW DIR,Y
+2 SET DIR("A")="Agreed to pay deductible"
SET DIR(0)="Y"
+3 DO ^DIR
+4 QUIT +$GET(Y)
+5 ;
DISCF ;Check if patient declines to provide income information
+1 ;similar to module REF in program DGMTSCC, but the questions
+2 ;are negatives of each other
+3 NEW DIR,Y,U,MSG
+4 SET U="^"
+5 SET MSG(1)=""
+6 SET MSG(2)="PROVIDE SPECIFIC INCOME AND/OR ASSET INFORMATION"
+7 SET MSG(3)="TO HAVE ELIGIBILITY FOR CARE DETERMINED. <YES>"
+8 SET MSG(4)="Continue, and complete the test with last calendar year's information."
+9 SET MSG(5)=""
+10 SET MSG(6)="PROVIDE MY DETAILED FINANCIAL INFORMATION. <NO>"
+11 SET MSG(7)="The appropriate enrollment priority based on nondisclosure of"
+12 SET MSG(8)="my financial information will be assigned."
+13 SET MSG(9)=""
+14 DO BMES^XPDUTL(.MSG)
+15 SET DIR("A")="Do you wish to provide financial information? "
+16 ;piece 14 says declines to give income info yes or no
+17 ;if the user declines to give income info, then provide financial information is no
+18 IF $PIECE($GET(^DGMT(408.31,DGMTI,0)),"^",14)]""
SET DIR("B")=$SELECT($PIECE(^DGMT(408.31,DGMTI,0),"^",14):"N",1:"Y")
+19 IF '$DATA(DIR("B"))
SET DIR("B")="YES"
+20 SET DIR(0)="408.31,.14"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+21 if 'Y
SET DGREF=""
SET ANSPFIN="Y"
if '$DATA(DGREF)!($DATA(DGREF1))!(DGMTYPT'=1)
QUIT
SET DGCAT="C"
DO STA^DGMTSCU2
+22 QUIT
