| 1 | IVMUFNC ;ALB/MLI/PHH/SCK - IVM GENERIC FUNCTIONS ; 10/15/2004 1:10pm
|
|---|
| 2 | ;;2.0;INCOME VERIFICATION MATCH;**3,11,17,34,95,94**;21-OCT-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; This routine contains generic calls for use throughout IVM
|
|---|
| 6 | ;
|
|---|
| 7 | INIT(EID,HL,INT) ; initialize variables for 1.6 HL7/IVM
|
|---|
| 8 | S EID=$G(EID),INT=$G(INT)
|
|---|
| 9 | S HLDAP="IVM" D INIT^HLFNC2(EID,.HL,INT)
|
|---|
| 10 | S (HLEVN,IVMCT)=0 ; initialize segment and message counters
|
|---|
| 11 | ;;D NOW^%DTC S HLSDT=%
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | CLEAN ; clean-up variables for HL7/IVM (as defined by call to INIT)
|
|---|
| 16 | D KILL^HLTRANS
|
|---|
| 17 | K HLEVN,HLMTN,HLSDT,IVMCT
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | ;
|
|---|
| 21 | BATCH ; put BHS and BTS segments into TMP global
|
|---|
| 22 | ;
|
|---|
| 23 | ; Input - HLMTN as HL7 message type being sent in this batch (REQUIRED)
|
|---|
| 24 | ; HLEVN as number of HL7 messages in batch (REQUIRED)
|
|---|
| 25 | ; IVMCT as subscript in TMP global where BTS segment goes (REQ)
|
|---|
| 26 | ; HLSEC (optional) as security (see BHS^HLFNC1)
|
|---|
| 27 | ; HLMSA (optional) as message ack variables (see BHS^HLFNC1)
|
|---|
| 28 | ;
|
|---|
| 29 | ; ****Also assumes all HL7 variables returned from****
|
|---|
| 30 | ; INIT^HLTRANS are defined
|
|---|
| 31 | ;
|
|---|
| 32 | Q ; LINE ADDED FOR HL7 1.6
|
|---|
| 33 | S HLSEC=$G(HLSEC),HLMSA=$G(HLMSA)
|
|---|
| 34 | S ^TMP("HLS",$J,HLSDT,0)=$$BHS^HLFNC1(HLMTN,HLSEC,HLMSA)
|
|---|
| 35 | S ^TMP("HLS",$J,HLSDT,IVMCT)="BTS"_HLFS_HLEVN ; trailer
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | ;
|
|---|
| 39 | IVM(DFN,IVMDT) ; extrinsic function - should this pt be transmitted to IVM?
|
|---|
| 40 | ;
|
|---|
| 41 | ; Input - DFN as internal entry number of PATIENT file
|
|---|
| 42 | ; IVMDT as date of test (default DT)
|
|---|
| 43 | ;
|
|---|
| 44 | ; Output - 1 if pt should be sent to IVM, 0 otherwise
|
|---|
| 45 | ;
|
|---|
| 46 | N X,Y
|
|---|
| 47 | S DFN=$G(DFN) I '$D(^DPT(+DFN,0)) G IVMQ
|
|---|
| 48 | S IVMDT=$S($G(IVMDT):IVMDT,1:DT)
|
|---|
| 49 | S X=$$LST^DGMTU(DFN,IVMDT)
|
|---|
| 50 | I $E($P(X,"^",2),1,3)'=$E(IVMDT,1,3) K IVMDT G IVMQ ; not in same year
|
|---|
| 51 | S X=$G(^DGMT(408.31,+X,0)) I 'X G IVMQ ; can't find MT entry for date
|
|---|
| 52 | I $P(X,"^",3)=6 S:'$$INS(DFN,IVMDT) Y=1 G IVMQ ; C/no insurance...send
|
|---|
| 53 | I $P(X,"^",3)'=4 G IVMQ ; not cat A
|
|---|
| 54 | I ($P(X,"^",4)-$P(X,"^",15)>$P(X,"^",12))!$P(X,"^",10) G IVMQ ; income-deduct expenses>threshold (hardship) or adjudicated
|
|---|
| 55 | S Y=1
|
|---|
| 56 | IVMQ Q +$G(Y)
|
|---|
| 57 | ;
|
|---|
| 58 | ;
|
|---|
| 59 | INS(DFN,IVMDT) ; extrinsic function to see if pt has active insurance
|
|---|
| 60 | ;
|
|---|
| 61 | ; Input - DFN as internal entry number of PATIENT file
|
|---|
| 62 | ; IVMDT [optional] as date to compute ins coverage for
|
|---|
| 63 | ;
|
|---|
| 64 | ; Output - 1 if yes, 0 if no
|
|---|
| 65 | ;
|
|---|
| 66 | Q $S($$INSUR^IBBAPI(DFN,$G(IVMDT))=1:1,1:0)
|
|---|
| 67 | ;
|
|---|
| 68 | ;
|
|---|
| 69 | MAIL(IVMGRP) ; Transmit to members of Mail Group. Before D MAIL^IVMUFNC()
|
|---|
| 70 | ; set XMSUB = to subject and set IVMTEXT array to message.
|
|---|
| 71 | ;
|
|---|
| 72 | ;Input:
|
|---|
| 73 | ; IVMGRP - optional parameter, = to name of a mailgroup to send the
|
|---|
| 74 | ; message to. If not sent, the IVM Site Parameter file is
|
|---|
| 75 | ; used to determine the mailgroup.
|
|---|
| 76 | ;
|
|---|
| 77 | N DIFROM,XMDUZ,XMTEXT,XMSTRIP,XMROU,XMY,XMZ,XMDF
|
|---|
| 78 | S XMDF=""
|
|---|
| 79 | S XMDUZ="IVM PACKAGE"
|
|---|
| 80 | S XMTEXT="IVMTEXT("
|
|---|
| 81 | I '$L($G(IVMGRP)) D
|
|---|
| 82 | .S IVMGRP=$P($G(^XMB(3.8,+$P($G(^IVM(301.9,1,0)),"^",2),0)),"^")
|
|---|
| 83 | S XMY("G."_IVMGRP_"@"_^XMB("NETNAME"))=""
|
|---|
| 84 | D ^XMD
|
|---|
| 85 | K IVMTEXT,XMDUZ,XMSUB,XMTEXT,XMY
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | ;
|
|---|
| 89 | LTD(DFN,IVMQUERY) ; Find Last Treatment Date
|
|---|
| 90 | ; Input: DFN -- pointer to the patient in file #2
|
|---|
| 91 | ; IVMQUERY("LTD") -- # of the QUERY that is currently open or
|
|---|
| 92 | ; undefined, zero, or null if no QUERY opened for
|
|---|
| 93 | ; last treatment date
|
|---|
| 94 | ; Output: LTD -- Last Treatment Date (really last date seen at
|
|---|
| 95 | ; the facility)
|
|---|
| 96 | ;
|
|---|
| 97 | N LTD,SDSTOP,X,Z,IVMQ
|
|---|
| 98 | ;
|
|---|
| 99 | ; - need a patient
|
|---|
| 100 | S IVMQ=$G(IVMQUERY("LTD"))
|
|---|
| 101 | I '$G(DFN) S LTD=0 G LTDQ
|
|---|
| 102 | ;
|
|---|
| 103 | ; - if current inpatient, set LTD = today and quit
|
|---|
| 104 | I $G(^DPT(DFN,.105)) S LTD=DT G LTDQ
|
|---|
| 105 | ;
|
|---|
| 106 | ; - get the last discharge date
|
|---|
| 107 | S LTD=+$O(^DGPM("ATID3",DFN,"")) S:LTD LTD=9999999.9999999-LTD\1 S:LTD>DT LTD=DT
|
|---|
| 108 | ;
|
|---|
| 109 | ; - get the last registration date and compare to LTD
|
|---|
| 110 | S X=+$O(^DPT(DFN,"DIS",0)) I X S X=9999999-X\1 S:X>LTD LTD=X
|
|---|
| 111 | ;
|
|---|
| 112 | ; - get the last appointment or stop after LTD (if any)
|
|---|
| 113 | K ^TMP("DIERR",$J)
|
|---|
| 114 | I $G(IVMQ) D ACTIVE^SDQ(.IVMQ,"FALSE","SET") ;clear QUERY results
|
|---|
| 115 | I '$G(IVMQ) D
|
|---|
| 116 | .D OPEN^SDQ(.IVMQ) Q:'$G(IVMQ)
|
|---|
| 117 | .D INDEX^SDQ(.IVMQ,"PATIENT/DATE","SET")
|
|---|
| 118 | .D SCANCB^SDQ(.IVMQ,"I $S($P(SDOE0,U,8)=2:1,$P(SDOE0,U,8)=1:$$APPT^IVMUFNC(SDOE0),1:0) S LTD=SDOE0\1,SDSTOP=1","SET")
|
|---|
| 119 | .S IVMQUERY("LTD")=IVMQ
|
|---|
| 120 | ;
|
|---|
| 121 | D PAT^SDQ(.IVMQ,DFN,"SET")
|
|---|
| 122 | D DATE^SDQ(.IVMQ,LTD+.000001,9999999,"SET")
|
|---|
| 123 | D ACTIVE^SDQ(.IVMQ,"TRUE","SET")
|
|---|
| 124 | D SCAN^SDQ(.IVMQ,"BACKWARD")
|
|---|
| 125 | K ^TMP("DIERR",$J)
|
|---|
| 126 | ;
|
|---|
| 127 | LTDQ ;
|
|---|
| 128 | Q $S(LTD:$$HLDATE^HLFNC(LTD),1:HLQ)
|
|---|
| 129 | ;
|
|---|
| 130 | APPT(SDOE0) ;Determine if appt associated with encounter is in a valid state
|
|---|
| 131 | ; Quit when Outpatient Encounter STATUS is CHECKED OUT
|
|---|
| 132 | Q:$P(SDOE0,U,12)=2 1
|
|---|
| 133 | ; Quit when Outpatient Encounter STATUS is ACTION REQUIRED and the
|
|---|
| 134 | ; Appointment Status is SCHEDULED/KEPT
|
|---|
| 135 | N DGARRAY,SDCNT,SDSTAT,SDDTTM S DGARRAY("FLDS")=3,DGARRAY(4)=+$P(SDOE0,U,2)
|
|---|
| 136 | S DGARRAY(1)=$P(SDOE0,U),DGARRAY("SORT")="P",DGARRAY("MAX")=1
|
|---|
| 137 | S SDCNT=$$SDAPI^SDAMA301(.DGARRAY),SDSTAT=""
|
|---|
| 138 | I SDCNT>0 D
|
|---|
| 139 | .S SDDTTM=$O(^TMP($J,"SDAMA301",DGARRAY(4),0))
|
|---|
| 140 | .I SDDTTM S SDSTAT=$P($P($G(^TMP($J,"SDAMA301",DGARRAY(4),SDDTTM)),U,3),";")
|
|---|
| 141 | K ^TMP($J,"SDAMA301")
|
|---|
| 142 | Q:(($P(SDOE0,U,12)=14)&(SDSTAT="R")) 1
|
|---|
| 143 | Q 0
|
|---|
| 144 | ;
|
|---|
| 145 | OUTTR(IVMINT,IVMPAR,IVMST) ; - Transform IVMINT to a displayable value
|
|---|
| 146 | ; Input: IVMINT -- internal value of demographic element
|
|---|
| 147 | ; received from IVM
|
|---|
| 148 | ; IVMPAR -- Zeroth node of the entry in file #301.92
|
|---|
| 149 | ; for the demographic element IVMINT
|
|---|
| 150 | ; IVMST -- [optional] pointer to the STATE (#5) file
|
|---|
| 151 | ; Required to transform the county code
|
|---|
| 152 | ; Output: IVMOUT -- Displayable value for IVMINT
|
|---|
| 153 | ;
|
|---|
| 154 | N IVMOUT,Z S IVMOUT=IVMINT
|
|---|
| 155 | I $G(IVMINT)=""!($G(IVMPAR)="") S IVMOUT="" G OUTTRQ
|
|---|
| 156 | ;
|
|---|
| 157 | ; - use special transform for county
|
|---|
| 158 | I $G(IVMST),$P(IVMPAR,"^",2)="PID12" S IVMOUT=$P($G(^DIC(5,IVMST,1,IVMINT,0)),"^")
|
|---|
| 159 | ;
|
|---|
| 160 | ; - transform the internal value if necessary
|
|---|
| 161 | I $P(IVMPAR,"^",6) S IVMOUT=$$EXPAND($P(IVMPAR,"^",4),$P(IVMPAR,"^",5),IVMINT)
|
|---|
| 162 | ;
|
|---|
| 163 | OUTTRQ Q IVMOUT
|
|---|
| 164 | ;
|
|---|
| 165 | ;
|
|---|
| 166 | EXPAND(FILE,FIELD,VALUE) ; - returns internal data in an output format
|
|---|
| 167 | N Y,C S Y=VALUE
|
|---|
| 168 | I 'FILE!('FIELD)!(VALUE="") G EXPQ
|
|---|
| 169 | S Y=VALUE,C=$P(^DD(FILE,FIELD,0),"^",2) D Y^DIQ
|
|---|
| 170 | EXPQ Q Y
|
|---|
| 171 | ;
|
|---|
| 172 | ;
|
|---|
| 173 | GETPAT(DFN,IVMPAT) ;
|
|---|
| 174 | ; Description: Used to obtain identifying information for a patient
|
|---|
| 175 | ; in the PATIENT file and place it in the IVMPAT() array.
|
|---|
| 176 | ;
|
|---|
| 177 | ; Input:
|
|---|
| 178 | ; DFN - ien of patient in PATIENT file
|
|---|
| 179 | ;
|
|---|
| 180 | ; Output:
|
|---|
| 181 | ; Function Value - 1 on success, 0 on failure
|
|---|
| 182 | ; IVMPAT - (pass by reference) On success, this array will contain
|
|---|
| 183 | ; the patient identifing information. Array subscripts are:
|
|---|
| 184 | ; "DFN" - ien PATIENT file
|
|---|
| 185 | ; "NAME" - patient name
|
|---|
| 186 | ; "SSN" - patient Social Security Number
|
|---|
| 187 | ; "DOB" - patient date of birth (FM format)
|
|---|
| 188 | ; "SEX" - patient sex
|
|---|
| 189 | ;
|
|---|
| 190 | N IVMNODE
|
|---|
| 191 | Q:'$G(DFN) 0
|
|---|
| 192 | K IVMPAT S IVMPAT=""
|
|---|
| 193 | ;
|
|---|
| 194 | ; obtain patient record
|
|---|
| 195 | S IVMNODE=$G(^DPT(DFN,0))
|
|---|
| 196 | Q:IVMNODE="" 0
|
|---|
| 197 | ;
|
|---|
| 198 | S IVMPAT("DFN")=DFN
|
|---|
| 199 | S IVMPAT("NAME")=$P(IVMNODE,"^")
|
|---|
| 200 | S IVMPAT("SEX")=$P(IVMNODE,"^",2)
|
|---|
| 201 | S IVMPAT("DOB")=$P(IVMNODE,"^",3)
|
|---|
| 202 | S IVMPAT("SSN")=$P(IVMNODE,"^",9)
|
|---|
| 203 | Q 1
|
|---|
| 204 | ;
|
|---|
| 205 | LOOKUP(SSN,DOB,SEX,ERROR) ;
|
|---|
| 206 | ;Description: This function will do a search for the patient based on
|
|---|
| 207 | ;the identifying information provided. The function will be successful
|
|---|
| 208 | ;only if a single patient is found matching the identifiers provided.
|
|---|
| 209 | ;
|
|---|
| 210 | ;Inputs:
|
|---|
| 211 | ; SSN - patient Social Security Number
|
|---|
| 212 | ; DOB - patient date of birth (FM format)
|
|---|
| 213 | ; SEX - patient sex
|
|---|
| 214 | ;Outputs:
|
|---|
| 215 | ; Function Value - patient DFN if successful, 0 otherwise
|
|---|
| 216 | ; ERROR - if unsuccessful, an error message is returned (optional, pass by reference)
|
|---|
| 217 | ;
|
|---|
| 218 | N DFN,NODE
|
|---|
| 219 | ;
|
|---|
| 220 | S DFN=$O(^DPT("SSN",SSN,0))
|
|---|
| 221 | I 'DFN S ERROR="SSN NOT FOUND" Q 0
|
|---|
| 222 | I $O(^DPT("SSN",SSN,DFN)) S ERROR="MULTIPLE PATIENTS MATCHING SSN" Q 0
|
|---|
| 223 | S NODE=$G(^DPT(DFN,0))
|
|---|
| 224 | I $P(NODE,"^",2)'=SEX S ERROR="SEX DOES NOT MATCH" Q 0
|
|---|
| 225 | I $E($P(NODE,"^",3),1,3)'=$E(DOB,1,3) S ERROR="DOB DOES NOT MATCH" Q 0
|
|---|
| 226 | I $E($P(NODE,"^",3),4,5),$E($P(NODE,"^",3),4,5)'=$E(DOB,4,5) S ERROR="DOB DOES NOT MATCH" Q 0
|
|---|
| 227 | Q DFN
|
|---|
