IBCNEDE7 ;DAOU/DAC - eIV DATA EXTRACTS ; 04-JUN-2002
;;2.0;INTEGRATED BILLING;**271,416,438,497,601,621,668,702,737,771**;21-MAR-94;Build 26
;;Per VA Directive 6402, this routine should not be modified.
;
Q ; no direct calls allowed
;
SETTINGS(EXTNUM) ; Check site parameter settings for the extracts
; IB*737/TAZ - Removed reference to Non-Verified which is being pulled from VistA.
; Input Parameter:
;
; IB*2.0*621/DM reimplement extract (#4), now EICD, formerly No Insurance
; EXTNUM is either 1, 2, 4 to represent the different extracts
; 1 - Insurance Buffer extract
; 2 - Pre-Reg (appointments)
; 4 - EICD
;
; Output parameters:
; Returns a "^" delimited string passing back:
; EACTIVE - A flag of whether to consider the extract active
; XDAYS - Number of days to look back in the past when extracting data
; MAXCNT - Max Number of entries you are allowed to set into the eIV
; Transmission Queue file. If null, # of entries allowed is unlimited.
; SUPPBUFF - Suppress Buffer Flag - Either '0' (No) or '1' (Yes)
; 1 will suppress the creation of buffer entries
; 0 will not
; Applies to #2 (Appointment), and #4 (EICD)
;
; For now, the next three parameters are only used by the EICD (#4) extract
; STARTDYS - number of days from today to form the extract's start date
; DYSAFTER - number of days added to the start date to form the extract's end date
; FREQ - how long the extract must wait before an attempt to re-verify for the patient
;
N DIC,DISYS,DA,X,Y,EACTIVE,XDAYS,MAXCNT,OK,SUPPBUFF
N STARTDYS,DYSAFTER,FREQ
S EACTIVE=0,(XDAYS,MAXCNT,SUPPBUFF,STARTDYS,DYSAFTER,FREQ)=""
S OK=$S(EXTNUM=1:1,EXTNUM=2:1,EXTNUM=4:1,1:0)
I 'OK G EXIT
S DA=1,DIC="^IBE(350.9,"_DA_",51.17,",DIC(0)="X",X=EXTNUM D ^DIC
;
I Y<1 G EXIT ; extract not defined in the IB Site Parameter
;
S EACTIVE=$G(^IBE(350.9,1,51.17,+Y,0))
S XDAYS=$P(EACTIVE,U,3)
S MAXCNT=$P(EACTIVE,U,5)
S SUPPBUFF=$P(EACTIVE,U,6)
S STARTDYS=$P(EACTIVE,U,7)
S DYSAFTER=$P(EACTIVE,U,8)
S FREQ=$P(EACTIVE,U,9)
I SUPPBUFF="" S SUPPBUFF=0
S EACTIVE=$P(EACTIVE,U,2)
EXIT ;
I EXTNUM=2,(XDAYS="") S EACTIVE=0 ; missing required data
I EXTNUM=4,((STARTDYS="")!(DYSAFTER="")!(FREQ="")) S EACTIVE=0 ; missing required data
; IB*737/TAZ 3RD Piece below is left blank on purpose.
Q EACTIVE_U_XDAYS_U_U_MAXCNT_U_SUPPBUFF_U_STARTDYS_U_DYSAFTER_U_FREQ
;
SETTQ(DATA1,DATA2,ORIG,OVERRIDE,DATA5) ;Set extract data in TQ file 365.1
;
; DATA1, DATA2, ORIG & DATA5 are "^" delimited variables containing the data
; listed below
;
; OVERRIDE - flag indicates that this entry is a result of the
; 'Request Re-Verification' menu option.
;
; IB*737/TAZ - Removed references to "~NO PAYER"
;
N BUFFIEN,FDA,IENARRAY,ERROR,TRANSNO,DFN,SRVCODE
S BUFFIEN=$P(DATA1,U,4),SRVCODE=0
;IB*2.0*621/DM make sure SRVCODE is populated
S:BUFFIEN SRVCODE=+$$GET1^DIQ(355.33,BUFFIEN_",",80.01,"I") ; "INQ SERVICE TYPE CODE 1"
S:'SRVCODE SRVCODE=+$$GET1^DIQ(350.9,"1,",60.01,"I") ; "DEFAULT SERVICE TYPE CODE 1"
S TRANSNO=$P($G(^IBCN(365.1,0)),U,3)+1
S FDA(365.1,"+1,",.01)=TRANSNO ; Transaction #
;
S DFN=$P(DATA1,U)
S FDA(365.1,"+1,",.02)=DFN ; patient DFN
S FDA(365.1,"+1,",.03)=$P(DATA1,U,2) ; ien of payer
S FDA(365.1,"+1,",.04)=$P(DATA1,U,3) ; ien of transmission status
S FDA(365.1,"+1,",.15)=DT ; trans status date
S FDA(365.1,"+1,",.05)=BUFFIEN ; ien of buffer
;
S FDA(365.1,"+1,",.06)=$$NOW^XLFDT ; creation date/time
S FDA(365.1,"+1,",.07)=0 ; transmission retries
S FDA(365.1,"+1,",.08)=0 ; number of retries
I $D(OVERRIDE) S FDA(365.1,"+1,",.14)=OVERRIDE ; override flag
S FDA(365.1,"+1,",.16)=$P(DATA1,U,5) ; Sub. ID
S FDA(365.1,"+1,",.17)=$P(DATA1,U,6) ; Freshness Date
S FDA(365.1,"+1,",.18)=$P(DATA1,U,7) ; Pass Buffer ien?
S FDA(365.1,"+1,",.19)=$P(DATA1,U,8) ; Patient ID
S FDA(365.1,"+1,",.2)=SRVCODE ; Service code
;
I $D(DATA2) D
. S FDA(365.1,"+1,",.1)=$P(DATA2,U) ; which extract (ien)
. S FDA(365.1,"+1,",.11)=$P(DATA2,U,2) ; query flag
. S FDA(365.1,"+1,",.12)=$P(DATA2,U,3) ; service date
. S FDA(365.1,"+1,",.13)=$P(DATA2,U,4) ; patient insur. ien
;
I $D(ORIG) D
. S FDA(365.1,"+1,",1.02)=$P(ORIG,U) ; original ins co (in buffer)
. S FDA(365.1,"+1,",1.03)=$P(ORIG,U,2) ; grp number (in buffer or patient record) ;IB*771/CKB
. S FDA(365.1,"+1,",1.04)=$P(ORIG,U,3) ; grp name (in buffer or patient record) ;IB*771/CKB
. S FDA(365.1,"+1,",1.05)=$P(ORIG,U,4) ; original subscriber ID
;
I $D(DATA5) D
. S FDA(365.1,"+1,",3.02)=$P(DATA5,U) ; source of information ien, IB*2*601/DM
. S FDA(365.1,"+1,",.21)=$P(DATA5,U,2) ; EICD INS-FND IEN, IB*2*621/DM
;
D UPDATE^DIE("","FDA","IENARRAY","ERROR")
;
I $G(ERROR("DIERR",1,"TEXT",1))'="" D ; MailMan msg
. N MGRP,XMSUB,MSG
. ;
. ; Set to IB site parameter MAILGROUP
. S MGRP=$$MGRP^IBCNEUT5()
. ;
. S XMSUB="eIV Problem: Trouble setting entry in File 365.1"
. S MSG(1)="Tried to create an entry in the eIV Transmission Queue File #365.1 without"
. S MSG(2)="success."
. S MSG(3)=""
. S MSG(4)="Error encountered: "_$G(ERROR("DIERR",1,"TEXT",1))
. S MSG(5)=""
. S MSG(6)="The data that was to be stored is as follows:"
. S MSG(7)=""
. S MSG(8)="Transaction #: "_TRANSNO
. S MSG(9)="Patient: "_$P($G(^DPT(DFN,0)),U)_$$SSN^IBCNEDEQ(DFN)
. S MSG(10)="Extract: "_$P($G(DATA2),U,1)
. S MSG(11)="Payer: "
. S:$P(DATA1,U,2)'="" MSG(11)=MSG(11)_$P($G(^IBE(365.12,$P(DATA1,U,2),0)),U,1)
. S MSG(12)="Please call the Help Desk about this problem."
. D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
;
Q $G(IENARRAY(1))
;
PYRACTV(PIEN) ; check if given payer is nationally enabled for eIV
; returns 1 if payer is nationally enabled, 0 otherwise
;IB*668/TAZ - Changed field names to enabled and Payer Application from IIV to EIV
N APPIEN,RES
S RES=0
I +$G(PIEN)'>0 G PYRACTVX
S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
I +$G(APPIEN)'>0 G PYRACTVX
I $P($G(^IBE(365.12,PIEN,1,APPIEN,0)),U,2)=1 S RES=1
PYRACTVX ;
Q RES
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEDE7 6343 printed Oct 16, 2024@18:15:11 Page 2
IBCNEDE7 ;DAOU/DAC - eIV DATA EXTRACTS ; 04-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**271,416,438,497,601,621,668,702,737,771**;21-MAR-94;Build 26
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; no direct calls allowed
QUIT
+5 ;
SETTINGS(EXTNUM) ; Check site parameter settings for the extracts
+1 ; IB*737/TAZ - Removed reference to Non-Verified which is being pulled from VistA.
+2 ; Input Parameter:
+3 ;
+4 ; IB*2.0*621/DM reimplement extract (#4), now EICD, formerly No Insurance
+5 ; EXTNUM is either 1, 2, 4 to represent the different extracts
+6 ; 1 - Insurance Buffer extract
+7 ; 2 - Pre-Reg (appointments)
+8 ; 4 - EICD
+9 ;
+10 ; Output parameters:
+11 ; Returns a "^" delimited string passing back:
+12 ; EACTIVE - A flag of whether to consider the extract active
+13 ; XDAYS - Number of days to look back in the past when extracting data
+14 ; MAXCNT - Max Number of entries you are allowed to set into the eIV
+15 ; Transmission Queue file. If null, # of entries allowed is unlimited.
+16 ; SUPPBUFF - Suppress Buffer Flag - Either '0' (No) or '1' (Yes)
+17 ; 1 will suppress the creation of buffer entries
+18 ; 0 will not
+19 ; Applies to #2 (Appointment), and #4 (EICD)
+20 ;
+21 ; For now, the next three parameters are only used by the EICD (#4) extract
+22 ; STARTDYS - number of days from today to form the extract's start date
+23 ; DYSAFTER - number of days added to the start date to form the extract's end date
+24 ; FREQ - how long the extract must wait before an attempt to re-verify for the patient
+25 ;
+26 NEW DIC,DISYS,DA,X,Y,EACTIVE,XDAYS,MAXCNT,OK,SUPPBUFF
+27 NEW STARTDYS,DYSAFTER,FREQ
+28 SET EACTIVE=0
SET (XDAYS,MAXCNT,SUPPBUFF,STARTDYS,DYSAFTER,FREQ)=""
+29 SET OK=$SELECT(EXTNUM=1:1,EXTNUM=2:1,EXTNUM=4:1,1:0)
+30 IF 'OK
GOTO EXIT
+31 SET DA=1
SET DIC="^IBE(350.9,"_DA_",51.17,"
SET DIC(0)="X"
SET X=EXTNUM
DO ^DIC
+32 ;
+33 ; extract not defined in the IB Site Parameter
IF Y<1
GOTO EXIT
+34 ;
+35 SET EACTIVE=$GET(^IBE(350.9,1,51.17,+Y,0))
+36 SET XDAYS=$PIECE(EACTIVE,U,3)
+37 SET MAXCNT=$PIECE(EACTIVE,U,5)
+38 SET SUPPBUFF=$PIECE(EACTIVE,U,6)
+39 SET STARTDYS=$PIECE(EACTIVE,U,7)
+40 SET DYSAFTER=$PIECE(EACTIVE,U,8)
+41 SET FREQ=$PIECE(EACTIVE,U,9)
+42 IF SUPPBUFF=""
SET SUPPBUFF=0
+43 SET EACTIVE=$PIECE(EACTIVE,U,2)
EXIT ;
+1 ; missing required data
IF EXTNUM=2
IF (XDAYS="")
SET EACTIVE=0
+2 ; missing required data
IF EXTNUM=4
IF ((STARTDYS="")!(DYSAFTER="")!(FREQ=""))
SET EACTIVE=0
+3 ; IB*737/TAZ 3RD Piece below is left blank on purpose.
+4 QUIT EACTIVE_U_XDAYS_U_U_MAXCNT_U_SUPPBUFF_U_STARTDYS_U_DYSAFTER_U_FREQ
+5 ;
SETTQ(DATA1,DATA2,ORIG,OVERRIDE,DATA5) ;Set extract data in TQ file 365.1
+1 ;
+2 ; DATA1, DATA2, ORIG & DATA5 are "^" delimited variables containing the data
+3 ; listed below
+4 ;
+5 ; OVERRIDE - flag indicates that this entry is a result of the
+6 ; 'Request Re-Verification' menu option.
+7 ;
+8 ; IB*737/TAZ - Removed references to "~NO PAYER"
+9 ;
+10 NEW BUFFIEN,FDA,IENARRAY,ERROR,TRANSNO,DFN,SRVCODE
+11 SET BUFFIEN=$PIECE(DATA1,U,4)
SET SRVCODE=0
+12 ;IB*2.0*621/DM make sure SRVCODE is populated
+13 ; "INQ SERVICE TYPE CODE 1"
if BUFFIEN
SET SRVCODE=+$$GET1^DIQ(355.33,BUFFIEN_",",80.01,"I")
+14 ; "DEFAULT SERVICE TYPE CODE 1"
if 'SRVCODE
SET SRVCODE=+$$GET1^DIQ(350.9,"1,",60.01,"I")
+15 SET TRANSNO=$PIECE($GET(^IBCN(365.1,0)),U,3)+1
+16 ; Transaction #
SET FDA(365.1,"+1,",.01)=TRANSNO
+17 ;
+18 SET DFN=$PIECE(DATA1,U)
+19 ; patient DFN
SET FDA(365.1,"+1,",.02)=DFN
+20 ; ien of payer
SET FDA(365.1,"+1,",.03)=$PIECE(DATA1,U,2)
+21 ; ien of transmission status
SET FDA(365.1,"+1,",.04)=$PIECE(DATA1,U,3)
+22 ; trans status date
SET FDA(365.1,"+1,",.15)=DT
+23 ; ien of buffer
SET FDA(365.1,"+1,",.05)=BUFFIEN
+24 ;
+25 ; creation date/time
SET FDA(365.1,"+1,",.06)=$$NOW^XLFDT
+26 ; transmission retries
SET FDA(365.1,"+1,",.07)=0
+27 ; number of retries
SET FDA(365.1,"+1,",.08)=0
+28 ; override flag
IF $DATA(OVERRIDE)
SET FDA(365.1,"+1,",.14)=OVERRIDE
+29 ; Sub. ID
SET FDA(365.1,"+1,",.16)=$PIECE(DATA1,U,5)
+30 ; Freshness Date
SET FDA(365.1,"+1,",.17)=$PIECE(DATA1,U,6)
+31 ; Pass Buffer ien?
SET FDA(365.1,"+1,",.18)=$PIECE(DATA1,U,7)
+32 ; Patient ID
SET FDA(365.1,"+1,",.19)=$PIECE(DATA1,U,8)
+33 ; Service code
SET FDA(365.1,"+1,",.2)=SRVCODE
+34 ;
+35 IF $DATA(DATA2)
Begin DoDot:1
+36 ; which extract (ien)
SET FDA(365.1,"+1,",.1)=$PIECE(DATA2,U)
+37 ; query flag
SET FDA(365.1,"+1,",.11)=$PIECE(DATA2,U,2)
+38 ; service date
SET FDA(365.1,"+1,",.12)=$PIECE(DATA2,U,3)
+39 ; patient insur. ien
SET FDA(365.1,"+1,",.13)=$PIECE(DATA2,U,4)
End DoDot:1
+40 ;
+41 IF $DATA(ORIG)
Begin DoDot:1
+42 ; original ins co (in buffer)
SET FDA(365.1,"+1,",1.02)=$PIECE(ORIG,U)
+43 ; grp number (in buffer or patient record) ;IB*771/CKB
SET FDA(365.1,"+1,",1.03)=$PIECE(ORIG,U,2)
+44 ; grp name (in buffer or patient record) ;IB*771/CKB
SET FDA(365.1,"+1,",1.04)=$PIECE(ORIG,U,3)
+45 ; original subscriber ID
SET FDA(365.1,"+1,",1.05)=$PIECE(ORIG,U,4)
End DoDot:1
+46 ;
+47 IF $DATA(DATA5)
Begin DoDot:1
+48 ; source of information ien, IB*2*601/DM
SET FDA(365.1,"+1,",3.02)=$PIECE(DATA5,U)
+49 ; EICD INS-FND IEN, IB*2*621/DM
SET FDA(365.1,"+1,",.21)=$PIECE(DATA5,U,2)
End DoDot:1
+50 ;
+51 DO UPDATE^DIE("","FDA","IENARRAY","ERROR")
+52 ;
+53 ; MailMan msg
IF $GET(ERROR("DIERR",1,"TEXT",1))'=""
Begin DoDot:1
+54 NEW MGRP,XMSUB,MSG
+55 ;
+56 ; Set to IB site parameter MAILGROUP
+57 SET MGRP=$$MGRP^IBCNEUT5()
+58 ;
+59 SET XMSUB="eIV Problem: Trouble setting entry in File 365.1"
+60 SET MSG(1)="Tried to create an entry in the eIV Transmission Queue File #365.1 without"
+61 SET MSG(2)="success."
+62 SET MSG(3)=""
+63 SET MSG(4)="Error encountered: "_$GET(ERROR("DIERR",1,"TEXT",1))
+64 SET MSG(5)=""
+65 SET MSG(6)="The data that was to be stored is as follows:"
+66 SET MSG(7)=""
+67 SET MSG(8)="Transaction #: "_TRANSNO
+68 SET MSG(9)="Patient: "_$PIECE($GET(^DPT(DFN,0)),U)_$$SSN^IBCNEDEQ(DFN)
+69 SET MSG(10)="Extract: "_$PIECE($GET(DATA2),U,1)
+70 SET MSG(11)="Payer: "
+71 if $PIECE(DATA1,U,2)'=""
SET MSG(11)=MSG(11)_$PIECE($GET(^IBE(365.12,$PIECE(DATA1,U,2),0)),U,1)
+72 SET MSG(12)="Please call the Help Desk about this problem."
+73 DO MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
End DoDot:1
+74 ;
+75 QUIT $GET(IENARRAY(1))
+76 ;
PYRACTV(PIEN) ; check if given payer is nationally enabled for eIV
+1 ; returns 1 if payer is nationally enabled, 0 otherwise
+2 ;IB*668/TAZ - Changed field names to enabled and Payer Application from IIV to EIV
+3 NEW APPIEN,RES
+4 SET RES=0
+5 IF +$GET(PIEN)'>0
GOTO PYRACTVX
+6 SET APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
+7 IF +$GET(APPIEN)'>0
GOTO PYRACTVX
+8 IF $PIECE($GET(^IBE(365.12,PIEN,1,APPIEN,0)),U,2)=1
SET RES=1
PYRACTVX ;
+1 QUIT RES
