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

IVMLINS3.m

Go to the documentation of this file. 
  1. IVMLINS3 ;ALB/KCL,TDM,HM - IVM INSURANCE POLICY TRANSFER ;3/9/09 2:01pm
  1.  ;;2.0;INCOME VERIFICATION MATCH;**14,111,121,172**;21-OCT-94;Build 27
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ;
  1.  ;
  1. TRANSFER(IVMAUTO) ; user has chosen to transfer insurance information,
  1.  ; received from HEC, to the MCCR insurance buffer.  this routine
  1.  ; will call $$ADDSTF^IBCNBES(3,DFN,IVMIBDAT) to place HEC's insurance
  1.  ; information in the MCCR insurance buffer where authorized insurance
  1.  ; personnel will either upload or reject the data.
  1.  ;      3 indicates that source of information is IVM
  1.  ;      IVMIBDAT = data, to be filed in the MCCR buffer, in an array
  1.  ;                 subscripted by field number of the data field in
  1.  ;                 the INSURANCE BUFFER file (#355.33) 
  1.  ; INPUT: IVMAUTO = 1 if auto-filing directly from upload
  1.  ;                  0 if using list manager interface to file
  1.  ;        THE FOLLOWING ARE ASSUMED TO BE DEFINED:
  1.  ;          IVMIN1 (ST/ST1 segment string nodes of file 301.5)
  1.  ;          IVMADD (5th "^" piece of IVMIN1 for ins co address data)
  1.  ;
  1.  ; Supported ICR #2537: Supports use of ADDSTF^IBCNBES to add a
  1.  ;                      new entry to the INSURANCE BUFFER file (#355.33)
  1.  ;
  1.  N IVMIB,IVMIBDAT,IVMNOI,IVMPRTI
  1.  ;
  1.  I '$G(IVMAUTO) W !!,"Transferring HEC'S insurance data to the MCCR insurance buffer",!
  1.  S IVMNOI=$S($P(IVMIN1,HLFS,17)="v":$P($$PT^IVMUFNC4(DFN),"^"),1:$P(IVMIN1,HLFS,16))
  1.  S IVMPRTI=$S($P(IVMIN1,HLFS,17)="v":"01",1:"02")
  1.  ;
  1.  S IVMIBDAT(20.01)=$E($P(IVMIN1,HLFS,4),1,30) ;ins co name
  1.  S IVMIBDAT(20.02)=$E($P(IVMIN1,HLFS,7),1,20) ;phone number
  1.  S IVMIBDAT(21.01)=$E($P(IVMADD,"~",1),1,35) ;street add [line 1]
  1.  S IVMIBDAT(21.02)=$E($P(IVMADD,"~",2),1,30) ;street add [line 2]
  1.  S IVMIBDAT(21.03)=$E($P(IVMADD,"~",8),1,30) ;street add [line 3]
  1.  S IVMIBDAT(21.04)=$E($P(IVMADD,"~",3),1,25) ;city
  1.  S IVMIBDAT(21.05)=$$STATE1^IVMUFNC4($P(IVMADD,"~",4)) ;state
  1.  S IVMIBDAT(21.06)=$E($P(IVMADD,"~",5),1,20) ;zip
  1.  S IVMIBDAT(40.02)=$E($P(IVMIN1,HLFS,9),1,20) ;group name
  1.  S IVMIBDAT(40.03)=$E($P(IVMIN1,HLFS,8),1,17) ;group number
  1.  S IVMIBDAT(40.05)=$S($P(IVMIN1,HLFS,28)=1:1,1:0) ;precertification required
  1.  S IVMIBDAT(40.09)=$P(IVMIN1,HLFS,15) ;type of plan
  1.  S IVMIBDAT(60.01)=DFN ;patient name
  1.  S IVMIBDAT(60.02)=$$FMDATE^HLFNC($P(IVMIN1,HLFS,12)) ;effective date
  1.  S IVMIBDAT(60.03)=$$FMDATE^HLFNC($P(IVMIN1,HLFS,13)) ;expiration date
  1.  S IVMIBDAT(60.04)=$E($P(IVMIN1,HLFS,36),1,20) ;subcriber id
  1.  S IVMIBDAT(60.05)=$P(IVMIN1,HLFS,17) ;whose insurance
  1.  S IVMIBDAT(60.06)=IVMPRTI ;pt relationship to insured
  1.  S IVMIBDAT(60.07)=IVMNOI ;name of insured
  1.  S IVMIBDAT(60.08)=$P(IVMIN1,HLFS,18) ;insured's date of birth IVM*2.0*172 HM
  1.  ;
  1.  I '$G(IVMSOI) S IVMSOI=$P(IVMZIV,HLFS,13) ;set Source of Information if missing IVM*2.0*172 HM
  1.  S IVMIB=$$ADDSTF^IBCNBES(IVMSOI,DFN,.IVMIBDAT) ;updated to pass in IVMSOI from ZIV sequence 13 IVM*2.0*172 HM
  1.  I 'IVMIB D  Q
  1.  .Q:$G(IVMAUTO)
  1.  .W !,"The following error occurred when transferring data:"
  1.  .W !,$P(IVMIB,"^",2)
  1.  .W !,"Please contact your IRM staff for help"
  1.  ;
  1.  N DA,DIE,DR
  1.  S DA=IVMJ,DA(1)=IVMI
  1.  ;
  1.  ; - delete segment name (.02 field of 301.501 multiple) from IVM PATIENT
  1.  ;   file to remove from ASEG cross-reference
  1.  S DIE="^IVM(301.5,"_DA(1)_",""IN"",",DR=".02////@" D ^DIE
  1.  ;
  1.  I $G(IVMAUTO) G IVMQ
  1.  ;
  1.  W "completed.",!
  1.  ;
  1.  S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
  1.  ;
  1. REMOVE ; - remove entry from the List Manager display after transferring
  1.  K ^TMP("IVMIUPL",$J,IVMNAME,IVMI,IVMJ)
  1.  ;
  1.  ; - action completed
  1.  S IVMDONE=1
  1.  ;
  1. IVMQ K DIRUT,DTOUT,DUOUT,IVMACT,IVMDA,IVMFLAG,IVMREPTR,IVMSOI,IVMZIV,X,Y ;IVM*2.0*172 HM
  1.  Q
  1.  ;
  1. AUTO ; Auto-upload all Z04 entries pending in file 301.501
  1.  ; Called by the patch IVM*2*111 post-install
  1.  N DFN,IVMI,IVMJ,IVMIN1,IVMADD,IVM0NOD,HLFS
  1.  S HLFS=U
  1.  ;
  1.  S IVMI=0 F  S IVMI=$O(^IVM(301.5,"ASEG","IN1",IVMI)) Q:'IVMI  D
  1.  . S IVMJ=0 F  S IVMJ=$O(^IVM(301.5,"ASEG","IN1",IVMI,IVMJ)) Q:'IVMJ  D
  1.  .. S IVM0NOD=$G(^IVM(301.5,IVMI,0)) I IVM0NOD']"" Q
  1.  .. S DFN=+IVM0NOD
  1.  .. I $G(^DPT(+DFN,0))']"" Q
  1.  .. Q:$P($G(^IVM(301.5,IVMI,"IN",IVMJ,0)),U,2)'="IN1"
  1.  .. S IVMIN1=$$GETIN1^IVMLINS1(IVMI,IVMJ)
  1.  .. Q:IVMIN1=""
  1.  .. S IVMADD=$P(IVMIN1,U,5)
  1.  .. D TRANSFER(1)
  1.  ;
  1.  Q
  1.  ;