Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMLINS4

IVMLINS4.m

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