IVMLINS3 ;ALB/KCL,TDM,HM - IVM INSURANCE POLICY TRANSFER ;3/9/09 2:01pm
;;2.0;INCOME VERIFICATION MATCH;**14,111,121,172**;21-OCT-94;Build 27
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
;
TRANSFER(IVMAUTO) ; user has chosen to transfer insurance information,
; received from HEC, to the MCCR insurance buffer. this routine
; will call $$ADDSTF^IBCNBES(3,DFN,IVMIBDAT) to place HEC's insurance
; information in the MCCR insurance buffer where authorized insurance
; personnel will either upload or reject the data.
; 3 indicates that source of information is IVM
; IVMIBDAT = data, to be filed in the MCCR buffer, in an array
; subscripted by field number of the data field in
; the INSURANCE BUFFER file (#355.33)
; INPUT: IVMAUTO = 1 if auto-filing directly from upload
; 0 if using list manager interface to file
; THE FOLLOWING ARE ASSUMED TO BE DEFINED:
; IVMIN1 (ST/ST1 segment string nodes of file 301.5)
; IVMADD (5th "^" piece of IVMIN1 for ins co address data)
;
; Supported ICR #2537: Supports use of ADDSTF^IBCNBES to add a
; new entry to the INSURANCE BUFFER file (#355.33)
;
N IVMIB,IVMIBDAT,IVMNOI,IVMPRTI
;
I '$G(IVMAUTO) W !!,"Transferring HEC'S insurance data to the MCCR insurance buffer",!
S IVMNOI=$S($P(IVMIN1,HLFS,17)="v":$P($$PT^IVMUFNC4(DFN),"^"),1:$P(IVMIN1,HLFS,16))
S IVMPRTI=$S($P(IVMIN1,HLFS,17)="v":"01",1:"02")
;
S IVMIBDAT(20.01)=$E($P(IVMIN1,HLFS,4),1,30) ;ins co name
S IVMIBDAT(20.02)=$E($P(IVMIN1,HLFS,7),1,20) ;phone number
S IVMIBDAT(21.01)=$E($P(IVMADD,"~",1),1,35) ;street add [line 1]
S IVMIBDAT(21.02)=$E($P(IVMADD,"~",2),1,30) ;street add [line 2]
S IVMIBDAT(21.03)=$E($P(IVMADD,"~",8),1,30) ;street add [line 3]
S IVMIBDAT(21.04)=$E($P(IVMADD,"~",3),1,25) ;city
S IVMIBDAT(21.05)=$$STATE1^IVMUFNC4($P(IVMADD,"~",4)) ;state
S IVMIBDAT(21.06)=$E($P(IVMADD,"~",5),1,20) ;zip
S IVMIBDAT(40.02)=$E($P(IVMIN1,HLFS,9),1,20) ;group name
S IVMIBDAT(40.03)=$E($P(IVMIN1,HLFS,8),1,17) ;group number
S IVMIBDAT(40.05)=$S($P(IVMIN1,HLFS,28)=1:1,1:0) ;precertification required
S IVMIBDAT(40.09)=$P(IVMIN1,HLFS,15) ;type of plan
S IVMIBDAT(60.01)=DFN ;patient name
S IVMIBDAT(60.02)=$$FMDATE^HLFNC($P(IVMIN1,HLFS,12)) ;effective date
S IVMIBDAT(60.03)=$$FMDATE^HLFNC($P(IVMIN1,HLFS,13)) ;expiration date
S IVMIBDAT(60.04)=$E($P(IVMIN1,HLFS,36),1,20) ;subcriber id
S IVMIBDAT(60.05)=$P(IVMIN1,HLFS,17) ;whose insurance
S IVMIBDAT(60.06)=IVMPRTI ;pt relationship to insured
S IVMIBDAT(60.07)=IVMNOI ;name of insured
S IVMIBDAT(60.08)=$P(IVMIN1,HLFS,18) ;insured's date of birth IVM*2.0*172 HM
;
I '$G(IVMSOI) S IVMSOI=$P(IVMZIV,HLFS,13) ;set Source of Information if missing IVM*2.0*172 HM
S IVMIB=$$ADDSTF^IBCNBES(IVMSOI,DFN,.IVMIBDAT) ;updated to pass in IVMSOI from ZIV sequence 13 IVM*2.0*172 HM
I 'IVMIB D Q
.Q:$G(IVMAUTO)
.W !,"The following error occurred when transferring data:"
.W !,$P(IVMIB,"^",2)
.W !,"Please contact your IRM staff for help"
;
N DA,DIE,DR
S DA=IVMJ,DA(1)=IVMI
;
; - delete segment name (.02 field of 301.501 multiple) from IVM PATIENT
; file to remove from ASEG cross-reference
S DIE="^IVM(301.5,"_DA(1)_",""IN"",",DR=".02////@" D ^DIE
;
I $G(IVMAUTO) G IVMQ
;
W "completed.",!
;
S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
;
REMOVE ; - remove entry from the List Manager display after transferring
K ^TMP("IVMIUPL",$J,IVMNAME,IVMI,IVMJ)
;
; - action completed
S IVMDONE=1
;
IVMQ K DIRUT,DTOUT,DUOUT,IVMACT,IVMDA,IVMFLAG,IVMREPTR,IVMSOI,IVMZIV,X,Y ;IVM*2.0*172 HM
Q
;
AUTO ; Auto-upload all Z04 entries pending in file 301.501
; Called by the patch IVM*2*111 post-install
N DFN,IVMI,IVMJ,IVMIN1,IVMADD,IVM0NOD,HLFS
S HLFS=U
;
S IVMI=0 F S IVMI=$O(^IVM(301.5,"ASEG","IN1",IVMI)) Q:'IVMI D
. S IVMJ=0 F S IVMJ=$O(^IVM(301.5,"ASEG","IN1",IVMI,IVMJ)) Q:'IVMJ D
.. S IVM0NOD=$G(^IVM(301.5,IVMI,0)) I IVM0NOD']"" Q
.. S DFN=+IVM0NOD
.. I $G(^DPT(+DFN,0))']"" Q
.. Q:$P($G(^IVM(301.5,IVMI,"IN",IVMJ,0)),U,2)'="IN1"
.. S IVMIN1=$$GETIN1^IVMLINS1(IVMI,IVMJ)
.. Q:IVMIN1=""
.. S IVMADD=$P(IVMIN1,U,5)
.. D TRANSFER(1)
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLINS3 4325 printed Mar 13, 2025@21:06:03 Page 2
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
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
+5 ;
TRANSFER(IVMAUTO) ; user has chosen to transfer insurance information,
+1 ; received from HEC, to the MCCR insurance buffer. this routine
+2 ; will call $$ADDSTF^IBCNBES(3,DFN,IVMIBDAT) to place HEC's insurance
+3 ; information in the MCCR insurance buffer where authorized insurance
+4 ; personnel will either upload or reject the data.
+5 ; 3 indicates that source of information is IVM
+6 ; IVMIBDAT = data, to be filed in the MCCR buffer, in an array
+7 ; subscripted by field number of the data field in
+8 ; the INSURANCE BUFFER file (#355.33)
+9 ; INPUT: IVMAUTO = 1 if auto-filing directly from upload
+10 ; 0 if using list manager interface to file
+11 ; THE FOLLOWING ARE ASSUMED TO BE DEFINED:
+12 ; IVMIN1 (ST/ST1 segment string nodes of file 301.5)
+13 ; IVMADD (5th "^" piece of IVMIN1 for ins co address data)
+14 ;
+15 ; Supported ICR #2537: Supports use of ADDSTF^IBCNBES to add a
+16 ; new entry to the INSURANCE BUFFER file (#355.33)
+17 ;
+18 NEW IVMIB,IVMIBDAT,IVMNOI,IVMPRTI
+19 ;
+20 IF '$GET(IVMAUTO)
WRITE !!,"Transferring HEC'S insurance data to the MCCR insurance buffer",!
+21 SET IVMNOI=$SELECT($PIECE(IVMIN1,HLFS,17)="v":$PIECE($$PT^IVMUFNC4(DFN),"^"),1:$PIECE(IVMIN1,HLFS,16))
+22 SET IVMPRTI=$SELECT($PIECE(IVMIN1,HLFS,17)="v":"01",1:"02")
+23 ;
+24 ;ins co name
SET IVMIBDAT(20.01)=$EXTRACT($PIECE(IVMIN1,HLFS,4),1,30)
+25 ;phone number
SET IVMIBDAT(20.02)=$EXTRACT($PIECE(IVMIN1,HLFS,7),1,20)
+26 ;street add [line 1]
SET IVMIBDAT(21.01)=$EXTRACT($PIECE(IVMADD,"~",1),1,35)
+27 ;street add [line 2]
SET IVMIBDAT(21.02)=$EXTRACT($PIECE(IVMADD,"~",2),1,30)
+28 ;street add [line 3]
SET IVMIBDAT(21.03)=$EXTRACT($PIECE(IVMADD,"~",8),1,30)
+29 ;city
SET IVMIBDAT(21.04)=$EXTRACT($PIECE(IVMADD,"~",3),1,25)
+30 ;state
SET IVMIBDAT(21.05)=$$STATE1^IVMUFNC4($PIECE(IVMADD,"~",4))
+31 ;zip
SET IVMIBDAT(21.06)=$EXTRACT($PIECE(IVMADD,"~",5),1,20)
+32 ;group name
SET IVMIBDAT(40.02)=$EXTRACT($PIECE(IVMIN1,HLFS,9),1,20)
+33 ;group number
SET IVMIBDAT(40.03)=$EXTRACT($PIECE(IVMIN1,HLFS,8),1,17)
+34 ;precertification required
SET IVMIBDAT(40.05)=$SELECT($PIECE(IVMIN1,HLFS,28)=1:1,1:0)
+35 ;type of plan
SET IVMIBDAT(40.09)=$PIECE(IVMIN1,HLFS,15)
+36 ;patient name
SET IVMIBDAT(60.01)=DFN
+37 ;effective date
SET IVMIBDAT(60.02)=$$FMDATE^HLFNC($PIECE(IVMIN1,HLFS,12))
+38 ;expiration date
SET IVMIBDAT(60.03)=$$FMDATE^HLFNC($PIECE(IVMIN1,HLFS,13))
+39 ;subcriber id
SET IVMIBDAT(60.04)=$EXTRACT($PIECE(IVMIN1,HLFS,36),1,20)
+40 ;whose insurance
SET IVMIBDAT(60.05)=$PIECE(IVMIN1,HLFS,17)
+41 ;pt relationship to insured
SET IVMIBDAT(60.06)=IVMPRTI
+42 ;name of insured
SET IVMIBDAT(60.07)=IVMNOI
+43 ;insured's date of birth IVM*2.0*172 HM
SET IVMIBDAT(60.08)=$PIECE(IVMIN1,HLFS,18)
+44 ;
+45 ;set Source of Information if missing IVM*2.0*172 HM
IF '$GET(IVMSOI)
SET IVMSOI=$PIECE(IVMZIV,HLFS,13)
+46 ;updated to pass in IVMSOI from ZIV sequence 13 IVM*2.0*172 HM
SET IVMIB=$$ADDSTF^IBCNBES(IVMSOI,DFN,.IVMIBDAT)
+47 IF 'IVMIB
Begin DoDot:1
+48 if $GET(IVMAUTO)
QUIT
+49 WRITE !,"The following error occurred when transferring data:"
+50 WRITE !,$PIECE(IVMIB,"^",2)
+51 WRITE !,"Please contact your IRM staff for help"
End DoDot:1
QUIT
+52 ;
+53 NEW DA,DIE,DR
+54 SET DA=IVMJ
SET DA(1)=IVMI
+55 ;
+56 ; - delete segment name (.02 field of 301.501 multiple) from IVM PATIENT
+57 ; file to remove from ASEG cross-reference
+58 SET DIE="^IVM(301.5,"_DA(1)_",""IN"","
SET DR=".02////@"
DO ^DIE
+59 ;
+60 IF $GET(IVMAUTO)
GOTO IVMQ
+61 ;
+62 WRITE "completed.",!
+63 ;
+64 SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
KILL DIR
+65 ;
REMOVE ; - remove entry from the List Manager display after transferring
+1 KILL ^TMP("IVMIUPL",$JOB,IVMNAME,IVMI,IVMJ)
+2 ;
+3 ; - action completed
+4 SET IVMDONE=1
+5 ;
IVMQ ;IVM*2.0*172 HM
KILL DIRUT,DTOUT,DUOUT,IVMACT,IVMDA,IVMFLAG,IVMREPTR,IVMSOI,IVMZIV,X,Y
+1 QUIT
+2 ;
AUTO ; Auto-upload all Z04 entries pending in file 301.501
+1 ; Called by the patch IVM*2*111 post-install
+2 NEW DFN,IVMI,IVMJ,IVMIN1,IVMADD,IVM0NOD,HLFS
+3 SET HLFS=U
+4 ;
+5 SET IVMI=0
FOR
SET IVMI=$ORDER(^IVM(301.5,"ASEG","IN1",IVMI))
if 'IVMI
QUIT
Begin DoDot:1
+6 SET IVMJ=0
FOR
SET IVMJ=$ORDER(^IVM(301.5,"ASEG","IN1",IVMI,IVMJ))
if 'IVMJ
QUIT
Begin DoDot:2
+7 SET IVM0NOD=$GET(^IVM(301.5,IVMI,0))
IF IVM0NOD']""
QUIT
+8 SET DFN=+IVM0NOD
+9 IF $GET(^DPT(+DFN,0))']""
QUIT
+10 if $PIECE($GET(^IVM(301.5,IVMI,"IN",IVMJ,0)),U,2)'="IN1"
QUIT
+11 SET IVMIN1=$$GETIN1^IVMLINS1(IVMI,IVMJ)
+12 if IVMIN1=""
QUIT
+13 SET IVMADD=$PIECE(IVMIN1,U,5)
+14 DO TRANSFER(1)
End DoDot:2
End DoDot:1
+15 ;
+16 QUIT
+17 ;
