Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGMTU

DGMTU.m

Go to the documentation of this file.
  1. 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
  1. ;MT=Means Test
  1. LST(DFN,DGDT,DGMTYPT) ;Last MT for a patient
  1. ; Input -- DFN Patient IEN
  1. ; DGDT Date/Time (Optional- default today@2359)
  1. ; DGMTYPT Type of Test (Optional - if not defined
  1. ; Means Test will be assumed)
  1. ; Output -- Annual Means Test IEN^Date of Test
  1. ; ^Status Name^Status Code^Source of Test
  1. N DGIDT,DGMTFL1,DGMTI,DGNOD,Y I '$D(DGMTYPT) S DGMTYPT=1
  1. S DGIDT=$S($G(DGDT)>0:-DGDT,1:-DT) S:'$P(DGIDT,".",2) DGIDT=DGIDT_.2359
  1. F S DGIDT=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT)) Q:'DGIDT!$G(DGMTFL1) D
  1. .F DGMTI=0:0 S DGMTI=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT,DGMTI)) Q:'DGMTI!$G(DGMTFL1) D
  1. ..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
  1. Q $G(Y)
  1. ;
  1. LVMT(DFN,DGDT) ;Last valid MT (status other than required)
  1. ; Input -- DFN Patient IEN
  1. ; DGDT Date (Optional - default today)
  1. ; Output -- Annual Means Test IEN^Date of Test^Status Name
  1. ; ^Status Code
  1. N DGMT,DGMTL
  1. S:'$D(DGDT) DGDT=DT S DGMTL=$$LST^DGMTU(DFN,DGDT)
  1. 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
  1. Q $S($G(DGMT)]"":DGMT,1:$G(DGMTL))
  1. ;
  1. NVMT(DFN,DGDT) ;Next valid MT (status other than required)
  1. ; Input -- DFN Patient IEN
  1. ; DGDT Date (Required)
  1. ; Output -- Annual Means Test IEN^Date of Test^Status Name
  1. ; ^Status Code
  1. N DGDTE,DGMT,DGMT0,DGMTI,DGMTPR,DGMTS
  1. S DGDTE=DGDT
  1. F S DGDTE=$O(^DGMT(408.31,"AD",1,DFN,DGDTE)) Q:'DGDTE!$G(DGMT) D
  1. .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
  1. Q $G(DGMT)
  1. ;
  1. MTS(DFN,DGMTS) ;MT status -- default current
  1. ; Input -- DFN Patient IEN
  1. ; DGMTS Means Test Status IEN (Optional)
  1. ; Output -- Status Name^Status Code
  1. N Y
  1. S DGMTS=$S($G(DGMTS)>0:DGMTS,1:$P($G(^DPT(DFN,0)),"^",14))
  1. I DGMTS S Y=$P($G(^DG(408.32,DGMTS,0)),"^",1,2)
  1. Q $G(Y)
  1. ;
  1. DIS(DFN) ;Display patients current MT status,
  1. ; eligibility for care, deductible information,
  1. ; date of test and date of completion
  1. ; Input -- DFN Patient IEN
  1. ; Output -- None
  1. N DGCS,DGDED,DGMTI,DGMT0
  1. S DGCS=$P($G(^DPT(DFN,0)),"^",14) G DISQ:DGCS=""
  1. S DGMTI=+$$LST^DGMTU(DFN),DGMT0=$G(^DGMT(408.31,DGMTI,0))
  1. S MTSIG=$P(DGMT0,"^",29)
  1. W !,"Means Test Signed?: ",$S(MTSIG=1:"YES",MTSIG=0:"NO",MTSIG=9:"DELETED",1:"")
  1. I DGCS=1 W !!,"Patient Requires a Means Test"
  1. I DGCS=2 W !!,"Patient's Means Test is Pending Adjudication for "_$$PA^DGMTUTL(DGMTI)
  1. I DGCS=3 W !!,"Means Test Not Required"
  1. I ("^4^5^6^16^")[("^"_DGCS_"^") W !!,"Patient's status is ",$$GETNAME^DGMTH(DGCS)," based on primary means test"
  1. I $D(^DG(408.32,DGCS,"MSG")) W !,^("MSG")
  1. I DGCS=6 S DGDED=$P(DGMT0,"^",11) W ! W:DGDED]"" "Has",$S(DGDED:"",1:" not")," agreed to pay the deductible"
  1. S Y=$P(DGMT0,"^") X ^DD("DD") W !,"Primary Means Test ",$S(DGCS=1:"Required from",1:"Last Applied")," '",Y,"'"
  1. I ("^2^4^5^6^16^")[("^"_DGCS_"^") S Y=$P(DGMT0,"^",7) X ^DD("DD") W " (COMPLETED: ",Y,")"
  1. I DGCS=3 S Y=$P(DGMT0,"^",17) X ^DD("DD") W " (NO LONGER REQUIRED: ",Y,")"
  1. DISQ Q
  1. ;
  1. EDT(DFN,DGDT) ;Display patients current MT information and provide
  1. ; the user with the option of proceeding with a required
  1. ; MT or editing an existing means test
  1. ; Input -- DFN Patient IEN
  1. ; DGDT Date/Time
  1. ; Output -- None
  1. ;
  1. ; obtain lock used to synchronize local MT/CT options with income test upload
  1. ; '+' added to VSITE check to allow divisions to edit parent owned tests
  1. N VSITE
  1. I $$LOCK^DGMTUTL(DFN)
  1. ;
  1. D DIS(DFN)
  1. S DGMTI=+$$LST(DFN,DGDT),VSITE=+$P($$SITE^VASITE(),U,3)
  1. G EDTQ:'DGMTI!(DGMTI'=+$$LST^DGMTU(DFN))
  1. I +$P($G(^DGMT(408.31,DGMTI,2)),U,5)'=VSITE G EDTQ ; Test doesn't belong to site
  1. S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGMTDT=+DGMT0,DGMTS=$P(DGMT0,"^",3)
  1. S DIR("A")="Do you wish to "_$S(DGMTS=1:"proceed with",1:"edit")_" the means test at this time"
  1. S DIR("B")=$S(DGMTS&($D(DGPRFLG)):"NO",DGMTS=1:"YES",1:"NO"),DIR(0)="Y"
  1. W ! D ^DIR G EDTQ:$D(DTOUT)!($D(DUOUT))
  1. I Y S DGMTYPT=1,DGMTACT="EDT",DGMTROU="EDTQ^DGMTU" G EN^DGMTSC
  1. EDTQ K DGMT0,DGMTACT,DGMTDT,DGMTI,DGMTROU,DGMTS,DIR,DTOUT,DUOUT,Y
  1. ;
  1. ; release lock
  1. D UNLOCK^DGMTUTL(DFN)
  1. ;
  1. Q
  1. ;
  1. CMTS(DFN) ;Get Current MT Status - query HEC if necessary
  1. ;
  1. ; Input: DFN=patient ien
  1. ; Output: MT IEN^Date of Test^Status Name
  1. ; ^Status Code^Source of Test
  1. ;
  1. N X,Y,DGMTDATA,DGQSENT,DGDOD,NODE0,DGRET,DGMFLG,DGTAG,DGMTYPT
  1. D CHKPT^DGMTU4(DFN)
  1. S DGMTYPT=1,DGMTDATA=$$LST(DFN,"",DGMTYPT)
  1. ;Next line checks to see if patient has expired, if so, Query not initiated
  1. S DGDOD=$P($G(^DPT(DFN,.35)),U)
  1. I +DGDOD Q DGMTDATA
  1. ;Next line checks to see if current test exists, if not, Query not initiated
  1. I '$G(DGMTDATA) Q DGMTDATA
  1. D:+$$QFLG(DGMTDATA)
  1. .I $G(IVMZ10)'="UPLOAD IN PROGRESS",'$$OPEN^IVMCQ2(DFN),'$$SENT^IVMCQ2(DFN),$G(DGMFLG)'=0 D
  1. ..I $$LOCK^DGMTUTL(DFN)
  1. ..D QRYQUE2^IVMCQ2(DFN,$G(DUZ),0,$G(XQY)) S DGQSENT=1
  1. ..I '$D(ZTQUEUED),'$G(DGMSGF),$G(DGQSENT) W !!,"Financial query queued to be sent to HEC...",! H .5
  1. ..D UNLOCK^DGMTUTL(DFN)
  1. .S DGMTDATA=$$LST(DFN,"",DGMTYPT)
  1. D:+$$MFLG(DGMTDATA)
  1. .S DGMFLG=$$MFLG(DGMTDATA)
  1. .S DGTAG=$S(DGMFLG=1:"MSG"_DGMFLG,DGMFLG=2:"MSG"_DGMFLG,1:0)
  1. .I DGTAG["MSG",'$G(DGMSGF) D @DGTAG
  1. Q DGMTDATA ;return most current MT data
  1. MFLG(DGMTDATA) ;Set up appropriate informational message flag for user's
  1. ;benefit.
  1. ;Input - DGMTDATA as defined by $$LST function.
  1. ;Output - DGRETV
  1. ; 1 = Current Test is REQUIRED
  1. ; 2 = Test is > 365 days old and is in a status of
  1. ; other than REQUIRED or NO LONGER REQUIRED
  1. ; 2 = Pend Adj for GMT, test date is 10/6/99 or
  1. ; greater and agreed to the deductible
  1. ; 0 = CAT C/Pend Adj for MT, test date is 10/6/99
  1. ; or greater and agreed to the deductible.
  1. ; OR 0 = Cat C, declined income info and agreed
  1. ; to pay deductible.
  1. ; OR 0 = Has a future dated Means Test
  1. N DGRETV,FTST,DGMT0
  1. S DGRETV=0 I '$G(DGMTDATA) Q DGRETV
  1. S DGMT0=$G(^DGMT(408.31,+DGMTDATA,0))
  1. I $P(DGMTDATA,U,4)="R" S DGRETV=1
  1. I $$OLD^DGMTU4($P(DGMTDATA,U,2)),($P(DGMTDATA,U,4)'="N")&($P(DGMTDATA,U,4)'="R") S DGRETV=2
  1. 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
  1. I ($P(DGMTDATA,U,4)="C"),+$P(DGMT0,U,14),+$P(DGMT0,U,11) S DGRETV=0
  1. D DOM^DGMTR I $G(DGDOM) S DGRETV=0
  1. S FTST=$$FUT(DFN)
  1. I DGRETV,FTST,$P(^DGMT(408.31,+FTST,0),U,19)=1 S DGRETV=0
  1. Q DGRETV
  1. MSG1 ;Informational message 1
  1. N NODE0,Y
  1. S NODE0=$G(^DGMT(408.31,+DGMTDATA,0))
  1. W !!,$C(7),?15,"*** Patient Requires a Means Test ***",!
  1. S Y=$P(NODE0,U) X ^DD("DD") W !,?14,"Primary Means Test Required from "_Y,!
  1. I $G(IOST)["C-" R !!,"Enter <RETURN> to continue.",DGRET:DTIME
  1. Q
  1. MSG2 ;Informational message 2
  1. N NODE0,Y
  1. S NODE0=$G(^DGMT(408.31,+DGMTDATA,0))
  1. W !!,$C(7),?17,"*** Patient Requires a Means Test ***",!
  1. S Y=$P(NODE0,U) X ^DD("DD") W !,?10,"Patient's Test dated "_Y_" is "_$P(DGMTDATA,U,3)_"."_" The test"
  1. W !,?10,"date is greater than 365 days old. Please update."
  1. I $G(IOST)["C-" R !!,"Enter <RETURN> to continue.",DGRET:DTIME
  1. Q
  1. QFLG(DGMTDATA) ;
  1. ;INPUT - DGMTDATA
  1. ;OUTPUT- IVMQFLG 1 if query is necessary 0 if not
  1. N IVMQFLG,DGMT0
  1. S IVMQFLG=0 I '$G(DGMTDATA) Q IVMQFLG
  1. S DGMT0=$G(^DGMT(408.31,+DGMTDATA,0))
  1. ;Set flag to 1 if Means test is Required.
  1. I $P(DGMTDATA,U,4)="R" S IVMQFLG=1
  1. ;Set flag to 1 if Means test older than 365 days and status is not
  1. ;NO LONGER REQUIRED and not REQUIRED.
  1. I $$OLD^DGMTU4($P(DGMTDATA,U,2)),($P(DGMTDATA,U,4)'="N")&($P(DGMTDATA,U,4)'="R") S IVMQFLG=1
  1. ;If Cat C/Pend Adj for MT, older than 365 days, agreed to pay, test
  1. ;date > 10/5/99 reset flag to 0 - no query is necessary.
  1. 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
  1. ;If patient is Cat C, declined to provide income but has agreed to
  1. ;pay deductible, no query necessary - reset flag to 0
  1. I ($P(DGMTDATA,U,4)="C"),+$P(DGMT0,U,14),+$P(DGMT0,U,11) S DGRETV=0
  1. ;If patient is on a DOM ward, don't initiate query
  1. D DOM^DGMTR I $G(DGDOM) S IVMQFLG=0
  1. Q IVMQFLG
  1. ;
  1. FUT(DFN,DGDT,DGMTYPT) ; Future MT for a patient
  1. ;DFN Patient IEN
  1. ;DGDT Date (Optional- default to today)
  1. ;DGMTYPT Type of Test (Optional - default to MT)
  1. ;Return
  1. ;If a DCD test was performed it will be returned, else the
  1. ;current future dated test for the Income Year.
  1. ;MT IEN^Date of Test^Status Name^Status Code^Source
  1. ;
  1. N DGIDT,Y,MTIEN,SRCE,DONE,MTNOD,ARR,LAST,TYPTST
  1. S:'$D(DGMTYPT) DGMTYPT=1
  1. ;no future LTC eg 02/15/2005
  1. I ($G(DGMTYPT)=4) Q ""
  1. S TYPTST=$S(DGMTYPT=2:"AF",1:"AE")
  1. S DGIDT=$S($G(DGDT)>0:DGDT,1:DT),DONE=0
  1. S (ARR,LAST,Y)=""
  1. S:$P(DGIDT,".",2) DGIDT=$P(DGIDT,".")
  1. F S DGIDT=$O(^IVM(301.5,TYPTST,DFN,DGIDT)) Q:'DGIDT!(DONE) D
  1. .S MTIEN=0
  1. .F S MTIEN=$O(^IVM(301.5,TYPTST,DFN,DGIDT,MTIEN)) Q:'MTIEN!(DONE) D
  1. ..Q:'$D(^DGMT(408.31,MTIEN,0))
  1. ..S MTNOD=^DGMT(408.31,MTIEN,0),SRCE=$P(MTNOD,U,23)
  1. ..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
  1. ..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)
  1. I 'DONE S LAST=$O(ARR(""),-1) I LAST S Y=ARR(LAST,$O(ARR(LAST,""),-1))
  1. Q $G(Y)