101 lines
3.8 KiB
Mathematica
101 lines
3.8 KiB
Mathematica
IVMLINS4 ;ALB/SEK - IVM INSURANCE UPLOAD ACCEPT - IB CALL ; 17-APR-98
|
|
;;2.0;INCOME VERIFICATION MATCH;**14**; 21-OCT-94
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
; This routine is called by IB to update insurance segments sent
|
|
; from HEC and stored in the INCOMING SEGMENT multiple of the IVM
|
|
; PATIENT file (#301.5). A HL7 message is sent to HEC indicating if
|
|
; the data is accepted or rejected (including reason for rejection).
|
|
;
|
|
; Before this call, IB code allows the user to to review the
|
|
; insurance policy from HEC stored in IB's insurance module. When
|
|
; the user decides to accept or reject the policy, this routine is
|
|
; called. If the policy is rejected, this routine allows the user
|
|
; to pick the reason for rejection.
|
|
;
|
|
UPDATE(DFN,IVMINSST,IVMID) ;
|
|
;
|
|
; Input: DFN -- internal entry number of PATIENT file
|
|
; IVMINSST -- upload status 1-accepted 0-rejected
|
|
; IVMID -- ins. co. name ^ street add[line 1] ^ group #
|
|
;
|
|
; Output: returns 1 if updated or 0 followed by error if not updated
|
|
;
|
|
N IVM1INSN,IVM2SA1,IVM3GNU,IVMI,IVMIBERR,IVMJ,IVMDA,IVMDAIN,IVMFOUND,IVMREPTR
|
|
I '$G(DFN)!('$D(^DPT(+DFN,0))) S IVMIBERR="No patient defined" G EXIT
|
|
I '$D(^IVM(301.5,"B",DFN)) S IVMIBERR="Patient not in IVM PATIENT file" G EXIT
|
|
;
|
|
I $G(IVMINSST)'=0&($G(IVMINSST)'=1) S IVMIBERR="upload status not accepted or rejected" G EXIT
|
|
;
|
|
; - check id fields
|
|
S IVM1INSN=$P(IVMID,"^")
|
|
S IVM2SA1=$P(IVMID,"^",2)
|
|
S IVM3GNU=$P(IVMID,"^",3)
|
|
I IVM1INSN']"" S IVMIBERR="no insurance company name from MCCR insurance module" G EXIT
|
|
I IVM2SA1']"" S IVMIBERR="no street address from MCCR insurance module" G EXIT
|
|
I IVM3GNU']"" S IVMIBERR="no group number from MCCR insurance module" G EXIT
|
|
;
|
|
S IVMDA=0
|
|
F S IVMDA=$O(^IVM(301.5,"B",DFN,IVMDA)) Q:'IVMDA D FIND Q:$G(IVMFOUND)
|
|
G PROCESS
|
|
;
|
|
; - find ins. record in IVM PATIENT file
|
|
FIND S IVMDAIN=0
|
|
F S IVMDAIN=$O(^IVM(301.5,IVMDA,"IN",IVMDAIN)) Q:'IVMDAIN D Q:$G(IVMFOUND)
|
|
.; - record missing
|
|
.Q:'$D(^IVM(301.5,IVMDA,"IN",IVMDAIN,0))
|
|
.Q:'$D(^IVM(301.5,IVMDA,"IN",IVMDAIN,"ST"))
|
|
.;
|
|
.; - if 2nd piece not null - skip record - insurance record not transferred
|
|
.Q:$P($G(^IVM(301.5,IVMDA,"IN",IVMDAIN,0)),"^",2)]""
|
|
.;
|
|
.; - if 4th piece not null - skip record - already uploaded or rejected
|
|
.Q:$P($G(^IVM(301.5,IVMDA,"IN",IVMDAIN,0)),"^",4)]""
|
|
.;
|
|
.; - check 3 fields in ^IVM(301.5,IVMDA,"IN",IVMDAIN,"ST") if not 3 matches - skip record
|
|
.Q:$P(^IVM(301.5,IVMDA,"IN",IVMDAIN,"ST"),"^",4)'=IVM1INSN
|
|
.Q:$P($P(^IVM(301.5,IVMDA,"IN",IVMDAIN,"ST"),"^",5),"~")'=IVM2SA1
|
|
.Q:$P(^IVM(301.5,IVMDA,"IN",IVMDAIN,"ST"),"^",8)'=IVM3GNU
|
|
.; - if ins record found
|
|
.S IVMFOUND=1
|
|
.Q
|
|
Q
|
|
;
|
|
PROCESS I 'IVMDAIN S IVMIBERR="Insurance data not found in IVM PATIENT file" G EXIT
|
|
;
|
|
N DA,DTOUT,DUOUT,DR,DIE,Y
|
|
;
|
|
; - if the insurance data is accepted do
|
|
I IVMINSST D G DEL
|
|
.;
|
|
.; - stuff UPLOAD INSURANCE DATA(.04), UPLOADED INSURANCE DATE/TIME(.05)
|
|
.S DA=IVMDAIN,DA(1)=IVMDA
|
|
.S DIE="^IVM(301.5,"_DA(1)_",""IN"","
|
|
.S DR=".04////1;.05///NOW" D ^DIE
|
|
;
|
|
; - if the insurance data is rejected do
|
|
; - ask for reason why
|
|
;
|
|
W !!,"The 'Reject IVM Insurance Policy' action has been selected."
|
|
;
|
|
W !,"Please select a reason for rejecting the IVM insurance information."
|
|
S DIC="^IVM(301.91,",DIC("A")="Select reason for rejecting: ",DIC(0)="QEAMZ"
|
|
D ^DIC K DIC I Y<0!($D(DTOUT))!($D(DUOUT)) S IVMIBERR="No reason selected" G EXIT
|
|
S IVMREPTR=+Y
|
|
;
|
|
; stuff UPLOAD INSURANCE DATA(.04) and REASON NOT UPLOADING INSURANCE
|
|
; (.08)
|
|
S DA=IVMDAIN,DA(1)=IVMDA
|
|
S DIE="^IVM(301.5,"_DA(1)_",""IN"","
|
|
S DR=".04////0;.08////^S X=IVMREPTR" D ^DIE
|
|
;
|
|
DEL ; - delete incoming segments strings
|
|
K ^IVM(301.5,DA(1),"IN",DA,"ST"),^("ST1")
|
|
;
|
|
; - send HL7 message to IVM Center
|
|
;
|
|
S IVMI=DA(1),IVMJ=DA
|
|
D HL7^IVMLINS2
|
|
;
|
|
EXIT Q $S($D(IVMIBERR):0,1:1)_"^"_$G(IVMIBERR)
|