- IBCEP8C ;DSS/SCR - Functions for IB SILENT INTERFACE FROM FB ;03-27-12
- ;;2.0;INTEGRATED BILLING;**476**;21-MAR-94;Build 2
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; This routine contains functions needed by the FB PAID TO IB OPTION to maintain
- ; the 355.93 - IB VA NON/OTHER BILLING PROVIDER file
- ;
- EPTRANS() ;EP called from INPUT TRANSFORM IN THE .01 FIELD
- ; of 355.93 VA NON/OTHER BILLING PROVIDER file
- ;
- ;Used only by the IB AUTOMATIC INTERFACE FROM FB to ADD a new entry or UPDATE an existing one
- ;
- S:IBPRVTYP=1 IBTYPE="F"
- S:IBPRVTYP=2 IBTYPE="I"
- S IBFBFLAG=1 ;USED BY THE NPI input transform to transfer code to interface and avoid user interaction
- ;
- Q
- EPFBAPI(IBSRCREC,IBRETARY) ;EP from FBTOIB^FBPAID3A
- ; INPUTS : IBSRCREC - an array of information about this source record supplied by FB side
- ;
- ; OUTPUT : IBRETARY (passed by reference) populated with information about results of interface processing
- ;
- ;TO IB NON/OTHER VA BILLING PROVIDER FILE 355.93
- N IBRET
- ;
- S IBRET=$$IBNONVA(.IBSRCREC) ;UPDATES THE IB NON/OTHER VA BILLING PROVIDER FILE
- S IBRETARY(1)=$P(IBRET,U,1) ;The IEN of the IB record matched or created or NULL if neither
- S IBRETARY(2)=$P(IBRET,U,2) ;A code from below indicating how NPI validation and record updates went
- ; '0' FOR NO NPI UPDATES ATTEMPTED;'1' FOR NPI DATA INVALID;'2' FOR NPI MATCHED ACTIVE, NO UPDATES;
- ; '3' FOR NPI MATCHED INACTIVE, NO UPDATES;'4' FOR NPI MATCHED ACTIVE, IB UPDATED; '5' FOR NPI NEW, IB RECORD CREATED;
- S IBRETARY(3)=$P(IBRET,U,3) ;A code from below indicating how TXY updates went
- ; '0' FOR NO TXY UPDATES ATTEMPTED;'1' FOR TXY CODE NOT FOUND IN 8932.1; '2' FOR MATCHED PRIMARY,NO UPDATES;
- ;'3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;'4' FOR NEW, IB TXY ENTRY CREATED;
- Q
- ;
- IBNONVA(IBFBINF) ;UPDATES TO #355.93
- ; INPUTS IBFBINF : AN ARRAY OF INFORMATION FROM FB TO BE COMPARED/UPDATED IN IB NON/OTHER
- ;
- ; LOOK UP BY NPI - should only be one match per provider type
- ;
- N IBQUIT,IBRTRN,IBDONE,IBFLGS,IBFLDS,IBIEN,IBSCRN,IBINDX,IBERR2,IBLKUP,IBOKTXY,IBOKNPI
- N IBERR,IBFBMLT,IBNPICHK,IBFDA,IBALLOW,IBOKFB,IBOK,IBPRVNPI,IBPRVTYP
- ;
- S IBQUIT=0
- S IBDONE=0
- S IBOKTXY=""
- S IBOKNPI=""
- S IBPRVTYP=IBFBINF("IB TYPE")
- S IBPRVNPI=IBFBINF("FBNPI")
- S IBPRVNAM=IBFBINF("NAME")
- S IBPRVTXY=IBFBINF("FBTXY")
- S IBFBDUZ=IBFBINF("FB SUP DUZ")
- ;
- I IBPRVNPI'="" D
- .N DO,X,%,%H,%I,X,IBNOW,DD,Y
- .D NOW^%DTC
- .S IBNOW=%
- .S IBPRVNAM=$$STRIP(IBPRVNAM)
- .S IBPRVNAM=$$UP^XLFSTR(IBPRVNAM)
- .S IBIEN=$$ACTVNPI(IBPRVNPI) ;returns IEN of record with this NPI as 'active'
- .I IBIEN>0 D
- ..S IBFBMLT=0 ;FB MULTIPLE NOT YET UPDATED
- ..S IBOKNPI=2 ;MATCHED ACTIVE NO UPDATES...will get changed if updates are made
- ..S IBOKTXY=0 ;NO TXY UPDATES ATTEMPTED
- ..;(#.01) NAME [1F] ; (#.02) PROVIDER TYPE [2S](#.05) STREETADDRESS [5F] ; (#.06) CITY [6F];
- ..;(#.07) STATE [7P:5] ^(#.08) ZIP CODE [8F] ; (#.09) FACILITY DEFAULT ID NUMBER[9F] ^(#.1) STREET ADDRESS LINE 2 [10F] ;
- ..;(#.13)PRIMARY ID QUALIFIER [13P:355.97];(#41.01) NPI [14F]
- ..S IBFLDS=".01;.02;.05;.06;.07;.08;.09;.1;.13;41.01"
- ..D GETS^DIQ(355.93,IBIEN_",",IBFLDS,"I","IBRTRN","IBERR") ; 355.93 IB NON/OTHER VA BILLING PROVIDER FILE
- ..I $G(IBERR("DIERR")) S IBQUIT=1
- ..Q:IBQUIT
- ..S IBALLOW=$$FBALLOW(IBIEN) ;FIND OUT IF THIS PROVIDER SHOULD BE EDITED OR NOT
- ..Q:IBALLOW=0
- ..I IBRTRN(355.93,IBIEN_",",".02","I")=IBPRVTYP D SETIBFDA(.IBRTRN,.IBFBINF,.IBFDA,IBIEN)
- ..S IBOK=$$LOCK(IBIEN) ;locks the #355.93 record
- ..Q:'IBOK
- ..I $D(IBFDA(355.93)) D
- ...S XQY0="FB AUTO INTERFACE TO IB" ; MUST be set to pass the .01 input transform defined in PRVFMT^IBCEP8
- ...S IBFLPFLP=IBPRVTYP ;needed for input transform
- ...D FILE^DIE("","IBFDA","IBERR")
- ...I $G(IBERR("DIERR")) S IBQUIT=1 ;FILE ATTEMPT RETURNED DB ERROR
- ...Q:IBQUIT
- ...S IBFBMLT=$$ADDFB(IBIEN,IBFBDUZ,IBNOW,0)
- ...S IBOKNPI=4 ; FOR NPI MATCHED ACTIVE, IB UPDATED;
- ..;CHECK TAXONOMY CODE
- ..I $G(IBPRVTXY)'="" D
- ...S IBOKTXY=$$CHKTXY(IBIEN,IBPRVTXY) ;RETURNS A CODE FROM SET OF CODES - 0 IF NO CHANGES WERE MADE
- ...S:('+IBFBMLT)&((IBOKTXY=3)!(IBOKTXY=4)) IBFBMLT=$$ADDFB(IBIEN,IBFBDUZ,IBNOW,0)
- ...;add FB mult if not already added for other changes, and the txy was changed
- ..D UNLOCK(IBIEN) ;Unlocks the #355.93 record
- ..S IBDONE=1 ;We have found a match on NPI
- .Q:IBQUIT
- .Q:IBDONE
- .I IBIEN="" D
- ..S IBNPICHK=$$INACTV(IBPRVNPI) ;look for match on currently inactive
- ..I IBNPICHK'="" D
- ...S IBIEN=IBNPICHK ;THE IEN OF THE record with this NPI as INACTIVE
- ...S IBOKNPI=3 ;FOR NPI MATCHED INACTIVE, NO UPDATES;
- ...S IBOKTXY=0 ;NO ATTEMPTED UPDATES
- ...S IBDONE=1
- ..Q:IBDONE
- ..S IBNPICHK=$$RULES(IBPRVNPI) ;RETURN OF 0 means no problem
- ..I IBNPICHK>0 D
- ...;there is a match on an active NPI in the NEW PERSON or the INSTITUTION file
- ...S IBOKNPI=2 ;NPI MATCHED ACTIVE NO UPDATES
- ...S IBOKTXY=0
- ...S IBDONE=1
- ..Q:IBDONE
- ..;all checks have occurred, now we are going to add this PROVIDER/NPI
- ..S IBOK=$$LOCK() ;locks the #355.93 file
- ..I 'IBOK Q
- ..N DIC,X,Y
- ..S DIC="^IBA(355.93,"
- ..S X=IBPRVNAM
- ..S DIC(0)=""
- ..S DIC("DR")=".02///"_IBPRVTYP
- ..I IBPRVTYP=1 D ;ADD FACILITY INFORMATION
- ...I $G(IBFBINF("FBADD1"))'="" S DIC("DR")=DIC("DR")_";.05///"_IBFBINF("FBADD1")
- ...I $G(IBFBINF("FBADD2"))'="" S DIC("DR")=DIC("DR")_";.1///"_IBFBINF("FBADD2")
- ...I $G(IBFBINF("FBCITY"))'="" S DIC("DR")=DIC("DR")_";.06///"_IBFBINF("FBCITY")
- ...S:$G(IBFBINF("FBSTATE INT")) DIC("DR")=DIC("DR")_";.07///`"_IBFBINF("FBSTATE INT") ;POINTER SO PUT INTO INTERNAL FORMAT
- ...S:$G(IBFBINF("FBZIP")) DIC("DR")=DIC("DR")_";.08///"_IBFBINF("FBZIP")
- ...I $G(IBFBINF("FBFACID"))'="" S DIC("DR")=DIC("DR")_";.09///"_IBFBINF("FBFACID")
- ..S DIC("DR")=DIC("DR")_";41.01///"_IBPRVNPI
- ..S XQY0="FB AUTO INTERFACE TO IB" ; MUST be set to pass the .01 input transform defined in PRVFMT^IBCEP8
- ..S IBFLPFLP=IBPRVTYP ;needed for successful 'three stuff' validation
- ..D FILE^DICN
- ..S IBIEN=+Y
- ..I IBIEN=-1 D
- ...S IBQUIT=1
- ...D UNLOCK()
- ..Q:IBQUIT
- ..S IBOKFB=$$ADDFB(IBIEN,IBFBDUZ,IBNOW,1)
- ..S IBOKNPI=$$ADDNPI(IBIEN,IBPRVNPI,IBFBDUZ,IBNOW) ;returns 1 or 0
- ..S:IBOKNPI=1 IBOKNPI=5 ;NPI NEW, IB RECORD CREATED
- ..I $G(IBPRVTXY)'="" D
- ...S IBOK=$$ADDTXY(IBIEN,IBPRVTXY,1)
- ...S:IBOK IBOKTXY=4 ;FOR NEW TXY ENTRY CREATED
- ...S:'IBOK IBOKTXY=0 ;NO TXY UPDATES ATTEMPTED
- ..D UNLOCK() ;unlocks the #355.93 file or a record
- S:$G(IBPRVTXY)="" IBOKTXY=0 ;NO TXY UPDATES ATTEMPTED
- S:$G(IBPRVNPI)="" IBOKNPI=0 ;NO NPI UPDATES ATTEMPTED
- I IBQUIT S IBIEN=""
- Q IBIEN_"^"_IBOKNPI_"^"_IBOKTXY
- ;
- ADDFB(IBIEN,IBFBDUZ,IBNOW,IBFBADD) ;ADD a multiple entry
- ; INPUTS : IBIEN: IEN OF THE IB NON/OTHER VA PROVIDER FILE being updated with NPI information
- ; IBFBDUZ : IEN of the FB SUPERVISOR who certified the batch
- ; IBNOW : FM Date/time
- ; IBFBADD : 1 if FB is just created the record 0 if not
- ;
- N IBFDA,IBIENRET,IBERR
- ;
- S IBQUIT=0
- S IBFDA(355.935,"+1,"_IBIEN_",",.01)=IBNOW ;(#.01) DATE/TIME LAST FB UPDATE [1D]
- S IBFDA(355.935,"+1,"_IBIEN_",",.02)=IBFBDUZ ;(#.02) DUZ OFFB SUP [2P:200]
- S:IBFBADD IBFDA(355.935,"+1,"_IBIEN_",",.03)=IBFBADD ;(#.03) CREATED BY FB PAID TO IB[3S]
- D UPDATE^DIE("","IBFDA","IBIENRET","IBERR")
- I $G(IBERR("DIERR"))'="" S IBQUIT=1
- Q 'IBQUIT
- ;
- ADDNPI(IBIEN,IBNPI,IBFBDUZ,IBNOW) ;ADD NPI multiple
- ; INPUTS : IBIEN: IEN OF THE IB NON/OTHER VA PROVIDER FILE being updated with NPI information
- ; IBNPI : NPI STRING TO BE ADDED if it passes validation rules (we already know this
- ; npi does not exist as an 'active' npi for a current entry in this file
- ;
- N IBFDA,IBERR,IBQUIT
- ;
- S IBQUIT=0
- S IBFDA(355.9301,"+1,"_IBIEN_",",.01)=IBNOW ;355.9301 ;(#40) DATE/TIME OF LAST NPI CHANGE (#.01) DATE/TIME OF LAST NPI CHANGE [1D]
- S IBFDA(355.9301,"+1,"_IBIEN_",",.02)=1 ;(#.02) STATUS [2S]
- S IBFDA(355.9301,"+1,"_IBIEN_",",.03)=IBNPI ;(#.03) NPI [3F]
- S IBFDA(355.9301,"+1,"_IBIEN_",",.04)=IBFBDUZ ;(#.04)PERSON AFFECTING LAST CHANGE [4P:200]
- D UPDATE^DIE("","IBFDA","","IBERR")
- I $G(IBERR("DIERR"))'="" S IBQUIT=1
- Q 'IBQUIT
- ;
- CHKTXY(IBIEN,IBPRVTXY) ;LOOKS FOR TAXONOMY CODE AND MAKES ACTIVE OR ADDS
- ;
- ;INPUT : IBIEN - THE IEN OF THE IB NON/OTHER VA BILLING PROVIDER BEING UDPATED
- ; IBPRVTXY - THE TAXONOMY CODE PROVIDED BY FEE BASIS THAT IS BEING LOOKED FOR
- ;
- ; RETURNS:
- ; '0' FOR NO TXY UPDATES ATTEMPTED;
- ; '1' FOR TXY CODE NOT FOUND IN 8932.1;
- ; '2' FOR MATCHED PRIMARY,NO UPDATES;
- ; '3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;
- ; '4' FOR NEW, IB TXY ENTRY CREATED;
- ;
- N IBDONE,IBERR,IBTXYIEN,IBRETRN,IBACTIV,IBTXYCOD,IBOK
- ;
- ;GET THE INTERNAL VALUE OF THIS TAXONOMY CODE
- S IBTXYIEN=$$FIND1^DIC(8932.1,"","X",IBPRVTXY,"G","","IBERR") ;8932.1 PERSON CLASS FILE
- I (IBTXYIEN>0) D
- .S IBDONE=0
- .S IBPRIM=0
- .S IBTXY=0
- .F S IBTXY=$O(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY)) Q:(('+IBTXY)!IBDONE) D
- ..S IBTXYCOD=$P(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY,0),U,1)
- ..S IBPRIM=$P(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY,0),U,2)
- ..S IBACTIV=$P(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY,0),U,3)
- ..I IBTXYCOD=IBTXYIEN D
- ...S IBDONE=1
- ...S IBRETRN=2 ;'2' FOR MATCHED PRIMARY,NO UPDATES;
- ...I IBPRIM'=1 D
- ....S IBFDA(355.9342,IBTXY_","_IBIEN_",",".02")=1 ;355.9342 IB NON/OTHER VA BILLING PROVIDER FILE :TAXONOMY
- ....S IBFDA(355.9342,IBTXY_","_IBIEN_",",".03")="A"
- ....S IBRETRN=3 ;'3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;
- ....D FILE^DIE("","IBFDA","IBERR")
- .I 'IBDONE D
- ..S IBOK=$$ADDTXY(IBIEN,IBPRVTXY,1)
- ..S:IBOK IBRETRN=4 ; '4' FOR NEW IB TXY ENTRY CREATED
- ..S:'IBOK IBRETRN=0 ;'0' FOR NO UPDATES ATTEMPTED
- I (IBTXYIEN<=0) S IBRETRN=1 ;THIS CODE IS NOT A POINTER TO THE PERSON CLASS FILE - CAN'T ADD
- Q IBRETRN
- ;
- ADDTXY(IBIEN,IBTXY,IBPRIM) ;ADD TAXONOMY multiple entry
- ; INPUTS : IBIEN: IEN OF THE IB NON/OTHER VA PROVIDER FILE being updated with NPI information
- ; IBTXY : TAXONOMY STRING TO BE ADDED if it passes validation rules
- ; IBPRIM : 1 IF THIS IS TO BE ADDED AS PRIMARY CODE, 0 OTHERWISE
- ;
- ; RETURNS: 0 IF NO UDPATES WERE MADE TO TAXONOMY FILE
- ; 1 IF NEW TAXONOMY CODE WAS ADDED
- ;
- N IBFDA,IBFDAVAL,IBIENRET,IBERR,IBQUIT,IBOK
- ;
- S IBQUIT=0
- S IBFDA(355.9342,"?+1,"_IBIEN_",",.01)=IBTXY ;355.9342 ;IB NON/OTHER VA BILLING PROVIDER FILE :TAXONOMY
- S IBFDA(355.9342,"?+1,"_IBIEN_",",.02)=IBPRIM
- S IBFDA(355.9342,"?+1,"_IBIEN_",",.03)="A"
- D VALS^DIE("","IBFDA","IBFDAVAL","IBERR")
- I $G(IBERR("DIERR"))'="" S IBQUIT=1
- I 'IBQUIT D
- .D UPDATE^DIE("","IBFDAVAL","IBIENRET","IBERR")
- .I $G(IBERR("DIERR"))="" D
- ..S:$G(IBIENRET(1))'="" IBOK=IBIENRET(1) ;THE IEN WHICH WAS JUST ADDED
- ..S:'+IBOK IBQUIT=1
- .I $G(IBERR("DIERR"))'="" S IBQUIT=1
- Q 'IBQUIT
- ;
- ACTVNPI(IBNPI) ;RETURNS ien of ACTIVE NPI IN IB NON/OTHER VA BILLING PROVIDER FILE
- ;INPUT IBNPI : The NPI from FB provider under consideration
- N IBIEN,IBSUB
- S IBIEN=$O(^IBA(355.93,"NPIHISTORY",IBNPI,""),-1) ;Most recent IEN for this NPI
- I $G(IBIEN)'="" D
- .S IBSUB=$O(^IBA(355.93,IBIEN,"NPISTATUS","C",IBNPI,""),-1) ;MOST recent status for this IEN for this NPI
- .S:IBSUB="" IBIEN=""
- .Q:IBIEN=""
- .S:'$D(^IBA(355.93,IBIEN,"NPISTATUS","NPISTATUS",1,IBSUB)) IBIEN=""
- Q IBIEN
- ;
- INACTV(IBNPI) ;RETURNS ien of INACTIVE NPI IN IB NON/OTHER VA BILLING PROVIDER FILE
- ;INPUT IBNPI : The NPI from FB provider under consideration
- N IBIEN,IBSUB
- S IBIEN=$O(^IBA(355.93,"NPIHISTORY",IBNPI,""),-1)
- I $G(IBIEN)'="" D
- .S IBSUB=$O(^IBA(355.93,IBIEN,"NPISTATUS","C",IBNPI,""),-1) ;MOST recent status for this NPI
- .S:IBSUB="" IBIEN=""
- .Q:IBIEN=""
- .S:'$D(^IBA(355.93,IBIEN,"NPISTATUS","NPISTATUS",0,IBSUB)) IBIEN=""
- Q IBIEN
- ;
- RULES(IBNPI) ;Verify that the NPI meets all rules for being added
- ; see NPIUSED^IBCEP81 where the input transform on the NPI field that is being bypassed is defined
- ; INPUT IBNPI - the NPI about to be added
- ;
- ; OUTPUT 0 if no ACTIVE records found 1 if ACTIVE in NEW PERSON FILE, 2 IF ACVTIVE IN INSTUTUTION FILE
- N IBIEN1,IBIEN2,IBRETURN
- ;
- S IBRETURN=0 ;NOT FOUND IN ANY FILES
- I IBNPI="" S IBRETURN=""
- S:+IBNPI&$D(^VA(200,"ANPI",IBNPI)) IBRETURN=1 ;ACTIVE in the NEW PERSON file
- S:+IBNPI&$D(^DIC(4,"ANPI",IBNPI)) IBRETURN=2 ;ACTIVE in the INSTITUTION file
- Q IBRETURN
- ;
- FBALLOW(IBIEN) ;Returns 1 if FB updates are allowed
- ; INPUT : IBIEN - The internal entry number to the IB NON/OTHER VA BILLING PROVIDER FILE
- ;
- N IBRETURN,IBSUB,IBERR
- ;
- S IBSUB=9999999
- S IBRETURN=1 ;ALLOW updates if no entry has been made
- I $O(^IBA(355.93,IBIEN,2))=3 D
- .S IBSUB=$O(^IBA(355.93,IBIEN,3,IBSUB),-1) ;get the most recent sub-entry
- .S IBRETURN=$$GET1^DIQ(355.9351,IBSUB_","_IBIEN_",",".02","I","","")
- .I IBRETURN'=0 S IBRETURN=1
- Q IBRETURN
- ;
- STRIP(FBPRVNAM) ; Strip off leading and trailing spaces
- ;
- N IBPRVNAM
- ;
- S IBPRVNAM=FBPRVNAM
- F Q:$E(IBPRVNAM)'=" " S IBPRVNAM=$E(IBPRVNAM,2,$L(IBPRVNAM))
- F Q:$E(IBPRVNAM,$L(IBPRVNAM))'=" " S IBPRVNAM=$E(FBPRVNAM,1,$L(IBPRVNAM)-1)
- Q IBPRVNAM
- ;
- SETIBFDA(IBRTRN,IBFBINF,IBFDA,IBIEN) ;Populates IBFDA ARRAY with update information
- ; INPUT : IBRTRN - an array with current IB information in it
- ; IBFBINF - an array with information from FB in it
- ; IBFDA - the array which will be used to update the record
- ; IBIEN - the IEN of the IB record being updated
- ;
- ; OUTPUT : POPULATED IBFDA ARRAY IF UPDATES ARE NEEDED
- I IBFBINF("IB TYPE")=1 D
- .I IBRTRN(355.93,IBIEN_",",".01","I")=IBPRVNAM D
- ..I IBRTRN(355.93,IBIEN_",",".05","I")'=$G(IBFBINF("FBADD1")) S IBFDA(355.93,IBIEN_",",.05)=IBFBINF("FBADD1")
- ..I IBRTRN(355.93,IBIEN_",",".1","I")'=$G(IBFBINF("FBADD2")) S IBFDA(355.93,IBIEN_",",.1)=IBFBINF("FBADD2")
- ..I IBRTRN(355.93,IBIEN_",",".06","I")'=$G(IBFBINF("FBCITY")) S IBFDA(355.93,IBIEN_",",.06)=IBFBINF("FBCITY")
- ..I IBRTRN(355.93,IBIEN_",",".07","I")'=$G(IBFBINF("FBSTATE INT")) S IBFDA(355.93,IBIEN_",",.07)=IBFBINF("FBSTATE INT")
- ..I IBRTRN(355.93,IBIEN_",",".08","I")'=$G(IBFBINF("FBZIP")) S IBFDA(355.93,IBIEN_",",.08)=IBFBINF("FBZIP")
- ..I IBRTRN(355.93,IBIEN_",",".09","I")'=$G(IBFBINF("FBFACID")) S IBFDA(355.93,IBIEN_",",.09)=IBFBINF("FBFACID")
- .I (IBRTRN(355.93,IBIEN_",",".01","I")'=IBPRVNAM) D
- ..; When the name changes, everything is wiped out, so needs to be saved again
- ..S IBFDA(355.93,IBIEN_",",.01)=IBPRVNAM
- ..I $G(IBFBINF("FBADD1"))'="" S IBFDA(355.93,IBIEN_",",.05)=IBFBINF("FBADD1")
- ..I $G(IBFBINF("FBADD2"))'="" S IBFDA(355.93,IBIEN_",",.1)=IBFBINF("FBADD2")
- ..I $G(IBFBINF("FBCITY"))'="" S IBFDA(355.93,IBIEN_",",.06)=IBFBINF("FBCITY")
- ..I $G(IBFBINF("FBSTATE"))'="" S IBFDA(355.93,IBIEN_",",.07)=IBFBINF("FBSTATE INT")
- ..I $G(IBFBINF("FBZIP"))'="" S IBFDA(355.93,IBIEN_",",.08)=IBFBINF("FBZIP")
- ..I $G(IBFBINF("FBFACID"))'="" S IBFDA(355.93,IBIEN_",",.09)=IBFBINF("FBFACID")
- I IBFBINF("IB TYPE")=2 D
- .I (IBRTRN(355.93,IBIEN_",",".01","I")'=IBPRVNAM) S IBFDA(355.93,IBIEN_",",.01)=IBPRVNAM
- Q
- ;
- LOCK(IBIEN) ;Locks the #355.93 file or a record in it
- ; INPUT : IBIEN - the ien of the record to be locked NULL if a new record is being added
- N IBLOCK
- ;
- S IBLOCK=1
- I $G(IBIEN)="" D
- .L +^IBA(355.93):3
- .I '$T S IBLOCK=0
- I $G(IBIEN)'="" D
- .L +^IBA(355.93,IBIEN):3
- .I '$T S IBLOCK=0
- Q IBLOCK
- ;
- UNLOCK(IBIEN) ; Unlocks the #355.93 file or a record in it
- ; INPUT : IBIEN - the ien of the record to be unlocked or NULL if a new record was added
- I $G(IBIEN)="" L -^IBA(355.93)
- I $G(IBIEN)'="" L -^IBA(355.93,IBIEN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP8C 15970 printed Feb 18, 2025@23:38:16 Page 2
- IBCEP8C ;DSS/SCR - Functions for IB SILENT INTERFACE FROM FB ;03-27-12
- +1 ;;2.0;INTEGRATED BILLING;**476**;21-MAR-94;Build 2
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; This routine contains functions needed by the FB PAID TO IB OPTION to maintain
- +5 ; the 355.93 - IB VA NON/OTHER BILLING PROVIDER file
- +6 ;
- EPTRANS() ;EP called from INPUT TRANSFORM IN THE .01 FIELD
- +1 ; of 355.93 VA NON/OTHER BILLING PROVIDER file
- +2 ;
- +3 ;Used only by the IB AUTOMATIC INTERFACE FROM FB to ADD a new entry or UPDATE an existing one
- +4 ;
- +5 if IBPRVTYP=1
- SET IBTYPE="F"
- +6 if IBPRVTYP=2
- SET IBTYPE="I"
- +7 ;USED BY THE NPI input transform to transfer code to interface and avoid user interaction
- SET IBFBFLAG=1
- +8 ;
- +9 QUIT
- EPFBAPI(IBSRCREC,IBRETARY) ;EP from FBTOIB^FBPAID3A
- +1 ; INPUTS : IBSRCREC - an array of information about this source record supplied by FB side
- +2 ;
- +3 ; OUTPUT : IBRETARY (passed by reference) populated with information about results of interface processing
- +4 ;
- +5 ;TO IB NON/OTHER VA BILLING PROVIDER FILE 355.93
- +6 NEW IBRET
- +7 ;
- +8 ;UPDATES THE IB NON/OTHER VA BILLING PROVIDER FILE
- SET IBRET=$$IBNONVA(.IBSRCREC)
- +9 ;The IEN of the IB record matched or created or NULL if neither
- SET IBRETARY(1)=$PIECE(IBRET,U,1)
- +10 ;A code from below indicating how NPI validation and record updates went
- SET IBRETARY(2)=$PIECE(IBRET,U,2)
- +11 ; '0' FOR NO NPI UPDATES ATTEMPTED;'1' FOR NPI DATA INVALID;'2' FOR NPI MATCHED ACTIVE, NO UPDATES;
- +12 ; '3' FOR NPI MATCHED INACTIVE, NO UPDATES;'4' FOR NPI MATCHED ACTIVE, IB UPDATED; '5' FOR NPI NEW, IB RECORD CREATED;
- +13 ;A code from below indicating how TXY updates went
- SET IBRETARY(3)=$PIECE(IBRET,U,3)
- +14 ; '0' FOR NO TXY UPDATES ATTEMPTED;'1' FOR TXY CODE NOT FOUND IN 8932.1; '2' FOR MATCHED PRIMARY,NO UPDATES;
- +15 ;'3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;'4' FOR NEW, IB TXY ENTRY CREATED;
- +16 QUIT
- +17 ;
- IBNONVA(IBFBINF) ;UPDATES TO #355.93
- +1 ; INPUTS IBFBINF : AN ARRAY OF INFORMATION FROM FB TO BE COMPARED/UPDATED IN IB NON/OTHER
- +2 ;
- +3 ; LOOK UP BY NPI - should only be one match per provider type
- +4 ;
- +5 NEW IBQUIT,IBRTRN,IBDONE,IBFLGS,IBFLDS,IBIEN,IBSCRN,IBINDX,IBERR2,IBLKUP,IBOKTXY,IBOKNPI
- +6 NEW IBERR,IBFBMLT,IBNPICHK,IBFDA,IBALLOW,IBOKFB,IBOK,IBPRVNPI,IBPRVTYP
- +7 ;
- +8 SET IBQUIT=0
- +9 SET IBDONE=0
- +10 SET IBOKTXY=""
- +11 SET IBOKNPI=""
- +12 SET IBPRVTYP=IBFBINF("IB TYPE")
- +13 SET IBPRVNPI=IBFBINF("FBNPI")
- +14 SET IBPRVNAM=IBFBINF("NAME")
- +15 SET IBPRVTXY=IBFBINF("FBTXY")
- +16 SET IBFBDUZ=IBFBINF("FB SUP DUZ")
- +17 ;
- +18 IF IBPRVNPI'=""
- Begin DoDot:1
- +19 NEW DO,X,%,%H,%I,X,IBNOW,DD,Y
- +20 DO NOW^%DTC
- +21 SET IBNOW=%
- +22 SET IBPRVNAM=$$STRIP(IBPRVNAM)
- +23 SET IBPRVNAM=$$UP^XLFSTR(IBPRVNAM)
- +24 ;returns IEN of record with this NPI as 'active'
- SET IBIEN=$$ACTVNPI(IBPRVNPI)
- +25 IF IBIEN>0
- Begin DoDot:2
- +26 ;FB MULTIPLE NOT YET UPDATED
- SET IBFBMLT=0
- +27 ;MATCHED ACTIVE NO UPDATES...will get changed if updates are made
- SET IBOKNPI=2
- +28 ;NO TXY UPDATES ATTEMPTED
- SET IBOKTXY=0
- +29 ;(#.01) NAME [1F] ; (#.02) PROVIDER TYPE [2S](#.05) STREETADDRESS [5F] ; (#.06) CITY [6F];
- +30 ;(#.07) STATE [7P:5] ^(#.08) ZIP CODE [8F] ; (#.09) FACILITY DEFAULT ID NUMBER[9F] ^(#.1) STREET ADDRESS LINE 2 [10F] ;
- +31 ;(#.13)PRIMARY ID QUALIFIER [13P:355.97];(#41.01) NPI [14F]
- +32 SET IBFLDS=".01;.02;.05;.06;.07;.08;.09;.1;.13;41.01"
- +33 ; 355.93 IB NON/OTHER VA BILLING PROVIDER FILE
- DO GETS^DIQ(355.93,IBIEN_",",IBFLDS,"I","IBRTRN","IBERR")
- +34 IF $GET(IBERR("DIERR"))
- SET IBQUIT=1
- +35 if IBQUIT
- QUIT
- +36 ;FIND OUT IF THIS PROVIDER SHOULD BE EDITED OR NOT
- SET IBALLOW=$$FBALLOW(IBIEN)
- +37 if IBALLOW=0
- QUIT
- +38 IF IBRTRN(355.93,IBIEN_",",".02","I")=IBPRVTYP
- DO SETIBFDA(.IBRTRN,.IBFBINF,.IBFDA,IBIEN)
- +39 ;locks the #355.93 record
- SET IBOK=$$LOCK(IBIEN)
- +40 if 'IBOK
- QUIT
- +41 IF $DATA(IBFDA(355.93))
- Begin DoDot:3
- +42 ; MUST be set to pass the .01 input transform defined in PRVFMT^IBCEP8
- SET XQY0="FB AUTO INTERFACE TO IB"
- +43 ;needed for input transform
- SET IBFLPFLP=IBPRVTYP
- +44 DO FILE^DIE("","IBFDA","IBERR")
- +45 ;FILE ATTEMPT RETURNED DB ERROR
- IF $GET(IBERR("DIERR"))
- SET IBQUIT=1
- +46 if IBQUIT
- QUIT
- +47 SET IBFBMLT=$$ADDFB(IBIEN,IBFBDUZ,IBNOW,0)
- +48 ; FOR NPI MATCHED ACTIVE, IB UPDATED;
- SET IBOKNPI=4
- End DoDot:3
- +49 ;CHECK TAXONOMY CODE
- +50 IF $GET(IBPRVTXY)'=""
- Begin DoDot:3
- +51 ;RETURNS A CODE FROM SET OF CODES - 0 IF NO CHANGES WERE MADE
- SET IBOKTXY=$$CHKTXY(IBIEN,IBPRVTXY)
- +52 if ('+IBFBMLT)&((IBOKTXY=3)!(IBOKTXY=4))
- SET IBFBMLT=$$ADDFB(IBIEN,IBFBDUZ,IBNOW,0)
- +53 ;add FB mult if not already added for other changes, and the txy was changed
- End DoDot:3
- +54 ;Unlocks the #355.93 record
- DO UNLOCK(IBIEN)
- +55 ;We have found a match on NPI
- SET IBDONE=1
- End DoDot:2
- +56 if IBQUIT
- QUIT
- +57 if IBDONE
- QUIT
- +58 IF IBIEN=""
- Begin DoDot:2
- +59 ;look for match on currently inactive
- SET IBNPICHK=$$INACTV(IBPRVNPI)
- +60 IF IBNPICHK'=""
- Begin DoDot:3
- +61 ;THE IEN OF THE record with this NPI as INACTIVE
- SET IBIEN=IBNPICHK
- +62 ;FOR NPI MATCHED INACTIVE, NO UPDATES;
- SET IBOKNPI=3
- +63 ;NO ATTEMPTED UPDATES
- SET IBOKTXY=0
- +64 SET IBDONE=1
- End DoDot:3
- +65 if IBDONE
- QUIT
- +66 ;RETURN OF 0 means no problem
- SET IBNPICHK=$$RULES(IBPRVNPI)
- +67 IF IBNPICHK>0
- Begin DoDot:3
- +68 ;there is a match on an active NPI in the NEW PERSON or the INSTITUTION file
- +69 ;NPI MATCHED ACTIVE NO UPDATES
- SET IBOKNPI=2
- +70 SET IBOKTXY=0
- +71 SET IBDONE=1
- End DoDot:3
- +72 if IBDONE
- QUIT
- +73 ;all checks have occurred, now we are going to add this PROVIDER/NPI
- +74 ;locks the #355.93 file
- SET IBOK=$$LOCK()
- +75 IF 'IBOK
- QUIT
- +76 NEW DIC,X,Y
- +77 SET DIC="^IBA(355.93,"
- +78 SET X=IBPRVNAM
- +79 SET DIC(0)=""
- +80 SET DIC("DR")=".02///"_IBPRVTYP
- +81 ;ADD FACILITY INFORMATION
- IF IBPRVTYP=1
- Begin DoDot:3
- +82 IF $GET(IBFBINF("FBADD1"))'=""
- SET DIC("DR")=DIC("DR")_";.05///"_IBFBINF("FBADD1")
- +83 IF $GET(IBFBINF("FBADD2"))'=""
- SET DIC("DR")=DIC("DR")_";.1///"_IBFBINF("FBADD2")
- +84 IF $GET(IBFBINF("FBCITY"))'=""
- SET DIC("DR")=DIC("DR")_";.06///"_IBFBINF("FBCITY")
- +85 ;POINTER SO PUT INTO INTERNAL FORMAT
- if $GET(IBFBINF("FBSTATE INT"))
- SET DIC("DR")=DIC("DR")_";.07///`"_IBFBINF("FBSTATE INT")
- +86 if $GET(IBFBINF("FBZIP"))
- SET DIC("DR")=DIC("DR")_";.08///"_IBFBINF("FBZIP")
- +87 IF $GET(IBFBINF("FBFACID"))'=""
- SET DIC("DR")=DIC("DR")_";.09///"_IBFBINF("FBFACID")
- End DoDot:3
- +88 SET DIC("DR")=DIC("DR")_";41.01///"_IBPRVNPI
- +89 ; MUST be set to pass the .01 input transform defined in PRVFMT^IBCEP8
- SET XQY0="FB AUTO INTERFACE TO IB"
- +90 ;needed for successful 'three stuff' validation
- SET IBFLPFLP=IBPRVTYP
- +91 DO FILE^DICN
- +92 SET IBIEN=+Y
- +93 IF IBIEN=-1
- Begin DoDot:3
- +94 SET IBQUIT=1
- +95 DO UNLOCK()
- End DoDot:3
- +96 if IBQUIT
- QUIT
- +97 SET IBOKFB=$$ADDFB(IBIEN,IBFBDUZ,IBNOW,1)
- +98 ;returns 1 or 0
- SET IBOKNPI=$$ADDNPI(IBIEN,IBPRVNPI,IBFBDUZ,IBNOW)
- +99 ;NPI NEW, IB RECORD CREATED
- if IBOKNPI=1
- SET IBOKNPI=5
- +100 IF $GET(IBPRVTXY)'=""
- Begin DoDot:3
- +101 SET IBOK=$$ADDTXY(IBIEN,IBPRVTXY,1)
- +102 ;FOR NEW TXY ENTRY CREATED
- if IBOK
- SET IBOKTXY=4
- +103 ;NO TXY UPDATES ATTEMPTED
- if 'IBOK
- SET IBOKTXY=0
- End DoDot:3
- +104 ;unlocks the #355.93 file or a record
- DO UNLOCK()
- End DoDot:2
- End DoDot:1
- +105 ;NO TXY UPDATES ATTEMPTED
- if $GET(IBPRVTXY)=""
- SET IBOKTXY=0
- +106 ;NO NPI UPDATES ATTEMPTED
- if $GET(IBPRVNPI)=""
- SET IBOKNPI=0
- +107 IF IBQUIT
- SET IBIEN=""
- +108 QUIT IBIEN_"^"_IBOKNPI_"^"_IBOKTXY
- +109 ;
- ADDFB(IBIEN,IBFBDUZ,IBNOW,IBFBADD) ;ADD a multiple entry
- +1 ; INPUTS : IBIEN: IEN OF THE IB NON/OTHER VA PROVIDER FILE being updated with NPI information
- +2 ; IBFBDUZ : IEN of the FB SUPERVISOR who certified the batch
- +3 ; IBNOW : FM Date/time
- +4 ; IBFBADD : 1 if FB is just created the record 0 if not
- +5 ;
- +6 NEW IBFDA,IBIENRET,IBERR
- +7 ;
- +8 SET IBQUIT=0
- +9 ;(#.01) DATE/TIME LAST FB UPDATE [1D]
- SET IBFDA(355.935,"+1,"_IBIEN_",",.01)=IBNOW
- +10 ;(#.02) DUZ OFFB SUP [2P:200]
- SET IBFDA(355.935,"+1,"_IBIEN_",",.02)=IBFBDUZ
- +11 ;(#.03) CREATED BY FB PAID TO IB[3S]
- if IBFBADD
- SET IBFDA(355.935,"+1,"_IBIEN_",",.03)=IBFBADD
- +12 DO UPDATE^DIE("","IBFDA","IBIENRET","IBERR")
- +13 IF $GET(IBERR("DIERR"))'=""
- SET IBQUIT=1
- +14 QUIT 'IBQUIT
- +15 ;
- ADDNPI(IBIEN,IBNPI,IBFBDUZ,IBNOW) ;ADD NPI multiple
- +1 ; INPUTS : IBIEN: IEN OF THE IB NON/OTHER VA PROVIDER FILE being updated with NPI information
- +2 ; IBNPI : NPI STRING TO BE ADDED if it passes validation rules (we already know this
- +3 ; npi does not exist as an 'active' npi for a current entry in this file
- +4 ;
- +5 NEW IBFDA,IBERR,IBQUIT
- +6 ;
- +7 SET IBQUIT=0
- +8 ;355.9301 ;(#40) DATE/TIME OF LAST NPI CHANGE (#.01) DATE/TIME OF LAST NPI CHANGE [1D]
- SET IBFDA(355.9301,"+1,"_IBIEN_",",.01)=IBNOW
- +9 ;(#.02) STATUS [2S]
- SET IBFDA(355.9301,"+1,"_IBIEN_",",.02)=1
- +10 ;(#.03) NPI [3F]
- SET IBFDA(355.9301,"+1,"_IBIEN_",",.03)=IBNPI
- +11 ;(#.04)PERSON AFFECTING LAST CHANGE [4P:200]
- SET IBFDA(355.9301,"+1,"_IBIEN_",",.04)=IBFBDUZ
- +12 DO UPDATE^DIE("","IBFDA","","IBERR")
- +13 IF $GET(IBERR("DIERR"))'=""
- SET IBQUIT=1
- +14 QUIT 'IBQUIT
- +15 ;
- CHKTXY(IBIEN,IBPRVTXY) ;LOOKS FOR TAXONOMY CODE AND MAKES ACTIVE OR ADDS
- +1 ;
- +2 ;INPUT : IBIEN - THE IEN OF THE IB NON/OTHER VA BILLING PROVIDER BEING UDPATED
- +3 ; IBPRVTXY - THE TAXONOMY CODE PROVIDED BY FEE BASIS THAT IS BEING LOOKED FOR
- +4 ;
- +5 ; RETURNS:
- +6 ; '0' FOR NO TXY UPDATES ATTEMPTED;
- +7 ; '1' FOR TXY CODE NOT FOUND IN 8932.1;
- +8 ; '2' FOR MATCHED PRIMARY,NO UPDATES;
- +9 ; '3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;
- +10 ; '4' FOR NEW, IB TXY ENTRY CREATED;
- +11 ;
- +12 NEW IBDONE,IBERR,IBTXYIEN,IBRETRN,IBACTIV,IBTXYCOD,IBOK
- +13 ;
- +14 ;GET THE INTERNAL VALUE OF THIS TAXONOMY CODE
- +15 ;8932.1 PERSON CLASS FILE
- SET IBTXYIEN=$$FIND1^DIC(8932.1,"","X",IBPRVTXY,"G","","IBERR")
- +16 IF (IBTXYIEN>0)
- Begin DoDot:1
- +17 SET IBDONE=0
- +18 SET IBPRIM=0
- +19 SET IBTXY=0
- +20 FOR
- SET IBTXY=$ORDER(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY))
- if (('+IBTXY)!IBDONE)
- QUIT
- Begin DoDot:2
- +21 SET IBTXYCOD=$PIECE(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY,0),U,1)
- +22 SET IBPRIM=$PIECE(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY,0),U,2)
- +23 SET IBACTIV=$PIECE(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY,0),U,3)
- +24 IF IBTXYCOD=IBTXYIEN
- Begin DoDot:3
- +25 SET IBDONE=1
- +26 ;'2' FOR MATCHED PRIMARY,NO UPDATES;
- SET IBRETRN=2
- +27 IF IBPRIM'=1
- Begin DoDot:4
- +28 ;355.9342 IB NON/OTHER VA BILLING PROVIDER FILE :TAXONOMY
- SET IBFDA(355.9342,IBTXY_","_IBIEN_",",".02")=1
- +29 SET IBFDA(355.9342,IBTXY_","_IBIEN_",",".03")="A"
- +30 ;'3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;
- SET IBRETRN=3
- +31 DO FILE^DIE("","IBFDA","IBERR")
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +32 IF 'IBDONE
- Begin DoDot:2
- +33 SET IBOK=$$ADDTXY(IBIEN,IBPRVTXY,1)
- +34 ; '4' FOR NEW IB TXY ENTRY CREATED
- if IBOK
- SET IBRETRN=4
- +35 ;'0' FOR NO UPDATES ATTEMPTED
- if 'IBOK
- SET IBRETRN=0
- End DoDot:2
- End DoDot:1
- +36 ;THIS CODE IS NOT A POINTER TO THE PERSON CLASS FILE - CAN'T ADD
- IF (IBTXYIEN<=0)
- SET IBRETRN=1
- +37 QUIT IBRETRN
- +38 ;
- ADDTXY(IBIEN,IBTXY,IBPRIM) ;ADD TAXONOMY multiple entry
- +1 ; INPUTS : IBIEN: IEN OF THE IB NON/OTHER VA PROVIDER FILE being updated with NPI information
- +2 ; IBTXY : TAXONOMY STRING TO BE ADDED if it passes validation rules
- +3 ; IBPRIM : 1 IF THIS IS TO BE ADDED AS PRIMARY CODE, 0 OTHERWISE
- +4 ;
- +5 ; RETURNS: 0 IF NO UDPATES WERE MADE TO TAXONOMY FILE
- +6 ; 1 IF NEW TAXONOMY CODE WAS ADDED
- +7 ;
- +8 NEW IBFDA,IBFDAVAL,IBIENRET,IBERR,IBQUIT,IBOK
- +9 ;
- +10 SET IBQUIT=0
- +11 ;355.9342 ;IB NON/OTHER VA BILLING PROVIDER FILE :TAXONOMY
- SET IBFDA(355.9342,"?+1,"_IBIEN_",",.01)=IBTXY
- +12 SET IBFDA(355.9342,"?+1,"_IBIEN_",",.02)=IBPRIM
- +13 SET IBFDA(355.9342,"?+1,"_IBIEN_",",.03)="A"
- +14 DO VALS^DIE("","IBFDA","IBFDAVAL","IBERR")
- +15 IF $GET(IBERR("DIERR"))'=""
- SET IBQUIT=1
- +16 IF 'IBQUIT
- Begin DoDot:1
- +17 DO UPDATE^DIE("","IBFDAVAL","IBIENRET","IBERR")
- +18 IF $GET(IBERR("DIERR"))=""
- Begin DoDot:2
- +19 ;THE IEN WHICH WAS JUST ADDED
- if $GET(IBIENRET(1))'=""
- SET IBOK=IBIENRET(1)
- +20 if '+IBOK
- SET IBQUIT=1
- End DoDot:2
- +21 IF $GET(IBERR("DIERR"))'=""
- SET IBQUIT=1
- End DoDot:1
- +22 QUIT 'IBQUIT
- +23 ;
- ACTVNPI(IBNPI) ;RETURNS ien of ACTIVE NPI IN IB NON/OTHER VA BILLING PROVIDER FILE
- +1 ;INPUT IBNPI : The NPI from FB provider under consideration
- +2 NEW IBIEN,IBSUB
- +3 ;Most recent IEN for this NPI
- SET IBIEN=$ORDER(^IBA(355.93,"NPIHISTORY",IBNPI,""),-1)
- +4 IF $GET(IBIEN)'=""
- Begin DoDot:1
- +5 ;MOST recent status for this IEN for this NPI
- SET IBSUB=$ORDER(^IBA(355.93,IBIEN,"NPISTATUS","C",IBNPI,""),-1)
- +6 if IBSUB=""
- SET IBIEN=""
- +7 if IBIEN=""
- QUIT
- +8 if '$DATA(^IBA(355.93,IBIEN,"NPISTATUS","NPISTATUS",1,IBSUB))
- SET IBIEN=""
- End DoDot:1
- +9 QUIT IBIEN
- +10 ;
- INACTV(IBNPI) ;RETURNS ien of INACTIVE NPI IN IB NON/OTHER VA BILLING PROVIDER FILE
- +1 ;INPUT IBNPI : The NPI from FB provider under consideration
- +2 NEW IBIEN,IBSUB
- +3 SET IBIEN=$ORDER(^IBA(355.93,"NPIHISTORY",IBNPI,""),-1)
- +4 IF $GET(IBIEN)'=""
- Begin DoDot:1
- +5 ;MOST recent status for this NPI
- SET IBSUB=$ORDER(^IBA(355.93,IBIEN,"NPISTATUS","C",IBNPI,""),-1)
- +6 if IBSUB=""
- SET IBIEN=""
- +7 if IBIEN=""
- QUIT
- +8 if '$DATA(^IBA(355.93,IBIEN,"NPISTATUS","NPISTATUS",0,IBSUB))
- SET IBIEN=""
- End DoDot:1
- +9 QUIT IBIEN
- +10 ;
- RULES(IBNPI) ;Verify that the NPI meets all rules for being added
- +1 ; see NPIUSED^IBCEP81 where the input transform on the NPI field that is being bypassed is defined
- +2 ; INPUT IBNPI - the NPI about to be added
- +3 ;
- +4 ; OUTPUT 0 if no ACTIVE records found 1 if ACTIVE in NEW PERSON FILE, 2 IF ACVTIVE IN INSTUTUTION FILE
- +5 NEW IBIEN1,IBIEN2,IBRETURN
- +6 ;
- +7 ;NOT FOUND IN ANY FILES
- SET IBRETURN=0
- +8 IF IBNPI=""
- SET IBRETURN=""
- +9 ;ACTIVE in the NEW PERSON file
- if +IBNPI&$DATA(^VA(200,"ANPI",IBNPI))
- SET IBRETURN=1
- +10 ;ACTIVE in the INSTITUTION file
- if +IBNPI&$DATA(^DIC(4,"ANPI",IBNPI))
- SET IBRETURN=2
- +11 QUIT IBRETURN
- +12 ;
- FBALLOW(IBIEN) ;Returns 1 if FB updates are allowed
- +1 ; INPUT : IBIEN - The internal entry number to the IB NON/OTHER VA BILLING PROVIDER FILE
- +2 ;
- +3 NEW IBRETURN,IBSUB,IBERR
- +4 ;
- +5 SET IBSUB=9999999
- +6 ;ALLOW updates if no entry has been made
- SET IBRETURN=1
- +7 IF $ORDER(^IBA(355.93,IBIEN,2))=3
- Begin DoDot:1
- +8 ;get the most recent sub-entry
- SET IBSUB=$ORDER(^IBA(355.93,IBIEN,3,IBSUB),-1)
- +9 SET IBRETURN=$$GET1^DIQ(355.9351,IBSUB_","_IBIEN_",",".02","I","","")
- +10 IF IBRETURN'=0
- SET IBRETURN=1
- End DoDot:1
- +11 QUIT IBRETURN
- +12 ;
- STRIP(FBPRVNAM) ; Strip off leading and trailing spaces
- +1 ;
- +2 NEW IBPRVNAM
- +3 ;
- +4 SET IBPRVNAM=FBPRVNAM
- +5 FOR
- if $EXTRACT(IBPRVNAM)'=" "
- QUIT
- SET IBPRVNAM=$EXTRACT(IBPRVNAM,2,$LENGTH(IBPRVNAM))
- +6 FOR
- if $EXTRACT(IBPRVNAM,$LENGTH(IBPRVNAM))'=" "
- QUIT
- SET IBPRVNAM=$EXTRACT(FBPRVNAM,1,$LENGTH(IBPRVNAM)-1)
- +7 QUIT IBPRVNAM
- +8 ;
- SETIBFDA(IBRTRN,IBFBINF,IBFDA,IBIEN) ;Populates IBFDA ARRAY with update information
- +1 ; INPUT : IBRTRN - an array with current IB information in it
- +2 ; IBFBINF - an array with information from FB in it
- +3 ; IBFDA - the array which will be used to update the record
- +4 ; IBIEN - the IEN of the IB record being updated
- +5 ;
- +6 ; OUTPUT : POPULATED IBFDA ARRAY IF UPDATES ARE NEEDED
- +7 IF IBFBINF("IB TYPE")=1
- Begin DoDot:1
- +8 IF IBRTRN(355.93,IBIEN_",",".01","I")=IBPRVNAM
- Begin DoDot:2
- +9 IF IBRTRN(355.93,IBIEN_",",".05","I")'=$GET(IBFBINF("FBADD1"))
- SET IBFDA(355.93,IBIEN_",",.05)=IBFBINF("FBADD1")
- +10 IF IBRTRN(355.93,IBIEN_",",".1","I")'=$GET(IBFBINF("FBADD2"))
- SET IBFDA(355.93,IBIEN_",",.1)=IBFBINF("FBADD2")
- +11 IF IBRTRN(355.93,IBIEN_",",".06","I")'=$GET(IBFBINF("FBCITY"))
- SET IBFDA(355.93,IBIEN_",",.06)=IBFBINF("FBCITY")
- +12 IF IBRTRN(355.93,IBIEN_",",".07","I")'=$GET(IBFBINF("FBSTATE INT"))
- SET IBFDA(355.93,IBIEN_",",.07)=IBFBINF("FBSTATE INT")
- +13 IF IBRTRN(355.93,IBIEN_",",".08","I")'=$GET(IBFBINF("FBZIP"))
- SET IBFDA(355.93,IBIEN_",",.08)=IBFBINF("FBZIP")
- +14 IF IBRTRN(355.93,IBIEN_",",".09","I")'=$GET(IBFBINF("FBFACID"))
- SET IBFDA(355.93,IBIEN_",",.09)=IBFBINF("FBFACID")
- End DoDot:2
- +15 IF (IBRTRN(355.93,IBIEN_",",".01","I")'=IBPRVNAM)
- Begin DoDot:2
- +16 ; When the name changes, everything is wiped out, so needs to be saved again
- +17 SET IBFDA(355.93,IBIEN_",",.01)=IBPRVNAM
- +18 IF $GET(IBFBINF("FBADD1"))'=""
- SET IBFDA(355.93,IBIEN_",",.05)=IBFBINF("FBADD1")
- +19 IF $GET(IBFBINF("FBADD2"))'=""
- SET IBFDA(355.93,IBIEN_",",.1)=IBFBINF("FBADD2")
- +20 IF $GET(IBFBINF("FBCITY"))'=""
- SET IBFDA(355.93,IBIEN_",",.06)=IBFBINF("FBCITY")
- +21 IF $GET(IBFBINF("FBSTATE"))'=""
- SET IBFDA(355.93,IBIEN_",",.07)=IBFBINF("FBSTATE INT")
- +22 IF $GET(IBFBINF("FBZIP"))'=""
- SET IBFDA(355.93,IBIEN_",",.08)=IBFBINF("FBZIP")
- +23 IF $GET(IBFBINF("FBFACID"))'=""
- SET IBFDA(355.93,IBIEN_",",.09)=IBFBINF("FBFACID")
- End DoDot:2
- End DoDot:1
- +24 IF IBFBINF("IB TYPE")=2
- Begin DoDot:1
- +25 IF (IBRTRN(355.93,IBIEN_",",".01","I")'=IBPRVNAM)
- SET IBFDA(355.93,IBIEN_",",.01)=IBPRVNAM
- End DoDot:1
- +26 QUIT
- +27 ;
- LOCK(IBIEN) ;Locks the #355.93 file or a record in it
- +1 ; INPUT : IBIEN - the ien of the record to be locked NULL if a new record is being added
- +2 NEW IBLOCK
- +3 ;
- +4 SET IBLOCK=1
- +5 IF $GET(IBIEN)=""
- Begin DoDot:1
- +6 LOCK +^IBA(355.93):3
- +7 IF '$TEST
- SET IBLOCK=0
- End DoDot:1
- +8 IF $GET(IBIEN)'=""
- Begin DoDot:1
- +9 LOCK +^IBA(355.93,IBIEN):3
- +10 IF '$TEST
- SET IBLOCK=0
- End DoDot:1
- +11 QUIT IBLOCK
- +12 ;
- UNLOCK(IBIEN) ; Unlocks the #355.93 file or a record in it
- +1 ; INPUT : IBIEN - the ien of the record to be unlocked or NULL if a new record was added
- +2 IF $GET(IBIEN)=""
- LOCK -^IBA(355.93)
- +3 IF $GET(IBIEN)'=""
- LOCK -^IBA(355.93,IBIEN)
- +4 QUIT