- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCM.m
r613 r623 1 IVMCM ;ALB/SEK,KCL,RTK,AEG,BRM,AEG - PROCESS INCOME TEST (Z10) TRANSMISSIONS ; 04/23/03 1:43pm 2 ;;2.0;INCOME VERIFICATION MATCH;**12,17,28,41,44,53,34,49,59,55,63,77,74,123**;21-OCT-94;Build 6 3 ; 4 ; 5 ORF ; Handler for ORF type HL7 messages received from HEC 6 ; 7 ; Make sure POSTMASTER DUZ instead of DUZ of Person who 8 ; started Incoming Logical Link. 9 S DUZ=.5 10 N CNT,IVMRTN,SEGCNT 11 S IVMRTN="IVMCMX" ;USE "IVMCMX" BECAUSE "IVMCM" ALREADY USED 12 K ^TMP($J,IVMRTN),DIC 13 S (DGMSGF,DGMTMSG)=1 ; HL7 rtn. Don't need DG interative messages. 14 S HLECH=HL("ECH"),HLQ=HL("Q"),HLMID=HL("MID") 15 K %,%H,%I D NOW^%DTC S HLDT=% 16 F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D 17 . S CNT=0 18 . S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE 19 . F S CNT=$O(HLNODE(CNT)) Q:'CNT D 20 . . S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE(CNT) 21 S HLDA=HLMTIEN 22 ; 23 N SEG,EVENT,MSGID 24 S:'$D(HLEVN) HLEVN=0 25 D NXTSEG^DGENUPL(HLDA,0,.SEG) 26 Q:(SEG("TYPE")'="MSH") ;would not have reached here if this happened! 27 S EVENT=$P(SEG(9),$E(HLECH),2) 28 ; 29 ; INITIALIZE HL7 VARIABLES 30 S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORF-"_EVENT_" SERVER" 31 S HLEID=$O(^ORD(101,"B",HLEID,0)) 32 D INIT^HLFNC2(HLEID,.HL) 33 S HLEIDS=$O(^ORD(101,HLEID,775,"B",0)) 34 ; 35 ; Handle means test signature ORF (Z06) event 36 I EVENT="Z06" D ORF^IVMPREC7 37 ; 38 ; Handle income test ORF (Z10) event 39 I EVENT="Z10" D Z10 40 ; 41 ; Handle enrollment/elig. ORF (Z11) event 42 I EVENT="Z11" D 43 .S MSGID=SEG(10) 44 .D ORFZ11^DGENUPL(HLDA,MSGID) 45 ; 46 K ^TMP($J,IVMRTN) 47 Q 48 ; 49 ; 50 Z10 ; Entry point for receipt of ORF~Z10 transmission 51 ; The Income Test (Z10) transmission has the following format: 52 ; 53 ; BHS ORF msgs do not include batch header or trailer. 54 ; {MSH 55 ; PID They will include the sequence: MSA 56 ; ZIC QRD 57 ; ZIR QRF 58 ; {ZDP These segments will follow the MSH segment. 59 ; ZIC 60 ; ZIR 61 ; } 62 ; {ZMT 63 ; } 64 ; ZBT 65 ; } 66 ; BTS 67 ; 68 S IVMORF=1 ; set ORF msg flag 69 S (HLEVN,IVMCT,IVMERROR,IVMCNTR)=0 ; init vars 70 ; 71 ORU ; Entry point for receipt of ORU~Z10 trans (called by IVMPREC2) 72 S IVMTYPE=5,IVMZ10F=1 73 ; 74 ; - loop through the msg in (#772 file), and process (PROC) msgs 75 S IVMDA=0 F S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D PROC Q:'IVMDA 76 ; 77 ; - if ORF msg flag, update the Query Tran Log and send ACK 78 I $G(IVMORF) D 79 .I $G(DFN),$D(IVMMCI) D 80 ..N IVMCR 81 ..S IVMCR=$P("1^2^3^7^5^6^4","^",IVMTYPE) ;map reason to test type 82 ..D FIND^IVMCQ2(DFN,IVMMCI,HLDT,$S($D(HLERR):5,1:IVMCR),1) 83 .;D ACK^IVMPREC:'$D(HLERR) 84 .;N HLRESLTA,HLP 85 .;D GENACK^HLMA1(HLEID,HLMTIEN,HLEIDS,"LM",1,.HLRESLTA,"",.HLP) 86 ; 87 ; - if tests are uploaded, generate notification msg 88 I $D(^TMP($J,"IVMBULL")) D ^IVMCMB 89 ; 90 ENQ ; 91 K IVMDA,IVMORF,IVMSEG,IVMFLGC,IVMTYPE,IVMMTIEN,IVMMTDT,IVMDGBT,IVMMCI 92 K ^TMP($J,"IVMCM"),^("IVMBULL"),DGMSGF,DGADDF,IVMCPAY,IVMBULL,DFN 93 K DGMTMSG,IVMZ10F 94 Q 95 ; 96 PROC ; Process each HL7 message from (#772) file 97 ; 98 N IVMFUTR,TMSTAMP,SOURCE,NODE,HSDATE,IVMZ10,DGMTP,DGMTACT,DGMTI,DGMTA 99 S DGMTACT="ADD" 100 D PRIOR^DGMTEVT 101 S IVMZ10="UPLOAD IN PROGRESS" 102 S IVMFUTR=0 ;this flag will indicate whether or not a test with a future date is being uploaded 103 S IVMMTIEN=0 104 ; 105 S MSGID=$P(IVMSEG,HLFS,10) ; msg control id for ACK's 106 ; - check if DCD messaging is enabled 107 I '$$DCDON^IVMUPAR1() D PROB^IVMCMC("Facility has DCD messaging disabled") Q 108 ; 109 ; - check HL7 msg structure for errors 110 K HLERR,^TMP($J,"IVMCM") 111 D ^IVMCMC I $D(HLERR) K:HLERR="" HLERR Q 112 ; 113 ; Determine type of test/transmission 114 S IVMTYPE=0 115 ; 116 ; - was a means test sent? 117 I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2) S IVMTYPE=1 ; MT trans 118 ; 119 ; - if MT and CT transmitted, error - pt can't have both unless 120 ; one is a deletion, but HEC not currently handling that situation 121 I IVMTYPE,$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) D PROB^IVMCMC("Patient can not have both a Means Test and Copay Test") Q 122 I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) S IVMTYPE=2 ; CT trans 123 ; 124 ; - if no MT or CT or LTC then Income Screening 125 I 'IVMTYPE,'$P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2) S IVMTYPE=3 ; IS trans 126 ; 127 ;send an eligibility query if no eligibility code 128 I '$$ELIG^IVMCUF1(DFN),'$$PENDING^DGENQRY(DFN) I $$SEND^DGENQRY1(DFN) 129 ; 130 ; obtain locks used to sychronize upload with local income test options 131 D GETLOCKS^IVMCUPL(DFN) 132 ; 133 ; 134 MT ; If transmission is a Means Test 135 N NODE0,RET,CODE,DATA 136 S HLQ=$G(HL("Q")) 137 S:HLQ="" HLQ="""""" 138 I IVMTYPE=1 D I $D(HLERR) G PROCQ 139 .S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2)) 140 .S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,25)) 141 .S HSDATE=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,24)) 142 .S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,22) 143 .S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,1) 144 .; Check that test is for same year 145 .I $P(IVMLAST,U,2),$E($P(IVMLAST,U,2),1,3)'=$E(IVMMTDT,1,3) S IVMLAST="" 146 .I $$Z06MT^EASPTRN1(+IVMLAST) D PROB^IVMCMC("IVM Means Test already on file for this year") Q 147 .I '$$ELIG^IVMUFNC5(DFN) S ERRMSG="Means Test upload not appropriate for current patient" 148 .I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D 149 ..N CATCZMT S CATCZMT=$G(^TMP($J,"IVMCM","ZMT1")) 150 ..S CATC=$$CATC^IVMUFNC5(CATCZMT) 151 ..I '+$G(CATC) S ERRMSG="Only Means Tests in current/previous income years are valid (not effective)" 152 .I $G(ERRMSG)'="" D PROB^IVMCMC(ERRMSG) K ERRMSG,CATC Q 153 .; 154 .; - perform edit checks and file MT 155 .D CHKDT 156 .;deletion indicator sent? 157 .I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,3)=HLQ D Q 158 ..D 159 ...;if there is a future test for that income year, delete that 160 ...N IEN,DATA,IVMPAT 161 ...S IEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),1,.IVMPAT) 162 ...I IEN S DATA(.06)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA) 163 ...I IEN,$D(^DGMT(408.31,IEN,0)) D 164 ....S IVMMTIEN=IEN 165 ....S IVMFUTR=1 166 ...E D 167 ....S IVMFUTR=0 168 ..Q:('IVMMTIEN) 169 ..S NODE0=$G(^DGMT(408.31,IVMMTIEN,0)) 170 ..I $$EN^IVMCMD(IVMMTIEN) D 171 ...S RET=$$LST^DGMTU(DFN,DT,IVMTYPE) 172 ...S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"") 173 ...D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE) 174 .; 175 .;check timestamp - if matches current primary test and hardship matches, then this is a duplicate and does not need to be uploaded 176 .I TMSTAMP D 177 ..S NODE="" 178 ..I IVMFUTR N IVMMTIEN S IVMMTIEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),1) 179 ..Q:'IVMMTIEN 180 ..S NODE=$G(^DGMT(408.31,IVMMTIEN,2)) 181 .S NODE0=$G(^DGMT(408.31,IVMMTIEN,0)) 182 .I TMSTAMP,TMSTAMP=$P(NODE,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE,"^",5),(HSDATE=$P(NODE,"^")) Q 183 .; 184 .D DELTYPE^IVMCMD(DFN,IVMMTDT,2) 185 .D EN^IVMCM1 186 ; 187 ; 188 CT ; If transmission is a Copay Test 189 N NODE0,RET,CODE,DATA 190 I IVMTYPE=2 D I $D(HLERR) G PROCQ 191 .S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2)) 192 .S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,25)) 193 .S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,22) 194 .S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,2) 195 .S IVMCPAY=$$RXST^IBARXEU(DFN) 196 .I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D PROB^IVMCMC("Only Copay Tests in the current/previous income years are valid. (Not effective)") Q 197 .; - perform edit checks and file CT 198 .D CHKDT 199 .;deletion indicator sent? 200 .I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,3)=HLQ D Q 201 ..D 202 ...;if there is a future test for that income year, delete that 203 ...N IEN,DATA,IVMPAT 204 ...S IEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),2,.IVMPAT) 205 ...I IEN S DATA(.07)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA) 206 ...I IEN,$D(^DGMT(408.31,IEN,0)) D 207 ....S IVMMTIEN=IEN 208 ....S IVMFUTR=1 209 ...E D 210 ....S IVMFUTR=0 211 ..Q:('IVMMTIEN) 212 ..S NODE0=$G(^DGMT(408.31,IVMMTIEN,0)) 213 ..I $$EN^IVMCMD(IVMMTIEN) D 214 ...S RET=$$LST^DGMTU(DFN,DT,IVMTYPE) 215 ...S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"") 216 ...D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE) 217 .; 218 .;check timestamp - if matches current primary test, then this is a duplicate and does not need to be uploaded 219 .I TMSTAMP D 220 ..S NODE="" 221 ..I IVMFUTR N IVMMTIEN S IVMMTIEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),2) 222 ..Q:'IVMMTIEN 223 ..S NODE=$G(^DGMT(408.31,IVMMTIEN,2)) 224 .S NODE0=$G(^DGMT(408.31,IVMMTIEN,0)) 225 .I TMSTAMP,TMSTAMP=$P(NODE,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE,"^",5) Q 226 .; 227 .D DELTYPE^IVMCMD(DFN,IVMMTDT,1) 228 .D EN^IVMCM1 229 ; 230 IS ; - If transmission is income screening info only then do not process 231 ; - outside of the scope of MTS 232 ;I IVMTYPE=3 S IVMMTDT=0 D EN^IVMCM1 I $D(HLERR) G PROCQ 233 I IVMTYPE=3 S IVMMTDT=0 234 ; 235 LTC ; If transmission contains a Long Term Care Test (TYPE 4 TEST) 236 I $P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2) D LTC^IVMCM1 237 ; 238 PROCQ ; 239 ; release locks used to sychronize upload with local income test options 240 D RELLOCKS^IVMCUPL(DFN) 241 Q 242 ; 243 CHKDT ; check date of income test being uploaded 244 ; Is it a future date? If so, set IVMFUTR=1 245 ; 246 ; IVMMTIEN is the IEN of current primary test for the year 247 ; 248 I $E($P(IVMLAST,"^",2),1,3)=$E(IVMMTDT,1,3) S IVMMTIEN=+IVMLAST 249 I IVMMTDT>DT S IVMFUTR=1 250 Q 251 FUTURE(DFN,YEAR,TYPE,IVMPAT) ; 252 ;Returns the ien of the future test, if there is one 253 ;Inputs: DFN 254 ; YEAR - income year 255 ; TYPE - type of test 256 ;Output: 257 ; function value - ien of future means test, if there is one, "" otherwise 258 ; IVMPAT - Pointer to the IVM Patient file for the income year if there is an entry (pass by reference) 259 ; 260 N RET 261 S RET="" 262 S IVMPAT=$$FIND^IVMPLOG(DFN,YEAR) 263 I IVMPAT S RET=$P($G(^IVM(301.5,IVMPAT,0)),"^",$S(TYPE=1:6,1:7)) 264 Q RET 1 IVMCM ;ALB/SEK,KCL,RTK,AEG,BRM,AEG - PROCESS INCOME TEST (Z10) TRANSMISSIONS ; 04/23/03 1:43pm 2 ;;2.0;INCOME VERIFICATION MATCH;**12,17,28,41,44,53,34,49,59,55,63,77,74**;21-OCT-94 3 ; 4 ; 5 ORF ; Handler for ORF type HL7 messages received from HEC 6 ; 7 ; Make sure POSTMASTER DUZ instead of DUZ of Person who 8 ; started Incoming Logical Link. 9 S DUZ=.5 10 N CNT,IVMRTN,SEGCNT 11 S IVMRTN="IVMCMX" ;USE "IVMCMX" BECAUSE "IVMCM" ALREADY USED 12 K ^TMP($J,IVMRTN),DIC 13 S (DGMSGF,DGMTMSG)=1 ; HL7 rtn. Don't need DG interative messages. 14 S HLECH=HL("ECH"),HLQ=HL("Q"),HLMID=HL("MID") 15 K %,%H,%I D NOW^%DTC S HLDT=% 16 F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D 17 . S CNT=0 18 . S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE 19 . F S CNT=$O(HLNODE(CNT)) Q:'CNT D 20 . . S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE(CNT) 21 S HLDA=HLMTIEN 22 ; 23 N SEG,EVENT,MSGID 24 S:'$D(HLEVN) HLEVN=0 25 D NXTSEG^DGENUPL(HLDA,0,.SEG) 26 Q:(SEG("TYPE")'="MSH") ;would not have reached here if this happened! 27 S EVENT=$P(SEG(9),$E(HLECH),2) 28 ; 29 ; INITIALIZE HL7 VARIABLES 30 S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORF-"_EVENT_" SERVER" 31 S HLEID=$O(^ORD(101,"B",HLEID,0)) 32 D INIT^HLFNC2(HLEID,.HL) 33 S HLEIDS=$O(^ORD(101,HLEID,775,"B",0)) 34 ; 35 ; Handle means test signature ORF (Z06) event 36 I EVENT="Z06" D ORF^IVMPREC7 37 ; 38 ; Handle income test ORF (Z10) event 39 I EVENT="Z10" D Z10 40 ; 41 ; Handle enrollment/elig. ORF (Z11) event 42 I EVENT="Z11" D 43 .S MSGID=SEG(10) 44 .D ORFZ11^DGENUPL(HLDA,MSGID) 45 ; 46 K ^TMP($J,IVMRTN) 47 Q 48 ; 49 ; 50 Z10 ; Entry point for receipt of ORF~Z10 transmission 51 ; The Income Test (Z10) transmission has the following format: 52 ; 53 ; BHS ORF msgs do not include batch header or trailer. 54 ; {MSH 55 ; PID They will include the sequence: MSA 56 ; ZIC QRD 57 ; ZIR QRF 58 ; {ZDP These segments will follow the MSH segment. 59 ; ZIC 60 ; ZIR 61 ; } 62 ; {ZMT 63 ; } 64 ; ZBT 65 ; } 66 ; BTS 67 ; 68 S IVMORF=1 ; set ORF msg flag 69 S (HLEVN,IVMCT,IVMERROR,IVMCNTR)=0 ; init vars 70 ; 71 ORU ; Entry point for receipt of ORU~Z10 trans (called by IVMPREC2) 72 S IVMTYPE=5,IVMZ10F=1 73 ; 74 ; - loop through the msg in (#772 file), and process (PROC) msgs 75 S IVMDA=0 F S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D PROC Q:'IVMDA 76 ; 77 ; - if ORF msg flag, update the Query Tran Log and send ACK 78 I $G(IVMORF) D 79 .I $G(DFN),$D(IVMMCI) D 80 ..N IVMCR 81 ..S IVMCR=$P("1^2^3^7^5^6^4","^",IVMTYPE) ;map reason to test type 82 ..D FIND^IVMCQ2(DFN,IVMMCI,HLDT,$S($D(HLERR):5,1:IVMCR),1) 83 .;D ACK^IVMPREC:'$D(HLERR) 84 .;N HLRESLTA,HLP 85 .;D GENACK^HLMA1(HLEID,HLMTIEN,HLEIDS,"LM",1,.HLRESLTA,"",.HLP) 86 ; 87 ; - if tests are uploaded, generate notification msg 88 I $D(^TMP($J,"IVMBULL")) D ^IVMCMB 89 ; 90 ENQ ; 91 K IVMDA,IVMORF,IVMSEG,IVMFLGC,IVMTYPE,IVMMTIEN,IVMMTDT,IVMDGBT,IVMMCI 92 K ^TMP($J,"IVMCM"),^("IVMBULL"),DGMSGF,DGADDF,IVMCPAY,IVMBULL,DFN 93 K DGMTMSG,IVMZ10F 94 Q 95 ; 96 PROC ; Process each HL7 message from (#772) file 97 ; 98 N IVMFUTR,TMSTAMP,SOURCE,NODE,HSDATE,IVMZ10,DGMTP,DGMTACT,DGMTI,DGMTA 99 S DGMTACT="ADD" 100 D PRIOR^DGMTEVT 101 S IVMZ10="UPLOAD IN PROGRESS" 102 S IVMFUTR=0 ;this flag will indicate whether or not a test with a future date is being uploaded 103 S IVMMTIEN=0 104 ; 105 S MSGID=$P(IVMSEG,HLFS,10) ; msg control id for ACK's 106 ; - check if DCD messaging is enabled 107 I '$$DCDON^IVMUPAR1() D PROB^IVMCMC("Facility has DCD messaging disabled") Q 108 ; 109 ; - check HL7 msg structure for errors 110 K HLERR,^TMP($J,"IVMCM") 111 D ^IVMCMC I $D(HLERR) K:HLERR="" HLERR Q 112 ; 113 ; Determine type of test/transmission 114 S IVMTYPE=0 115 ; 116 ; - was a means test sent? 117 I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2) S IVMTYPE=1 ; MT trans 118 ; 119 ; - if MT and CT transmitted, error - pt can't have both unless 120 ; one is a deletion, but HEC not currently handling that situation 121 I IVMTYPE,$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) D PROB^IVMCMC("Patient can not have both a Means Test and Copay Test") Q 122 I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) S IVMTYPE=2 ; CT trans 123 ; 124 ; - if no MT or CT or LTC then Income Screening 125 I 'IVMTYPE,'$P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2) S IVMTYPE=3 ; IS trans 126 ; 127 ;send an eligibility query if no eligibility code 128 I '$$ELIG^IVMCUF1(DFN),'$$PENDING^DGENQRY(DFN) I $$SEND^DGENQRY1(DFN) 129 ; 130 ; obtain locks used to sychronize upload with local income test options 131 D GETLOCKS^IVMCUPL(DFN) 132 ; 133 ; 134 MT ; If transmission is a Means Test 135 N NODE0,RET,CODE,DATA 136 S HLQ=$G(HL("Q")) 137 S:HLQ="" HLQ="""""" 138 I IVMTYPE=1 D I $D(HLERR) G PROCQ 139 .S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2)) 140 .S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,25)) 141 .S HSDATE=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,24)) 142 .S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,22) 143 .S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,1) 144 .I $$Z06MT^EASPTRN1(+IVMLAST) Q 145 .I '$$ELIG^IVMUFNC5(DFN) S ERRMSG="Means Test upload not appropriate for current patient" 146 .I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D 147 ..N CATCZMT S CATCZMT=$G(^TMP($J,"IVMCM","ZMT1")) 148 ..S CATC=$$CATC^IVMUFNC5(CATCZMT) 149 ..I '+$G(CATC) S ERRMSG="Only Means Tests in current/previous income years are valid (not effective)" 150 .I $G(ERRMSG)'="" D PROB^IVMCMC(ERRMSG) K ERRMSG,CATC Q 151 .; 152 .; - perform edit checks and file MT 153 .D CHKDT 154 .;deletion indicator sent? 155 .I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,3)=HLQ D Q 156 ..D 157 ...;if there is a future test for that income year, delete that 158 ...N IEN,DATA,IVMPAT 159 ...S IEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),1,.IVMPAT) 160 ...I IEN S DATA(.06)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA) 161 ...I IEN,$D(^DGMT(408.31,IEN,0)) D 162 ....S IVMMTIEN=IEN 163 ....S IVMFUTR=1 164 ...E D 165 ....S IVMFUTR=0 166 ..Q:('IVMMTIEN) 167 ..S NODE0=$G(^DGMT(408.31,IVMMTIEN,0)) 168 ..I $$EN^IVMCMD(IVMMTIEN) D 169 ...S RET=$$LST^DGMTU(DFN,DT,IVMTYPE) 170 ...S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"") 171 ...D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE) 172 .; 173 .;check timestamp - if matches current primary test and hardship matches, then this is a duplicate and does not need to be uploaded 174 .I TMSTAMP D 175 ..S NODE="" 176 ..I IVMFUTR N IVMMTIEN S IVMMTIEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),1) 177 ..Q:'IVMMTIEN 178 ..S NODE=$G(^DGMT(408.31,IVMMTIEN,2)) 179 .S NODE0=$G(^DGMT(408.31,IVMMTIEN,0)) 180 .I TMSTAMP,TMSTAMP=$P(NODE,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE,"^",5),(HSDATE=$P(NODE,"^")) Q 181 .; 182 .D DELTYPE^IVMCMD(DFN,IVMMTDT,2) 183 .D EN^IVMCM1 184 ; 185 ; 186 CT ; If transmission is a Copay Test 187 N NODE0,RET,CODE,DATA 188 I IVMTYPE=2 D I $D(HLERR) G PROCQ 189 .S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2)) 190 .S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,25)) 191 .S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,22) 192 .S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,2) 193 .S IVMCPAY=$$RXST^IBARXEU(DFN) 194 .I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D PROB^IVMCMC("Only Copay Tests in the current/previous income years are valid. (Not effective)") Q 195 .; - perform edit checks and file CT 196 .D CHKDT 197 .;deletion indicator sent? 198 .I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,3)=HLQ D Q 199 ..D 200 ...;if there is a future test for that income year, delete that 201 ...N IEN,DATA,IVMPAT 202 ...S IEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),2,.IVMPAT) 203 ...I IEN S DATA(.07)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA) 204 ...I IEN,$D(^DGMT(408.31,IEN,0)) D 205 ....S IVMMTIEN=IEN 206 ....S IVMFUTR=1 207 ...E D 208 ....S IVMFUTR=0 209 ..Q:('IVMMTIEN) 210 ..S NODE0=$G(^DGMT(408.31,IVMMTIEN,0)) 211 ..I $$EN^IVMCMD(IVMMTIEN) D 212 ...S RET=$$LST^DGMTU(DFN,DT,IVMTYPE) 213 ...S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"") 214 ...D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE) 215 .; 216 .;check timestamp - if matches current primary test, then this is a duplicate and does not need to be uploaded 217 .I TMSTAMP D 218 ..S NODE="" 219 ..I IVMFUTR N IVMMTIEN S IVMMTIEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),2) 220 ..Q:'IVMMTIEN 221 ..S NODE=$G(^DGMT(408.31,IVMMTIEN,2)) 222 .S NODE0=$G(^DGMT(408.31,IVMMTIEN,0)) 223 .I TMSTAMP,TMSTAMP=$P(NODE,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE,"^",5) Q 224 .; 225 .D DELTYPE^IVMCMD(DFN,IVMMTDT,1) 226 .D EN^IVMCM1 227 ; 228 IS ; - If transmission is income screening info only then do not process 229 ; - outside of the scope of MTS 230 ;I IVMTYPE=3 S IVMMTDT=0 D EN^IVMCM1 I $D(HLERR) G PROCQ 231 I IVMTYPE=3 S IVMMTDT=0 232 ; 233 LTC ; If transmission contains a Long Term Care Test (TYPE 4 TEST) 234 I $P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2) D LTC^IVMCM1 235 ; 236 PROCQ ; 237 ; release locks used to sychronize upload with local income test options 238 D RELLOCKS^IVMCUPL(DFN) 239 Q 240 ; 241 CHKDT ; check date of income test being uploaded 242 ; Is it a future date? If so, set IVMFUTR=1 243 ; 244 ; IVMMTIEN is the IEN of current primary test for the year 245 ; 246 I $E($P(IVMLAST,"^",2),1,3)=$E(IVMMTDT,1,3) S IVMMTIEN=+IVMLAST 247 I IVMMTDT>DT S IVMFUTR=1 248 Q 249 FUTURE(DFN,YEAR,TYPE,IVMPAT) ; 250 ;Returns the ien of the future test, if there is one 251 ;Inputs: DFN 252 ; YEAR - income year 253 ; TYPE - type of test 254 ;Output: 255 ; function value - ien of future means test, if there is one, "" otherwise 256 ; IVMPAT - Pointer to the IVM Patient file for the income year if there is an entry (pass by reference) 257 ; 258 N RET 259 S RET="" 260 S IVMPAT=$$FIND^IVMPLOG(DFN,YEAR) 261 I IVMPAT S RET=$P($G(^IVM(301.5,IVMPAT,0)),"^",$S(TYPE=1:6,1:7)) 262 Q RET
Note:
See TracChangeset
for help on using the changeset viewer.
