| 1 | DGMTU ;ALB/RMO,LBD,BRM,EG - Means Test Utilities ; 02/08/2005 07:10 AM
|
|---|
| 2 | ;;5.3;Registration;**4,33,182,277,290,374,358,420,426,411,332,433,456,476,519,451,630**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | LST(DFN,DGDT,DGMTYPT) ;Last means test for a patient
|
|---|
| 5 | ; Input -- DFN Patient IEN
|
|---|
| 6 | ; DGDT Date/Time (Optional- default today@2359)
|
|---|
| 7 | ; DGMTYPT Type of Test (Optional - if not defined
|
|---|
| 8 | ; Means Test will be assumed)
|
|---|
| 9 | ; Output -- Annual Means Test IEN^Date of Test
|
|---|
| 10 | ; ^Status Name^Status Code^Source of Test
|
|---|
| 11 | N DGIDT,DGMTFL1,DGMTI,DGNOD,Y I '$D(DGMTYPT) S DGMTYPT=1
|
|---|
| 12 | S DGIDT=$S($G(DGDT)>0:-DGDT,1:-DT) S:'$P(DGIDT,".",2) DGIDT=DGIDT_.2359
|
|---|
| 13 | F S DGIDT=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT)) Q:'DGIDT!$G(DGMTFL1) D
|
|---|
| 14 | .F DGMTI=0:0 S DGMTI=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT,DGMTI)) Q:'DGMTI!$G(DGMTFL1) D
|
|---|
| 15 | ..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
|
|---|
| 16 | Q $G(Y)
|
|---|
| 17 | ;
|
|---|
| 18 | LVMT(DFN,DGDT) ;Last valid means test (status other than required)
|
|---|
| 19 | ; Input -- DFN Patient IEN
|
|---|
| 20 | ; DGDT Date (Optional - default today)
|
|---|
| 21 | ; Output -- Annual Means Test IEN^Date of Test^Status Name
|
|---|
| 22 | ; ^Status Code
|
|---|
| 23 | N DGMT,DGMTL
|
|---|
| 24 | S:'$D(DGDT) DGDT=DT S DGMTL=$$LST^DGMTU(DFN,DGDT)
|
|---|
| 25 | 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
|
|---|
| 26 | Q $S($G(DGMT)]"":DGMT,1:$G(DGMTL))
|
|---|
| 27 | ;
|
|---|
| 28 | NVMT(DFN,DGDT) ;Next valid means test (status other than required)
|
|---|
| 29 | ; Input -- DFN Patient IEN
|
|---|
| 30 | ; DGDT Date (Required)
|
|---|
| 31 | ; Output -- Annual Means Test IEN^Date of Test^Status Name
|
|---|
| 32 | ; ^Status Code
|
|---|
| 33 | N DGDTE,DGMT,DGMT0,DGMTI,DGMTPR,DGMTS
|
|---|
| 34 | S DGDTE=DGDT
|
|---|
| 35 | F S DGDTE=$O(^DGMT(408.31,"AD",1,DFN,DGDTE)) Q:'DGDTE!$G(DGMT) D
|
|---|
| 36 | .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
|
|---|
| 37 | Q $G(DGMT)
|
|---|
| 38 | ;
|
|---|
| 39 | MTS(DFN,DGMTS) ;Means test status -- default current
|
|---|
| 40 | ; Input -- DFN Patient IEN
|
|---|
| 41 | ; DGMTS Means Test Status IEN (Optional)
|
|---|
| 42 | ; Output -- Status Name^Status Code
|
|---|
| 43 | N Y
|
|---|
| 44 | S DGMTS=$S($G(DGMTS)>0:DGMTS,1:$P($G(^DPT(DFN,0)),"^",14))
|
|---|
| 45 | I DGMTS S Y=$P($G(^DG(408.32,DGMTS,0)),"^",1,2)
|
|---|
| 46 | Q $G(Y)
|
|---|
| 47 | ;
|
|---|
| 48 | DIS(DFN) ;Display patients current means test status,
|
|---|
| 49 | ; eligibility for care, deductible information,
|
|---|
| 50 | ; date of test and date of completion
|
|---|
| 51 | ; Input -- DFN Patient IEN
|
|---|
| 52 | ; Output -- None
|
|---|
| 53 | N DGCS,DGDED,DGMTI,DGMT0
|
|---|
| 54 | S DGCS=$P($G(^DPT(DFN,0)),"^",14) G DISQ:DGCS=""
|
|---|
| 55 | S DGMTI=+$$LST^DGMTU(DFN),DGMT0=$G(^DGMT(408.31,DGMTI,0))
|
|---|
| 56 | S MTSIG=$P(DGMT0,"^",29)
|
|---|
| 57 | W !,"Means Test Signed?: ",$S(MTSIG=1:"YES",MTSIG=0:"NO",MTSIG=9:"DELETED",1:"")
|
|---|
| 58 | I DGCS=1 W !!,"Patient Requires a Means Test"
|
|---|
| 59 | I DGCS=2 W !!,"Patient's Means Test is Pending Adjudication for "_$$PA^DGMTUTL(DGMTI)
|
|---|
| 60 | I DGCS=3 W !!,"Means Test Not Required"
|
|---|
| 61 | I ("^4^5^6^16^")[("^"_DGCS_"^") W !!,"Patient's status is ",$$GETNAME^DGMTH(DGCS)," based on primary means test"
|
|---|
| 62 | I $D(^DG(408.32,DGCS,"MSG")) W !,^("MSG")
|
|---|
| 63 | I DGCS=6 S DGDED=$P(DGMT0,"^",11) W ! W:DGDED]"" "Has",$S(DGDED:"",1:" not")," agreed to pay the deductible"
|
|---|
| 64 | S Y=$P(DGMT0,"^") X ^DD("DD") W !,"Primary Means Test ",$S(DGCS=1:"Required from",1:"Last Applied")," '",Y,"'"
|
|---|
| 65 | I ("^2^4^5^6^16^")[("^"_DGCS_"^") S Y=$P(DGMT0,"^",7) X ^DD("DD") W " (COMPLETED: ",Y,")"
|
|---|
| 66 | I DGCS=3 S Y=$P(DGMT0,"^",17) X ^DD("DD") W " (NO LONGER REQUIRED: ",Y,")"
|
|---|
| 67 | DISQ Q
|
|---|
| 68 | ;
|
|---|
| 69 | EDT(DFN,DGDT) ;Display patients current means test information and provide
|
|---|
| 70 | ; the user with the option of proceeding with a required
|
|---|
| 71 | ; means test or editing an existing means test
|
|---|
| 72 | ; Input -- DFN Patient IEN
|
|---|
| 73 | ; DGDT Date/Time
|
|---|
| 74 | ; Output -- None
|
|---|
| 75 | ;
|
|---|
| 76 | ; obtain lock used to synchronize local MT/CT options with income test upload
|
|---|
| 77 | I $$LOCK^DGMTUTL(DFN)
|
|---|
| 78 | ;
|
|---|
| 79 | D DIS(DFN)
|
|---|
| 80 | S DGMTI=+$$LST(DFN,DGDT) G EDTQ:'DGMTI!(DGMTI'=+$$LST^DGMTU(DFN))
|
|---|
| 81 | S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGMTDT=+DGMT0,DGMTS=$P(DGMT0,"^",3)
|
|---|
| 82 | S DIR("A")="Do you wish to "_$S(DGMTS=1:"proceed with",1:"edit")_" the means test at this time"
|
|---|
| 83 | S DIR("B")=$S(DGMTS=1:"YES",1:"NO"),DIR(0)="Y"
|
|---|
| 84 | W ! D ^DIR G EDTQ:$D(DTOUT)!($D(DUOUT))
|
|---|
| 85 | I Y S DGMTYPT=1,DGMTACT="EDT",DGMTROU="EDTQ^DGMTU" G EN^DGMTSC
|
|---|
| 86 | EDTQ K DGMT0,DGMTACT,DGMTDT,DGMTI,DGMTROU,DGMTS,DIR,DTOUT,DUOUT,Y
|
|---|
| 87 | ;
|
|---|
| 88 | ; release lock
|
|---|
| 89 | D UNLOCK^DGMTUTL(DFN)
|
|---|
| 90 | ;
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | CMTS(DFN) ;Get Current Means Test Status - query HEC if necessary
|
|---|
| 94 | ;
|
|---|
| 95 | ; Input: DFN=patient ien
|
|---|
| 96 | ; Output: MT IEN^Date of Test^Status Name
|
|---|
| 97 | ; ^Status Code^Source of Test
|
|---|
| 98 | ;
|
|---|
| 99 | N X,Y,DGMTDATA,DGQSENT,DGDOD,NODE0,DGRET,DGMFLG,DGTAG,DGMTYPT
|
|---|
| 100 | D CHKPT^DGMTU4(DFN)
|
|---|
| 101 | S DGMTYPT=1,DGMTDATA=$$LST(DFN,"",DGMTYPT)
|
|---|
| 102 | ;Next line checks to see if patient has expired, if so, Query not initiated
|
|---|
| 103 | S DGDOD=$P($G(^DPT(DFN,.35)),U)
|
|---|
| 104 | I +DGDOD Q DGMTDATA
|
|---|
| 105 | ;Next line checks to see if current test exists, if not, Query not initiated
|
|---|
| 106 | I '$G(DGMTDATA) Q DGMTDATA
|
|---|
| 107 | D:+$$QFLG(DGMTDATA)
|
|---|
| 108 | .I $G(IVMZ10)'="UPLOAD IN PROGRESS",'$$OPEN^IVMCQ2(DFN),'$$SENT^IVMCQ2(DFN),$G(DGMFLG)'=0 D
|
|---|
| 109 | ..I $$LOCK^DGMTUTL(DFN)
|
|---|
| 110 | ..D QRYQUE2^IVMCQ2(DFN,$G(DUZ),0,$G(XQY)) S DGQSENT=1
|
|---|
| 111 | ..I '$D(ZTQUEUED),'$G(DGMSGF),$G(DGQSENT) W !!,"Financial query queued to be sent to HEC...",! H .5
|
|---|
| 112 | ..D UNLOCK^DGMTUTL(DFN)
|
|---|
| 113 | .S DGMTDATA=$$LST(DFN,"",DGMTYPT)
|
|---|
| 114 | D:+$$MFLG(DGMTDATA)
|
|---|
| 115 | .S DGMFLG=$$MFLG(DGMTDATA)
|
|---|
| 116 | .S DGTAG=$S(DGMFLG=1:"MSG"_DGMFLG,DGMFLG=2:"MSG"_DGMFLG,1:0)
|
|---|
| 117 | .I DGTAG["MSG",'$G(DGMSGF) D @DGTAG
|
|---|
| 118 | Q DGMTDATA ;return most current MT data
|
|---|
| 119 | MFLG(DGMTDATA) ;Set up appropriate informational message flag for user's
|
|---|
| 120 | ;benefit.
|
|---|
| 121 | ;Input - DGMTDATA as defined by $$LST function.
|
|---|
| 122 | ;Output - DGRETV
|
|---|
| 123 | ; 1 = Current Test is REQUIRED
|
|---|
| 124 | ; 2 = Test is > 365 days old and is in a status of
|
|---|
| 125 | ; other than REQUIRED or NO LONGER REQUIRED
|
|---|
| 126 | ; 2 = Pend Adj for GMT, test date is 10/6/99 or
|
|---|
| 127 | ; greater and agreed to the deductible
|
|---|
| 128 | ; 0 = CAT C/Pend Adj for MT, test date is 10/6/99
|
|---|
| 129 | ; or greater and agreed to the deductible.
|
|---|
| 130 | ; OR 0 = Cat C, declined income info and agreed
|
|---|
| 131 | ; to pay deductible.
|
|---|
| 132 | ; OR 0 = Has a future dated Means Test
|
|---|
| 133 | N DGRETV,FTST,DGMT0
|
|---|
| 134 | S DGRETV=0 I '$G(DGMTDATA) Q DGRETV
|
|---|
| 135 | S DGMT0=$G(^DGMT(408.31,+DGMTDATA,0))
|
|---|
| 136 | I $P(DGMTDATA,U,4)="R" S DGRETV=1
|
|---|
| 137 | I $$OLD^DGMTU4($P(DGMTDATA,U,2)),($P(DGMTDATA,U,4)'="N")&($P(DGMTDATA,U,4)'="R") S DGRETV=2
|
|---|
| 138 | 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
|
|---|
| 139 | I ($P(DGMTDATA,U,4)="C"),+$P(DGMT0,U,14),+$P(DGMT0,U,11) S DGRETV=0
|
|---|
| 140 | D DOM^DGMTR I $G(DGDOM) S DGRETV=0
|
|---|
| 141 | S FTST=$$FUT(DFN)
|
|---|
| 142 | I DGRETV,FTST,$P(^DGMT(408.31,+FTST,0),U,19)=1 S DGRETV=0
|
|---|
| 143 | Q DGRETV
|
|---|
| 144 | MSG1 ;Informational message 1
|
|---|
| 145 | N NODE0,Y
|
|---|
| 146 | S NODE0=$G(^DGMT(408.31,+DGMTDATA,0))
|
|---|
| 147 | W !!,$C(7),?15,"*** Patient Requires a Means Test ***",!
|
|---|
| 148 | S Y=$P(NODE0,U) X ^DD("DD") W !,?14,"Primary Means Test Required from "_Y,!
|
|---|
| 149 | I $G(IOST)["C-" R !!,"Enter <RETURN> to continue.",DGRET:DTIME
|
|---|
| 150 | Q
|
|---|
| 151 | MSG2 ;Informational message 2
|
|---|
| 152 | N NODE0,Y
|
|---|
| 153 | S NODE0=$G(^DGMT(408.31,+DGMTDATA,0))
|
|---|
| 154 | W !!,$C(7),?17,"*** Patient Requires a Means Test ***",!
|
|---|
| 155 | S Y=$P(NODE0,U) X ^DD("DD") W !,?10,"Patient's Test dated "_Y_" is "_$P(DGMTDATA,U,3)_"."_" The test"
|
|---|
| 156 | W !,?10,"date is greater than 365 days old. Please update."
|
|---|
| 157 | I $G(IOST)["C-" R !!,"Enter <RETURN> to continue.",DGRET:DTIME
|
|---|
| 158 | Q
|
|---|
| 159 | QFLG(DGMTDATA) ;
|
|---|
| 160 | ;INPUT - DGMTDATA
|
|---|
| 161 | ;OUTPUT- IVMQFLG 1 if query is necessary 0 if not
|
|---|
| 162 | N IVMQFLG,DGMT0
|
|---|
| 163 | S IVMQFLG=0 I '$G(DGMTDATA) Q IVMQFLG
|
|---|
| 164 | S DGMT0=$G(^DGMT(408.31,+DGMTDATA,0))
|
|---|
| 165 | ;Set flag to 1 if Means test is Required.
|
|---|
| 166 | I $P(DGMTDATA,U,4)="R" S IVMQFLG=1
|
|---|
| 167 | ;Set flag to 1 if Means test older than 365 days and status is not
|
|---|
| 168 | ;NO LONGER REQUIRED and not REQUIRED.
|
|---|
| 169 | I $$OLD^DGMTU4($P(DGMTDATA,U,2)),($P(DGMTDATA,U,4)'="N")&($P(DGMTDATA,U,4)'="R") S IVMQFLG=1
|
|---|
| 170 | ;If Cat C/Pend Adj for MT, older than 365 days, agreed to pay, test
|
|---|
| 171 | ;date > 10/5/99 reset flag to 0 - no query is necessary.
|
|---|
| 172 | 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
|
|---|
| 173 | ;If patient is Cat C, declined to provide income but has agreed to
|
|---|
| 174 | ;pay deductible, no query necessary - reset flag to 0
|
|---|
| 175 | I ($P(DGMTDATA,U,4)="C"),+$P(DGMT0,U,14),+$P(DGMT0,U,11) S DGRETV=0
|
|---|
| 176 | ;If patient is on a DOM ward, don't initiate query
|
|---|
| 177 | D DOM^DGMTR I $G(DGDOM) S IVMQFLG=0
|
|---|
| 178 | Q IVMQFLG
|
|---|
| 179 | ;
|
|---|
| 180 | FUT(DFN,DGDT,DGMTYPT) ; Future Means Tests for a patient
|
|---|
| 181 | ;DFN Patient IEN
|
|---|
| 182 | ;DGDT Date (Optional- default to today)
|
|---|
| 183 | ;DGMTYPT Type of Test (Optional - default to MT)
|
|---|
| 184 | ;Return
|
|---|
| 185 | ;If a DCD test was performed it will be returned, else the
|
|---|
| 186 | ;current future dated test for the Income Year.
|
|---|
| 187 | ;MT IEN^Date of Test^Status Name^Status Code^Source
|
|---|
| 188 | ;
|
|---|
| 189 | N DGIDT,Y,MTIEN,SRCE,DONE,MTNOD,ARR,LAST,TYPTST
|
|---|
| 190 | S:'$D(DGMTYPT) DGMTYPT=1
|
|---|
| 191 | ;no future LTC eg 02/15/2005
|
|---|
| 192 | I ($G(DGMTYPT)=4) Q ""
|
|---|
| 193 | S TYPTST=$S(DGMTYPT=2:"AF",1:"AE")
|
|---|
| 194 | S DGIDT=$S($G(DGDT)>0:DGDT,1:DT),DONE=0
|
|---|
| 195 | S (ARR,LAST,Y)=""
|
|---|
| 196 | S:$P(DGIDT,".",2) DGIDT=$P(DGIDT,".")
|
|---|
| 197 | F S DGIDT=$O(^IVM(301.5,TYPTST,DFN,DGIDT)) Q:'DGIDT!(DONE) D
|
|---|
| 198 | .S MTIEN=0
|
|---|
| 199 | .F S MTIEN=$O(^IVM(301.5,TYPTST,DFN,DGIDT,MTIEN)) Q:'MTIEN!(DONE) D
|
|---|
| 200 | ..Q:'$D(^DGMT(408.31,MTIEN,0))
|
|---|
| 201 | ..S MTNOD=^DGMT(408.31,MTIEN,0),SRCE=$P(MTNOD,U,23)
|
|---|
| 202 | ..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
|
|---|
| 203 | ..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)
|
|---|
| 204 | I 'DONE S LAST=$O(ARR(""),-1) I LAST S Y=ARR(LAST,$O(ARR(LAST,""),-1))
|
|---|
| 205 | Q $G(Y)
|
|---|
