- DGMTU ;ALB/RMO,LBD,BRM,EG - Means Test Utilities ; 02/08/2005 07:10 AM
- ;;5.3;PIMS;**4,33,182,277,290,374,358,420,426,411,332,433,456,476,519,451,630,1015,1016**;JUN 30, 2012;Build 20
- ;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 > 365 days old 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
- I $$OLD^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 !,?10,"Patient's Test dated "_Y_" is "_$P(DGMTDATA,U,3)_"."_" The test"
- W !,?10,"date is greater than 365 days 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 365 days and status is not
- ;NO LONGER REQUIRED and not REQUIRED.
- I $$OLD^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 365 days, 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)
- DGMTU ;ALB/RMO,LBD,BRM,EG - Means Test Utilities ; 02/08/2005 07:10 AM
- +1 ;;5.3;PIMS;**4,33,182,277,290,374,358,420,426,411,332,433,456,476,519,451,630,1015,1016**;JUN 30, 2012;Build 20
- +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 > 365 days old and is in a status of
- +6 ; 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 IF $$OLD^DGMTU4($PIECE(DGMTDATA,U,2))
- IF ($PIECE(DGMTDATA,U,4)'="N")&($PIECE(DGMTDATA,U,4)'="R")
- SET DGRETV=2
- +19 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
- +20 IF ($PIECE(DGMTDATA,U,4)="C")
- IF +$PIECE(DGMT0,U,14)
- IF +$PIECE(DGMT0,U,11)
- SET DGRETV=0
- +21 DO DOM^DGMTR
- IF $GET(DGDOM)
- SET DGRETV=0
- +22 SET FTST=$$FUT(DFN)
- +23 IF DGRETV
- IF FTST
- IF $PIECE(^DGMT(408.31,+FTST,0),U,19)=1
- SET DGRETV=0
- +24 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 SET Y=$PIECE(NODE0,U)
- XECUTE ^DD("DD")
- WRITE !,?10,"Patient's Test dated "_Y_" is "_$PIECE(DGMTDATA,U,3)_"."_" The test"
- +5 WRITE !,?10,"date is greater than 365 days old. Please update."
- +6 IF $GET(IOST)["C-"
- READ !!,"Enter <RETURN> to continue.",DGRET:DTIME
- +7 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 365 days and status is not
- +9 ;NO LONGER REQUIRED and not REQUIRED.
- +10 IF $$OLD^DGMTU4($PIECE(DGMTDATA,U,2))
- IF ($PIECE(DGMTDATA,U,4)'="N")&($PIECE(DGMTDATA,U,4)'="R")
- SET IVMQFLG=1
- +11 ;If Cat C/Pend Adj for MT, older than 365 days, agreed to pay, test
- +12 ;date > 10/5/99 reset flag to 0 - no query is necessary.
- +13 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
- +14 ;If patient is Cat C, declined to provide income but has agreed to
- +15 ;pay deductible, no query necessary - reset flag to 0
- +16 IF ($PIECE(DGMTDATA,U,4)="C")
- IF +$PIECE(DGMT0,U,14)
- IF +$PIECE(DGMT0,U,11)
- SET DGRETV=0
- +17 ;If patient is on a DOM ward, don't initiate query
- +18 DO DOM^DGMTR
- IF $GET(DGDOM)
- SET IVMQFLG=0
- +19 QUIT IVMQFLG
- +20 ;
- 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)