Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTU.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTU.m
r613 r623 1 DGMTU 2 ;;5.3;Registration;**4,33,182,277,290,374,358,420,426,411,332,433,456,476,519,451,630,783**;Aug 13, 1993;Build 2 3 ;MT=Means Test 4 LST(DFN,DGDT,DGMTYPT) ;Last MTfor a patient5 6 7 8 9 10 11 12 13 14 15 16 17 18 LVMT(DFN,DGDT) ;Last valid MT(status other than required)19 20 21 22 23 24 25 26 27 28 NVMT(DFN,DGDT) ;Next valid MT(status other than required)29 30 31 32 33 34 35 36 37 38 39 MTS(DFN,DGMTS) ;MTstatus -- default current40 41 42 43 44 45 46 47 48 DIS(DFN) ;Display patients current MTstatus,49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 DISQ 68 69 EDT(DFN,DGDT) ;Display patients current MTinformation and provide70 71 ; MTor editing an existing means test72 73 74 75 76 77 78 79 80 81 82 83 S DIR("B")=$S(DGMTS&($D(DGPRFLG)):"NO",DGMTS=1:"YES",1:"NO"),DIR(0)="Y"84 85 86 EDTQ 87 88 89 90 91 92 93 CMTS(DFN) ;Get Current MTStatus - query HEC if necessary94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 MFLG(DGMTDATA) 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 MSG1 145 146 147 148 149 150 151 MSG2 152 153 154 155 156 157 158 159 QFLG(DGMTDATA) 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 FUT(DFN,DGDT,DGMTYPT) ; Future MTfor a patient181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 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)
Note:
See TracChangeset
for help on using the changeset viewer.
