- 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 Jan 18, 2025@03:45:57 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