IVMUFNC ;ALB/MLI/PHH/SCK - IVM GENERIC FUNCTIONS ; 10/15/2004 1:10pm
 ;;2.0;INCOME VERIFICATION MATCH;**3,11,17,34,95,94**;21-OCT-94
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 ; This routine contains generic calls for use throughout IVM
 ;
INIT(EID,HL,INT) ; initialize variables for 1.6 HL7/IVM
 S EID=$G(EID),INT=$G(INT)
 S HLDAP="IVM" D INIT^HLFNC2(EID,.HL,INT)
 S (HLEVN,IVMCT)=0 ; initialize segment and message counters
 ;;D NOW^%DTC S HLSDT=%
 Q
 ;
 ;
CLEAN ; clean-up variables for HL7/IVM (as defined by call to INIT)
 D KILL^HLTRANS
 K HLEVN,HLMTN,HLSDT,IVMCT
 Q
 ;
 ;
BATCH ; put BHS and BTS segments into TMP global
 ;
 ;  Input - HLMTN as HL7 message type being sent in this batch (REQUIRED)
 ;          HLEVN as number of HL7 messages in batch (REQUIRED)
 ;          IVMCT as subscript in TMP global where BTS segment goes (REQ)
 ;          HLSEC (optional) as security (see BHS^HLFNC1)
 ;          HLMSA (optional) as message ack variables (see BHS^HLFNC1)
 ;
 ;      ****Also assumes all HL7 variables returned from****
 ;          INIT^HLTRANS are defined
 ;
 Q  ; LINE ADDED FOR HL7 1.6
 S HLSEC=$G(HLSEC),HLMSA=$G(HLMSA)
 S ^TMP("HLS",$J,HLSDT,0)=$$BHS^HLFNC1(HLMTN,HLSEC,HLMSA)
 S ^TMP("HLS",$J,HLSDT,IVMCT)="BTS"_HLFS_HLEVN ; trailer
 Q
 ;
 ;
IVM(DFN,IVMDT) ; extrinsic function - should this pt be transmitted to IVM?
 ;
 ;  Input - DFN as internal entry number of PATIENT file
 ;          IVMDT as date of test (default DT)
 ;
 ; Output - 1 if pt should be sent to IVM, 0 otherwise
 ;
 N X,Y
 S DFN=$G(DFN) I '$D(^DPT(+DFN,0)) G IVMQ
 S IVMDT=$S($G(IVMDT):IVMDT,1:DT)
 S X=$$LST^DGMTU(DFN,IVMDT)
 I $E($P(X,"^",2),1,3)'=$E(IVMDT,1,3) K IVMDT G IVMQ ; not in same year
 S X=$G(^DGMT(408.31,+X,0)) I 'X G IVMQ ; can't find MT entry for date
 I $P(X,"^",3)=6 S:'$$INS(DFN,IVMDT) Y=1 G IVMQ ; C/no insurance...send
 I $P(X,"^",3)'=4 G IVMQ ; not cat A
 I ($P(X,"^",4)-$P(X,"^",15)>$P(X,"^",12))!$P(X,"^",10) G IVMQ ; income-deduct expenses>threshold (hardship) or adjudicated
 S Y=1
IVMQ Q +$G(Y)
 ;
 ;
INS(DFN,IVMDT) ; extrinsic function to see if pt has active insurance
 ;
 ;  Input - DFN as internal entry number of PATIENT file
 ;          IVMDT [optional] as date to compute ins coverage for
 ;
 ; Output - 1 if yes, 0 if no
 ;
 Q $S($$INSUR^IBBAPI(DFN,$G(IVMDT))=1:1,1:0)
 ;
 ;
MAIL(IVMGRP) ; Transmit to members of Mail Group. Before D MAIL^IVMUFNC()
 ; set XMSUB = to subject   and  set IVMTEXT array to message.
 ;
 ;Input:
 ;  IVMGRP - optional parameter, = to name of a mailgroup to send the
 ;           message to.  If not sent, the IVM Site Parameter file is
 ;           used to determine the mailgroup.
 ;
 N DIFROM,XMDUZ,XMTEXT,XMSTRIP,XMROU,XMY,XMZ,XMDF
 S XMDF=""
 S XMDUZ="IVM PACKAGE"
 S XMTEXT="IVMTEXT("
 I '$L($G(IVMGRP)) D
 .S IVMGRP=$P($G(^XMB(3.8,+$P($G(^IVM(301.9,1,0)),"^",2),0)),"^")
 S XMY("G."_IVMGRP_"@"_^XMB("NETNAME"))=""
 D ^XMD
 K IVMTEXT,XMDUZ,XMSUB,XMTEXT,XMY
 Q
 ;
 ;
LTD(DFN,IVMQUERY) ; Find Last Treatment Date
 ;  Input:       DFN -- pointer to the patient in file #2
 ;          IVMQUERY("LTD") -- # of the QUERY that is currently open or
 ;                      undefined, zero, or null if no QUERY opened for
 ;                      last treatment date
 ; Output:  LTD -- Last Treatment Date (really last date seen at
 ;                                      the facility)
 ;
 N LTD,SDSTOP,X,Z,IVMQ
 ;
 ; - need a patient
 S IVMQ=$G(IVMQUERY("LTD"))
 I '$G(DFN) S LTD=0 G LTDQ
 ;
 ; - if current inpatient, set LTD = today and quit
 I $G(^DPT(DFN,.105)) S LTD=DT G LTDQ
 ;
 ; - get the last discharge date
 S LTD=+$O(^DGPM("ATID3",DFN,"")) S:LTD LTD=9999999.9999999-LTD\1 S:LTD>DT LTD=DT
 ;
 ; - get the last registration date and compare to LTD
 S X=+$O(^DPT(DFN,"DIS",0)) I X S X=9999999-X\1 S:X>LTD LTD=X
 ;
 ; - get the last appointment or stop after LTD (if any)
 K ^TMP("DIERR",$J)
 I $G(IVMQ) D ACTIVE^SDQ(.IVMQ,"FALSE","SET") ;clear QUERY results
 I '$G(IVMQ) D
 .D OPEN^SDQ(.IVMQ) Q:'$G(IVMQ)
 .D INDEX^SDQ(.IVMQ,"PATIENT/DATE","SET")
 .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")
 .S IVMQUERY("LTD")=IVMQ
 ;
 D PAT^SDQ(.IVMQ,DFN,"SET")
 D DATE^SDQ(.IVMQ,LTD+.000001,9999999,"SET")
 D ACTIVE^SDQ(.IVMQ,"TRUE","SET")
 D SCAN^SDQ(.IVMQ,"BACKWARD")
 K ^TMP("DIERR",$J)
 ;
LTDQ ;
 Q $S(LTD:$$HLDATE^HLFNC(LTD),1:HLQ)
 ;
APPT(SDOE0) ;Determine if appt associated with encounter is in a valid state
 ; Quit when Outpatient Encounter STATUS is CHECKED OUT
 Q:$P(SDOE0,U,12)=2 1
 ; Quit when Outpatient Encounter STATUS is ACTION REQUIRED and the
 ; Appointment Status is SCHEDULED/KEPT
 N DGARRAY,SDCNT,SDSTAT,SDDTTM S DGARRAY("FLDS")=3,DGARRAY(4)=+$P(SDOE0,U,2)
 S DGARRAY(1)=$P(SDOE0,U),DGARRAY("SORT")="P",DGARRAY("MAX")=1
 S SDCNT=$$SDAPI^SDAMA301(.DGARRAY),SDSTAT=""
 I SDCNT>0 D
 .S SDDTTM=$O(^TMP($J,"SDAMA301",DGARRAY(4),0))
 .I SDDTTM S SDSTAT=$P($P($G(^TMP($J,"SDAMA301",DGARRAY(4),SDDTTM)),U,3),";")
 K ^TMP($J,"SDAMA301")
 Q:(($P(SDOE0,U,12)=14)&(SDSTAT="R")) 1
 Q 0
 ;
OUTTR(IVMINT,IVMPAR,IVMST) ; - Transform IVMINT to a displayable value
 ;  Input:   IVMINT  --  internal value of demographic element
 ;                       received from IVM
 ;           IVMPAR  --  Zeroth node of the entry in file #301.92
 ;                       for the demographic element IVMINT
 ;            IVMST  --  [optional] pointer to the STATE (#5) file
 ;                       Required to transform the county code
 ;  Output:  IVMOUT  --  Displayable value for IVMINT
 ;
 N IVMOUT,Z S IVMOUT=IVMINT
 I $G(IVMINT)=""!($G(IVMPAR)="") S IVMOUT="" G OUTTRQ
 ;
 ; - use special transform for county
 I $G(IVMST),$P(IVMPAR,"^",2)="PID12" S IVMOUT=$P($G(^DIC(5,IVMST,1,IVMINT,0)),"^")
 ;
 ; - transform the internal value if necessary
 I $P(IVMPAR,"^",6) S IVMOUT=$$EXPAND($P(IVMPAR,"^",4),$P(IVMPAR,"^",5),IVMINT)
 ;
OUTTRQ Q IVMOUT
 ;
 ;
EXPAND(FILE,FIELD,VALUE) ; - returns internal data in an output format
 N Y,C S Y=VALUE
 I 'FILE!('FIELD)!(VALUE="") G EXPQ
 S Y=VALUE,C=$P(^DD(FILE,FIELD,0),"^",2) D Y^DIQ
EXPQ Q Y
 ;
 ;
GETPAT(DFN,IVMPAT) ;
 ; Description: Used to obtain identifying information for a patient
 ; in the PATIENT file and place it in the IVMPAT() array.
 ;
 ;  Input:
 ;   DFN - ien of patient in PATIENT file
 ;
 ; Output:
 ;  Function Value - 1 on success, 0 on failure
 ;   IVMPAT - (pass by reference) On success, this array will contain
 ;    the patient identifing information. Array subscripts are:
 ;      "DFN"  - ien PATIENT file
 ;      "NAME" - patient name
 ;      "SSN"  - patient Social Security Number
 ;      "DOB"  - patient date of birth (FM format)
 ;      "SEX"  - patient sex
 ;
 N IVMNODE
 Q:'$G(DFN) 0
 K IVMPAT S IVMPAT=""
 ;
 ; obtain patient record
 S IVMNODE=$G(^DPT(DFN,0))
 Q:IVMNODE="" 0
 ;
 S IVMPAT("DFN")=DFN
 S IVMPAT("NAME")=$P(IVMNODE,"^")
 S IVMPAT("SEX")=$P(IVMNODE,"^",2)
 S IVMPAT("DOB")=$P(IVMNODE,"^",3)
 S IVMPAT("SSN")=$P(IVMNODE,"^",9)
 Q 1
 ;
LOOKUP(SSN,DOB,SEX,ERROR) ;
 ;Description: This function will do a search for the patient based on
 ;the identifying information provided. The function will be successful
 ;only if a single patient is found matching the identifiers provided.
 ;
 ;Inputs:
 ;  SSN - patient Social Security Number
 ;  DOB - patient date of birth (FM format)
 ;  SEX - patient sex
 ;Outputs:
 ;  Function Value - patient DFN if successful, 0 otherwise
 ;  ERROR - if unsuccessful, an error message is returned (optional, pass by reference)
 ;
 N DFN,NODE
 ;
 S DFN=$O(^DPT("SSN",SSN,0))
 I 'DFN S ERROR="SSN NOT FOUND" Q 0
 I $O(^DPT("SSN",SSN,DFN)) S ERROR="MULTIPLE PATIENTS MATCHING SSN" Q 0
 S NODE=$G(^DPT(DFN,0))
 I $P(NODE,"^",2)'=SEX S ERROR="SEX DOES NOT MATCH" Q 0
 I $E($P(NODE,"^",3),1,3)'=$E(DOB,1,3) S ERROR="DOB DOES NOT MATCH" Q 0
 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
 Q DFN