DGMTU ;ALB/RMO,LBD,BRM,EG,BDB - Means Test Utilities ; 02/08/2005 07:10 AM
;;5.3;Registration;**4,33,182,277,290,374,358,420,426,411,332,433,456,476,519,451,630,783,799,834,858**;Aug 13, 1993;Build 30
;MT=Means Test
LST(DFN,DGDT,DGMTYPT) ;Last MT for a patient
; Input -- DFN Patient IEN
; DGDT Date/Time (Optional- default today@2359)
; DGMTYPT Type of Test (Optional - if not defined
; Means Test will be assumed)
; Output -- Annual Means Test IEN^Date of Test
; ^Status Name^Status Code^Source of Test
N DGIDT,DGMTFL1,DGMTI,DGNOD,Y I '$D(DGMTYPT) S DGMTYPT=1
S DGIDT=$S($G(DGDT)>0:-DGDT,1:-DT) S:'$P(DGIDT,".",2) DGIDT=DGIDT_.2359
F S DGIDT=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT)) Q:'DGIDT!$G(DGMTFL1) D
.F DGMTI=0:0 S DGMTI=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT,DGMTI)) Q:'DGMTI!$G(DGMTFL1) D
..S DGNOD=$G(^DGMT(408.31,DGMTI,0)) I DGNOD,$G(^("PRIM"))!(DGMTYPT=4) S DGMTFL1=1,Y=DGMTI_"^"_$P(^(0),"^")_"^"_$$MTS(DFN,+$P(^(0),"^",3))_"^"_$P(DGNOD,"^",23) ; chk for primary MT
Q $G(Y)
;
LVMT(DFN,DGDT) ;Last valid MT (status other than required)
; Input -- DFN Patient IEN
; DGDT Date (Optional - default today)
; Output -- Annual Means Test IEN^Date of Test^Status Name
; ^Status Code
N DGMT,DGMTL
S:'$D(DGDT) DGDT=DT S DGMTL=$$LST^DGMTU(DFN,DGDT)
I $P(DGMTL,"^",4)="R" F S DGMT=$$LST^DGMTU(DFN,DGDT) Q:DGMT']""!($P(DGMT,U,4)'="R") S DGDT=$P(DGMT,U,2)-1
Q $S($G(DGMT)]"":DGMT,1:$G(DGMTL))
;
NVMT(DFN,DGDT) ;Next valid MT (status other than required)
; Input -- DFN Patient IEN
; DGDT Date (Required)
; Output -- Annual Means Test IEN^Date of Test^Status Name
; ^Status Code
N DGDTE,DGMT,DGMT0,DGMTI,DGMTPR,DGMTS
S DGDTE=DGDT
F S DGDTE=$O(^DGMT(408.31,"AD",1,DFN,DGDTE)) Q:'DGDTE!$G(DGMT) D
.F DGMTI=0:0 S DGMTI=$O(^DGMT(408.31,"AD",1,DFN,DGDTE,DGMTI)) Q:'DGMTI S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGMTS=+$P(DGMT0,"^",3),DGMTPR=$G(^("PRIM")) I +DGMT0,DGMTS'=1,DGMTPR S DGMT=DGMTI_"^"_+DGMT0_"^"_$$MTS^DGMTU(DFN,DGMTS) Q
Q $G(DGMT)
;
MTS(DFN,DGMTS) ;MT status -- default current
; Input -- DFN Patient IEN
; DGMTS Means Test Status IEN (Optional)
; Output -- Status Name^Status Code
N Y
S DGMTS=$S($G(DGMTS)>0:DGMTS,1:$P($G(^DPT(DFN,0)),"^",14))
I DGMTS S Y=$P($G(^DG(408.32,DGMTS,0)),"^",1,2)
Q $G(Y)
;
DIS(DFN) ;Display patients current MT status,
; eligibility for care, deductible information,
; date of test and date of completion
; Input -- DFN Patient IEN
; Output -- None
N DGCS,DGDED,DGMTI,DGMT0
S DGCS=$P($G(^DPT(DFN,0)),"^",14) G DISQ:DGCS=""
S DGMTI=+$$LST^DGMTU(DFN),DGMT0=$G(^DGMT(408.31,DGMTI,0))
S MTSIG=$P(DGMT0,"^",29)
W !,"Means Test Signed?: ",$S(MTSIG=1:"YES",MTSIG=0:"NO",MTSIG=9:"DELETED",1:"")
I DGCS=1 W !!,"Patient Requires a Means Test"
I DGCS=2 W !!,"Patient's Means Test is Pending Adjudication for "_$$PA^DGMTUTL(DGMTI)
I DGCS=3 W !!,"Means Test Not Required"
I ("^4^5^6^16^")[("^"_DGCS_"^") W !!,"Patient's status is ",$$GETNAME^DGMTH(DGCS)," based on primary means test"
I $D(^DG(408.32,DGCS,"MSG")) W !,^("MSG")
I DGCS=6 S DGDED=$P(DGMT0,"^",11) W ! W:DGDED]"" "Has",$S(DGDED:"",1:" not")," agreed to pay the deductible"
S Y=$P(DGMT0,"^") X ^DD("DD") W !,"Primary Means Test ",$S(DGCS=1:"Required from",1:"Last Applied")," '",Y,"'"
I ("^2^4^5^6^16^")[("^"_DGCS_"^") S Y=$P(DGMT0,"^",7) X ^DD("DD") W " (COMPLETED: ",Y,")"
I DGCS=3 S Y=$P(DGMT0,"^",17) X ^DD("DD") W " (NO LONGER REQUIRED: ",Y,")"
DISQ Q
;
EDT(DFN,DGDT) ;Display patients current MT information and provide
; the user with the option of proceeding with a required
; MT or editing an existing means test
; Input -- DFN Patient IEN
; DGDT Date/Time
; Output -- None
;
; obtain lock used to synchronize local MT/CT options with income test upload
; '+' added to VSITE check to allow divisions to edit parent owned tests
N VSITE
I $$LOCK^DGMTUTL(DFN)
;
D DIS(DFN)
S DGMTI=+$$LST(DFN,DGDT),VSITE=+$P($$SITE^VASITE(),U,3)
G EDTQ:'DGMTI!(DGMTI'=+$$LST^DGMTU(DFN))
I +$P($G(^DGMT(408.31,DGMTI,2)),U,5)'=VSITE G EDTQ ; Test doesn't belong to site
S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGMTDT=+DGMT0,DGMTS=$P(DGMT0,"^",3)
S DIR("A")="Do you wish to "_$S(DGMTS=1:"proceed with",1:"edit")_" the means test at this time"
S DIR("B")=$S(DGMTS&($D(DGPRFLG)):"NO",DGMTS=1:"YES",1:"NO"),DIR(0)="Y"
W ! D ^DIR G EDTQ:$D(DTOUT)!($D(DUOUT))
I Y S DGMTYPT=1,DGMTACT="EDT",DGMTROU="EDTQ^DGMTU" G EN^DGMTSC
EDTQ K DGMT0,DGMTACT,DGMTDT,DGMTI,DGMTROU,DGMTS,DIR,DTOUT,DUOUT,Y
;
; release lock
D UNLOCK^DGMTUTL(DFN)
;
Q
;
CMTS(DFN) ;Get Current MT Status - query HEC if necessary
;
; Input: DFN=patient ien
; Output: MT IEN^Date of Test^Status Name
; ^Status Code^Source of Test
;
N X,Y,DGMTDATA,DGQSENT,DGDOD,NODE0,DGRET,DGMFLG,DGTAG,DGMTYPT
D CHKPT^DGMTU4(DFN)
S DGMTYPT=1,DGMTDATA=$$LST(DFN,"",DGMTYPT)
;Next line checks to see if patient has expired, if so, Query not initiated
S DGDOD=$P($G(^DPT(DFN,.35)),U)
I +DGDOD Q DGMTDATA
;Next line checks to see if current test exists, if not, Query not initiated
I '$G(DGMTDATA) Q DGMTDATA
D:+$$QFLG(DGMTDATA)
.I $G(IVMZ10)'="UPLOAD IN PROGRESS",'$$OPEN^IVMCQ2(DFN),'$$SENT^IVMCQ2(DFN),$G(DGMFLG)'=0 D
..I $$LOCK^DGMTUTL(DFN)
..D QRYQUE2^IVMCQ2(DFN,$G(DUZ),0,$G(XQY)) S DGQSENT=1
..I '$D(ZTQUEUED),'$G(DGMSGF),$G(DGQSENT) W !!,"Financial query queued to be sent to HEC...",! H .5
..D UNLOCK^DGMTUTL(DFN)
.S DGMTDATA=$$LST(DFN,"",DGMTYPT)
D:+$$MFLG(DGMTDATA)
.S DGMFLG=$$MFLG(DGMTDATA)
.S DGTAG=$S(DGMFLG=1:"MSG"_DGMFLG,DGMFLG=2:"MSG"_DGMFLG,1:0)
.I DGTAG["MSG",'$G(DGMSGF) D @DGTAG
Q DGMTDATA ;return most current MT data
MFLG(DGMTDATA) ;Set up appropriate informational message flag for user's
;benefit.
;Input - DGMTDATA as defined by $$LST function.
;Output - DGRETV
; 1 = Current Test is REQUIRED
; 2 = Test is > 1 year older than January 1, 2013 and is in a
; status of other than REQUIRED or NO LONGER REQUIRED
; 2 = Pend Adj for GMT, test date is 10/6/99 or
; greater and agreed to the deductible
; 0 = CAT C/Pend Adj for MT, test date is 10/6/99
; or greater and agreed to the deductible.
; OR 0 = Cat C, declined income info and agreed
; to pay deductible.
; OR 0 = Has a future dated Means Test
N DGRETV,FTST,DGMT0
S DGRETV=0 I '$G(DGMTDATA) Q DGRETV
S DGMT0=$G(^DGMT(408.31,+DGMTDATA,0))
I $P(DGMTDATA,U,4)="R" S DGRETV=1
;DG*5.3*858 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
I $$OLDMTPF^DGMTU4($P(DGMTDATA,U,2)),($P(DGMTDATA,U,4)'="N")&($P(DGMTDATA,U,4)'="R") S DGRETV=2
I ($P(DGMTDATA,U,4)="C")!($P(DGMTDATA,U,4)="P"&($P(DGMT0,U,12)'<$P(DGMT0,U,27))),$P(DGMTDATA,U,2)>2991005,$P(DGMT0,U,11)=1 S DGRETV=0
I ($P(DGMTDATA,U,4)="C"),+$P(DGMT0,U,14),+$P(DGMT0,U,11) S DGRETV=0
D DOM^DGMTR I $G(DGDOM) S DGRETV=0
S FTST=$$FUT(DFN)
I DGRETV,FTST,$P(^DGMT(408.31,+FTST,0),U,19)=1 S DGRETV=0
Q DGRETV
MSG1 ;Informational message 1
N NODE0,Y
S NODE0=$G(^DGMT(408.31,+DGMTDATA,0))
W !!,$C(7),?15,"*** Patient Requires a Means Test ***",!
S Y=$P(NODE0,U) X ^DD("DD") W !,?14,"Primary Means Test Required from "_Y,!
I $G(IOST)["C-" R !!,"Enter <RETURN> to continue.",DGRET:DTIME
Q
MSG2 ;Informational message 2
N NODE0,Y
S NODE0=$G(^DGMT(408.31,+DGMTDATA,0))
W !!,$C(7),?17,"*** Patient Requires a Means Test ***",!
S Y=$P(NODE0,U) X ^DD("DD") W !,?25,"*** Please update ***",! ;DG*5.3*858
;S Y=$P(NODE0,U) X ^DD("DD") W !,?10,"Patient's Test dated "_Y_" is "_$P(DGMTDATA,U,3)_"."_" The test"
;W !,?10,"date is greater than 1 year old. Please update."
I $G(IOST)["C-" R !!,"Enter <RETURN> to continue.",DGRET:DTIME
Q
QFLG(DGMTDATA) ;
;INPUT - DGMTDATA
;OUTPUT- IVMQFLG 1 if query is necessary 0 if not
N IVMQFLG,DGMT0
S IVMQFLG=0 I '$G(DGMTDATA) Q IVMQFLG
S DGMT0=$G(^DGMT(408.31,+DGMTDATA,0))
;Set flag to 1 if Means test is Required.
I $P(DGMTDATA,U,4)="R" S IVMQFLG=1
;Set flag to 1 if Means test older than 1 year from January 1, 2013 and status is not
;NO LONGER REQUIRED and not REQUIRED.
;DG*5.3*858 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
I $$OLDMTPF^DGMTU4($P(DGMTDATA,U,2)),($P(DGMTDATA,U,4)'="N")&($P(DGMTDATA,U,4)'="R") S IVMQFLG=1
;If Cat C/Pend Adj for MT, older than 1 year from January 1, 2013, agreed to pay, test
;date > 10/5/99 reset flag to 0 - no query is necessary.
I ($P(DGMTDATA,U,4)="C")!($P(DGMTDATA,U,4)="P"&($P(DGMT0,U,12)'<$P(DGMT0,U,27))),$P(DGMTDATA,U,2)>2991005,$P(DGMT0,U,11)=1 S IVMQFLG=0
;If patient is Cat C, declined to provide income but has agreed to
;pay deductible, no query necessary - reset flag to 0
I ($P(DGMTDATA,U,4)="C"),+$P(DGMT0,U,14),+$P(DGMT0,U,11) S DGRETV=0
;If patient is on a DOM ward, don't initiate query
D DOM^DGMTR I $G(DGDOM) S IVMQFLG=0
Q IVMQFLG
;
FUT(DFN,DGDT,DGMTYPT) ; Future MT for a patient
;DFN Patient IEN
;DGDT Date (Optional- default to today)
;DGMTYPT Type of Test (Optional - default to MT)
;Return
;If a DCD test was performed it will be returned, else the
;current future dated test for the Income Year.
;MT IEN^Date of Test^Status Name^Status Code^Source
;
N DGIDT,Y,MTIEN,SRCE,DONE,MTNOD,ARR,LAST,TYPTST
S:'$D(DGMTYPT) DGMTYPT=1
;no future LTC eg 02/15/2005
I ($G(DGMTYPT)=4) Q ""
S TYPTST=$S(DGMTYPT=2:"AF",1:"AE")
S DGIDT=$S($G(DGDT)>0:DGDT,1:DT),DONE=0
S (ARR,LAST,Y)=""
S:$P(DGIDT,".",2) DGIDT=$P(DGIDT,".")
F S DGIDT=$O(^IVM(301.5,TYPTST,DFN,DGIDT)) Q:'DGIDT!(DONE) D
.S MTIEN=0
.F S MTIEN=$O(^IVM(301.5,TYPTST,DFN,DGIDT,MTIEN)) Q:'MTIEN!(DONE) D
..Q:'$D(^DGMT(408.31,MTIEN,0))
..S MTNOD=^DGMT(408.31,MTIEN,0),SRCE=$P(MTNOD,U,23)
..I SRCE'=1 S DONE=1,Y=MTIEN_U_$P(MTNOD,U)_U_$$MTS^DGMTU(DFN,+$P(MTNOD,U,3))_U_$P(MTNOD,U,23) Q
..I 'DONE,'$D(ARR($P(MTNOD,U),MTIEN)) S ARR($P(MTNOD,U),MTIEN)=MTIEN_U_$P(MTNOD,U)_U_$$MTS^DGMTU(DFN,+$P(MTNOD,U,3))_U_$P(MTNOD,U,23)
I 'DONE S LAST=$O(ARR(""),-1) I LAST S Y=ARR(LAST,$O(ARR(LAST,""),-1))
Q $G(Y)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTU 10517 printed Sep 23, 2025@20:21:24 Page 2
DGMTU ;ALB/RMO,LBD,BRM,EG,BDB - Means Test Utilities ; 02/08/2005 07:10 AM
+1 ;;5.3;Registration;**4,33,182,277,290,374,358,420,426,411,332,433,456,476,519,451,630,783,799,834,858**;Aug 13, 1993;Build 30
+2 ;MT=Means Test
LST(DFN,DGDT,DGMTYPT) ;Last MT for a patient
+1 ; Input -- DFN Patient IEN
+2 ; DGDT Date/Time (Optional- default today@2359)
+3 ; DGMTYPT Type of Test (Optional - if not defined
+4 ; Means Test will be assumed)
+5 ; Output -- Annual Means Test IEN^Date of Test
+6 ; ^Status Name^Status Code^Source of Test
+7 NEW DGIDT,DGMTFL1,DGMTI,DGNOD,Y
IF '$DATA(DGMTYPT)
SET DGMTYPT=1
+8 SET DGIDT=$SELECT($GET(DGDT)>0:-DGDT,1:-DT)
if '$PIECE(DGIDT,".",2)
SET DGIDT=DGIDT_.2359
+9 FOR
SET DGIDT=+$ORDER(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT))
if 'DGIDT!$GET(DGMTFL1)
QUIT
Begin DoDot:1
+10 FOR DGMTI=0:0
SET DGMTI=+$ORDER(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT,DGMTI))
if 'DGMTI!$GET(DGMTFL1)
QUIT
Begin DoDot:2
+11 ; chk for primary MT
SET DGNOD=$GET(^DGMT(408.31,DGMTI,0))
IF DGNOD
IF $GET(^("PRIM"))!(DGMTYPT=4)
SET DGMTFL1=1
SET Y=DGMTI_"^"_$PIECE(^(0),"^")_"^"_$$MTS(DFN,+$PIECE(^(0),"^",3))_"^"_$PIECE(DGNOD,"^",23)
End DoDot:2
End DoDot:1
+12 QUIT $GET(Y)
+13 ;
LVMT(DFN,DGDT) ;Last valid MT (status other than required)
+1 ; Input -- DFN Patient IEN
+2 ; DGDT Date (Optional - default today)
+3 ; Output -- Annual Means Test IEN^Date of Test^Status Name
+4 ; ^Status Code
+5 NEW DGMT,DGMTL
+6 if '$DATA(DGDT)
SET DGDT=DT
SET DGMTL=$$LST^DGMTU(DFN,DGDT)
+7 IF $PIECE(DGMTL,"^",4)="R"
FOR
SET DGMT=$$LST^DGMTU(DFN,DGDT)
if DGMT']""!($PIECE(DGMT,U,4)'="R")
QUIT
SET DGDT=$PIECE(DGMT,U,2)-1
+8 QUIT $SELECT($GET(DGMT)]"":DGMT,1:$GET(DGMTL))
+9 ;
NVMT(DFN,DGDT) ;Next valid MT (status other than required)
+1 ; Input -- DFN Patient IEN
+2 ; DGDT Date (Required)
+3 ; Output -- Annual Means Test IEN^Date of Test^Status Name
+4 ; ^Status Code
+5 NEW DGDTE,DGMT,DGMT0,DGMTI,DGMTPR,DGMTS
+6 SET DGDTE=DGDT
+7 FOR
SET DGDTE=$ORDER(^DGMT(408.31,"AD",1,DFN,DGDTE))
if 'DGDTE!$GET(DGMT)
QUIT
Begin DoDot:1
+8 FOR DGMTI=0:0
SET DGMTI=$ORDER(^DGMT(408.31,"AD",1,DFN,DGDTE,DGMTI))
if 'DGMTI
QUIT
SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
SET DGMTS=+$PIECE(DGMT0,"^",3)
SET DGMTPR=$GET(^("PRIM"))
IF +DGMT0
IF DGMTS'=1
IF DGMTPR
SET DGMT=DGMTI_"^"_+DGMT0_"^"_$$MTS^DGMTU(DFN,DGMTS)
QUIT
End DoDot:1
+9 QUIT $GET(DGMT)
+10 ;
MTS(DFN,DGMTS) ;MT status -- default current
+1 ; Input -- DFN Patient IEN
+2 ; DGMTS Means Test Status IEN (Optional)
+3 ; Output -- Status Name^Status Code
+4 NEW Y
+5 SET DGMTS=$SELECT($GET(DGMTS)>0:DGMTS,1:$PIECE($GET(^DPT(DFN,0)),"^",14))
+6 IF DGMTS
SET Y=$PIECE($GET(^DG(408.32,DGMTS,0)),"^",1,2)
+7 QUIT $GET(Y)
+8 ;
DIS(DFN) ;Display patients current MT status,
+1 ; eligibility for care, deductible information,
+2 ; date of test and date of completion
+3 ; Input -- DFN Patient IEN
+4 ; Output -- None
+5 NEW DGCS,DGDED,DGMTI,DGMT0
+6 SET DGCS=$PIECE($GET(^DPT(DFN,0)),"^",14)
if DGCS=""
GOTO DISQ
+7 SET DGMTI=+$$LST^DGMTU(DFN)
SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
+8 SET MTSIG=$PIECE(DGMT0,"^",29)
+9 WRITE !,"Means Test Signed?: ",$SELECT(MTSIG=1:"YES",MTSIG=0:"NO",MTSIG=9:"DELETED",1:"")
+10 IF DGCS=1
WRITE !!,"Patient Requires a Means Test"
+11 IF DGCS=2
WRITE !!,"Patient's Means Test is Pending Adjudication for "_$$PA^DGMTUTL(DGMTI)
+12 IF DGCS=3
WRITE !!,"Means Test Not Required"
+13 IF ("^4^5^6^16^")[("^"_DGCS_"^")
WRITE !!,"Patient's status is ",$$GETNAME^DGMTH(DGCS)," based on primary means test"
+14 IF $DATA(^DG(408.32,DGCS,"MSG"))
WRITE !,^("MSG")
+15 IF DGCS=6
SET DGDED=$PIECE(DGMT0,"^",11)
WRITE !
if DGDED]""
WRITE "Has",$SELECT(DGDED:"",1:" not")," agreed to pay the deductible"
+16 SET Y=$PIECE(DGMT0,"^")
XECUTE ^DD("DD")
WRITE !,"Primary Means Test ",$SELECT(DGCS=1:"Required from",1:"Last Applied")," '",Y,"'"
+17 IF ("^2^4^5^6^16^")[("^"_DGCS_"^")
SET Y=$PIECE(DGMT0,"^",7)
XECUTE ^DD("DD")
WRITE " (COMPLETED: ",Y,")"
+18 IF DGCS=3
SET Y=$PIECE(DGMT0,"^",17)
XECUTE ^DD("DD")
WRITE " (NO LONGER REQUIRED: ",Y,")"
DISQ QUIT
+1 ;
EDT(DFN,DGDT) ;Display patients current MT information and provide
+1 ; the user with the option of proceeding with a required
+2 ; MT or editing an existing means test
+3 ; Input -- DFN Patient IEN
+4 ; DGDT Date/Time
+5 ; Output -- None
+6 ;
+7 ; obtain lock used to synchronize local MT/CT options with income test upload
+8 ; '+' added to VSITE check to allow divisions to edit parent owned tests
+9 NEW VSITE
+10 IF $$LOCK^DGMTUTL(DFN)
+11 ;
+12 DO DIS(DFN)
+13 SET DGMTI=+$$LST(DFN,DGDT)
SET VSITE=+$PIECE($$SITE^VASITE(),U,3)
+14 if 'DGMTI!(DGMTI'=+$$LST^DGMTU(DFN))
GOTO EDTQ
+15 ; Test doesn't belong to site
IF +$PIECE($GET(^DGMT(408.31,DGMTI,2)),U,5)'=VSITE
GOTO EDTQ
+16 SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
SET DGMTDT=+DGMT0
SET DGMTS=$PIECE(DGMT0,"^",3)
+17 SET DIR("A")="Do you wish to "_$SELECT(DGMTS=1:"proceed with",1:"edit")_" the means test at this time"
+18 SET DIR("B")=$SELECT(DGMTS&($DATA(DGPRFLG)):"NO",DGMTS=1:"YES",1:"NO")
SET DIR(0)="Y"
+19 WRITE !
DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EDTQ
+20 IF Y
SET DGMTYPT=1
SET DGMTACT="EDT"
SET DGMTROU="EDTQ^DGMTU"
GOTO EN^DGMTSC
EDTQ KILL DGMT0,DGMTACT,DGMTDT,DGMTI,DGMTROU,DGMTS,DIR,DTOUT,DUOUT,Y
+1 ;
+2 ; release lock
+3 DO UNLOCK^DGMTUTL(DFN)
+4 ;
+5 QUIT
+6 ;
CMTS(DFN) ;Get Current MT Status - query HEC if necessary
+1 ;
+2 ; Input: DFN=patient ien
+3 ; Output: MT IEN^Date of Test^Status Name
+4 ; ^Status Code^Source of Test
+5 ;
+6 NEW X,Y,DGMTDATA,DGQSENT,DGDOD,NODE0,DGRET,DGMFLG,DGTAG,DGMTYPT
+7 DO CHKPT^DGMTU4(DFN)
+8 SET DGMTYPT=1
SET DGMTDATA=$$LST(DFN,"",DGMTYPT)
+9 ;Next line checks to see if patient has expired, if so, Query not initiated
+10 SET DGDOD=$PIECE($GET(^DPT(DFN,.35)),U)
+11 IF +DGDOD
QUIT DGMTDATA
+12 ;Next line checks to see if current test exists, if not, Query not initiated
+13 IF '$GET(DGMTDATA)
QUIT DGMTDATA
+14 if +$$QFLG(DGMTDATA)
Begin DoDot:1
+15 IF $GET(IVMZ10)'="UPLOAD IN PROGRESS"
IF '$$OPEN^IVMCQ2(DFN)
IF '$$SENT^IVMCQ2(DFN)
IF $GET(DGMFLG)'=0
Begin DoDot:2
+16 IF $$LOCK^DGMTUTL(DFN)
+17 DO QRYQUE2^IVMCQ2(DFN,$GET(DUZ),0,$GET(XQY))
SET DGQSENT=1
+18 IF '$DATA(ZTQUEUED)
IF '$GET(DGMSGF)
IF $GET(DGQSENT)
WRITE !!,"Financial query queued to be sent to HEC...",!
HANG .5
+19 DO UNLOCK^DGMTUTL(DFN)
End DoDot:2
+20 SET DGMTDATA=$$LST(DFN,"",DGMTYPT)
End DoDot:1
+21 if +$$MFLG(DGMTDATA)
Begin DoDot:1
+22 SET DGMFLG=$$MFLG(DGMTDATA)
+23 SET DGTAG=$SELECT(DGMFLG=1:"MSG"_DGMFLG,DGMFLG=2:"MSG"_DGMFLG,1:0)
+24 IF DGTAG["MSG"
IF '$GET(DGMSGF)
DO @DGTAG
End DoDot:1
+25 ;return most current MT data
QUIT DGMTDATA
MFLG(DGMTDATA) ;Set up appropriate informational message flag for user's
+1 ;benefit.
+2 ;Input - DGMTDATA as defined by $$LST function.
+3 ;Output - DGRETV
+4 ; 1 = Current Test is REQUIRED
+5 ; 2 = Test is > 1 year older than January 1, 2013 and is in a
+6 ; status of other than REQUIRED or NO LONGER REQUIRED
+7 ; 2 = Pend Adj for GMT, test date is 10/6/99 or
+8 ; greater and agreed to the deductible
+9 ; 0 = CAT C/Pend Adj for MT, test date is 10/6/99
+10 ; or greater and agreed to the deductible.
+11 ; OR 0 = Cat C, declined income info and agreed
+12 ; to pay deductible.
+13 ; OR 0 = Has a future dated Means Test
+14 NEW DGRETV,FTST,DGMT0
+15 SET DGRETV=0
IF '$GET(DGMTDATA)
QUIT DGRETV
+16 SET DGMT0=$GET(^DGMT(408.31,+DGMTDATA,0))
+17 IF $PIECE(DGMTDATA,U,4)="R"
SET DGRETV=1
+18 ;DG*5.3*858 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
+19 IF $$OLDMTPF^DGMTU4($PIECE(DGMTDATA,U,2))
IF ($PIECE(DGMTDATA,U,4)'="N")&($PIECE(DGMTDATA,U,4)'="R")
SET DGRETV=2
+20 IF ($PIECE(DGMTDATA,U,4)="C")!($PIECE(DGMTDATA,U,4)="P"&($PIECE(DGMT0,U,12)'<$PIECE(DGMT0,U,27)))
IF $PIECE(DGMTDATA,U,2)>2991005
IF $PIECE(DGMT0,U,11)=1
SET DGRETV=0
+21 IF ($PIECE(DGMTDATA,U,4)="C")
IF +$PIECE(DGMT0,U,14)
IF +$PIECE(DGMT0,U,11)
SET DGRETV=0
+22 DO DOM^DGMTR
IF $GET(DGDOM)
SET DGRETV=0
+23 SET FTST=$$FUT(DFN)
+24 IF DGRETV
IF FTST
IF $PIECE(^DGMT(408.31,+FTST,0),U,19)=1
SET DGRETV=0
+25 QUIT DGRETV
MSG1 ;Informational message 1
+1 NEW NODE0,Y
+2 SET NODE0=$GET(^DGMT(408.31,+DGMTDATA,0))
+3 WRITE !!,$CHAR(7),?15,"*** Patient Requires a Means Test ***",!
+4 SET Y=$PIECE(NODE0,U)
XECUTE ^DD("DD")
WRITE !,?14,"Primary Means Test Required from "_Y,!
+5 IF $GET(IOST)["C-"
READ !!,"Enter <RETURN> to continue.",DGRET:DTIME
+6 QUIT
MSG2 ;Informational message 2
+1 NEW NODE0,Y
+2 SET NODE0=$GET(^DGMT(408.31,+DGMTDATA,0))
+3 WRITE !!,$CHAR(7),?17,"*** Patient Requires a Means Test ***",!
+4 ;DG*5.3*858
SET Y=$PIECE(NODE0,U)
XECUTE ^DD("DD")
WRITE !,?25,"*** Please update ***",!
+5 ;S Y=$P(NODE0,U) X ^DD("DD") W !,?10,"Patient's Test dated "_Y_" is "_$P(DGMTDATA,U,3)_"."_" The test"
+6 ;W !,?10,"date is greater than 1 year old. Please update."
+7 IF $GET(IOST)["C-"
READ !!,"Enter <RETURN> to continue.",DGRET:DTIME
+8 QUIT
QFLG(DGMTDATA) ;
+1 ;INPUT - DGMTDATA
+2 ;OUTPUT- IVMQFLG 1 if query is necessary 0 if not
+3 NEW IVMQFLG,DGMT0
+4 SET IVMQFLG=0
IF '$GET(DGMTDATA)
QUIT IVMQFLG
+5 SET DGMT0=$GET(^DGMT(408.31,+DGMTDATA,0))
+6 ;Set flag to 1 if Means test is Required.
+7 IF $PIECE(DGMTDATA,U,4)="R"
SET IVMQFLG=1
+8 ;Set flag to 1 if Means test older than 1 year from January 1, 2013 and status is not
+9 ;NO LONGER REQUIRED and not REQUIRED.
+10 ;DG*5.3*858 MT less than 1 year old as of "VFA Start Date" and point forward do not expire
+11 IF $$OLDMTPF^DGMTU4($PIECE(DGMTDATA,U,2))
IF ($PIECE(DGMTDATA,U,4)'="N")&($PIECE(DGMTDATA,U,4)'="R")
SET IVMQFLG=1
+12 ;If Cat C/Pend Adj for MT, older than 1 year from January 1, 2013, agreed to pay, test
+13 ;date > 10/5/99 reset flag to 0 - no query is necessary.
+14 IF ($PIECE(DGMTDATA,U,4)="C")!($PIECE(DGMTDATA,U,4)="P"&($PIECE(DGMT0,U,12)'<$PIECE(DGMT0,U,27)))
IF $PIECE(DGMTDATA,U,2)>2991005
IF $PIECE(DGMT0,U,11)=1
SET IVMQFLG=0
+15 ;If patient is Cat C, declined to provide income but has agreed to
+16 ;pay deductible, no query necessary - reset flag to 0
+17 IF ($PIECE(DGMTDATA,U,4)="C")
IF +$PIECE(DGMT0,U,14)
IF +$PIECE(DGMT0,U,11)
SET DGRETV=0
+18 ;If patient is on a DOM ward, don't initiate query
+19 DO DOM^DGMTR
IF $GET(DGDOM)
SET IVMQFLG=0
+20 QUIT IVMQFLG
+21 ;
FUT(DFN,DGDT,DGMTYPT) ; Future MT for a patient
+1 ;DFN Patient IEN
+2 ;DGDT Date (Optional- default to today)
+3 ;DGMTYPT Type of Test (Optional - default to MT)
+4 ;Return
+5 ;If a DCD test was performed it will be returned, else the
+6 ;current future dated test for the Income Year.
+7 ;MT IEN^Date of Test^Status Name^Status Code^Source
+8 ;
+9 NEW DGIDT,Y,MTIEN,SRCE,DONE,MTNOD,ARR,LAST,TYPTST
+10 if '$DATA(DGMTYPT)
SET DGMTYPT=1
+11 ;no future LTC eg 02/15/2005
+12 IF ($GET(DGMTYPT)=4)
QUIT ""
+13 SET TYPTST=$SELECT(DGMTYPT=2:"AF",1:"AE")
+14 SET DGIDT=$SELECT($GET(DGDT)>0:DGDT,1:DT)
SET DONE=0
+15 SET (ARR,LAST,Y)=""
+16 if $PIECE(DGIDT,".",2)
SET DGIDT=$PIECE(DGIDT,".")
+17 FOR
SET DGIDT=$ORDER(^IVM(301.5,TYPTST,DFN,DGIDT))
if 'DGIDT!(DONE)
QUIT
Begin DoDot:1
+18 SET MTIEN=0
+19 FOR
SET MTIEN=$ORDER(^IVM(301.5,TYPTST,DFN,DGIDT,MTIEN))
if 'MTIEN!(DONE)
QUIT
Begin DoDot:2
+20 if '$DATA(^DGMT(408.31,MTIEN,0))
QUIT
+21 SET MTNOD=^DGMT(408.31,MTIEN,0)
SET SRCE=$PIECE(MTNOD,U,23)
+22 IF SRCE'=1
SET DONE=1
SET Y=MTIEN_U_$PIECE(MTNOD,U)_U_$$MTS^DGMTU(DFN,+$PIECE(MTNOD,U,3))_U_$PIECE(MTNOD,U,23)
QUIT
+23 IF 'DONE
IF '$DATA(ARR($PIECE(MTNOD,U),MTIEN))
SET ARR($PIECE(MTNOD,U),MTIEN)=MTIEN_U_$PIECE(MTNOD,U)_U_$$MTS^DGMTU(DFN,+$PIECE(MTNOD,U,3))_U_$PIECE(MTNOD,U,23)
End DoDot:2
End DoDot:1
+24 IF 'DONE
SET LAST=$ORDER(ARR(""),-1)
IF LAST
SET Y=ARR(LAST,$ORDER(ARR(LAST,""),-1))
+25 QUIT $GET(Y)
