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

IBCEP8C.m

Go to the documentation of this file.
  1. IBCEP8C ;DSS/SCR - Functions for IB SILENT INTERFACE FROM FB ;03-27-12
  1. ;;2.0;INTEGRATED BILLING;**476**;21-MAR-94;Build 2
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; This routine contains functions needed by the FB PAID TO IB OPTION to maintain
  1. ; the 355.93 - IB VA NON/OTHER BILLING PROVIDER file
  1. ;
  1. EPTRANS() ;EP called from INPUT TRANSFORM IN THE .01 FIELD
  1. ; of 355.93 VA NON/OTHER BILLING PROVIDER file
  1. ;
  1. ;Used only by the IB AUTOMATIC INTERFACE FROM FB to ADD a new entry or UPDATE an existing one
  1. ;
  1. S:IBPRVTYP=1 IBTYPE="F"
  1. S:IBPRVTYP=2 IBTYPE="I"
  1. S IBFBFLAG=1 ;USED BY THE NPI input transform to transfer code to interface and avoid user interaction
  1. ;
  1. Q
  1. EPFBAPI(IBSRCREC,IBRETARY) ;EP from FBTOIB^FBPAID3A
  1. ; INPUTS : IBSRCREC - an array of information about this source record supplied by FB side
  1. ;
  1. ; OUTPUT : IBRETARY (passed by reference) populated with information about results of interface processing
  1. ;
  1. ;TO IB NON/OTHER VA BILLING PROVIDER FILE 355.93
  1. N IBRET
  1. ;
  1. S IBRET=$$IBNONVA(.IBSRCREC) ;UPDATES THE IB NON/OTHER VA BILLING PROVIDER FILE
  1. S IBRETARY(1)=$P(IBRET,U,1) ;The IEN of the IB record matched or created or NULL if neither
  1. S IBRETARY(2)=$P(IBRET,U,2) ;A code from below indicating how NPI validation and record updates went
  1. ; '0' FOR NO NPI UPDATES ATTEMPTED;'1' FOR NPI DATA INVALID;'2' FOR NPI MATCHED ACTIVE, NO UPDATES;
  1. ; '3' FOR NPI MATCHED INACTIVE, NO UPDATES;'4' FOR NPI MATCHED ACTIVE, IB UPDATED; '5' FOR NPI NEW, IB RECORD CREATED;
  1. S IBRETARY(3)=$P(IBRET,U,3) ;A code from below indicating how TXY updates went
  1. ; '0' FOR NO TXY UPDATES ATTEMPTED;'1' FOR TXY CODE NOT FOUND IN 8932.1; '2' FOR MATCHED PRIMARY,NO UPDATES;
  1. ;'3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;'4' FOR NEW, IB TXY ENTRY CREATED;
  1. Q
  1. ;
  1. IBNONVA(IBFBINF) ;UPDATES TO #355.93
  1. ; INPUTS IBFBINF : AN ARRAY OF INFORMATION FROM FB TO BE COMPARED/UPDATED IN IB NON/OTHER
  1. ;
  1. ; LOOK UP BY NPI - should only be one match per provider type
  1. ;
  1. N IBQUIT,IBRTRN,IBDONE,IBFLGS,IBFLDS,IBIEN,IBSCRN,IBINDX,IBERR2,IBLKUP,IBOKTXY,IBOKNPI
  1. N IBERR,IBFBMLT,IBNPICHK,IBFDA,IBALLOW,IBOKFB,IBOK,IBPRVNPI,IBPRVTYP
  1. ;
  1. S IBQUIT=0
  1. S IBDONE=0
  1. S IBOKTXY=""
  1. S IBOKNPI=""
  1. S IBPRVTYP=IBFBINF("IB TYPE")
  1. S IBPRVNPI=IBFBINF("FBNPI")
  1. S IBPRVNAM=IBFBINF("NAME")
  1. S IBPRVTXY=IBFBINF("FBTXY")
  1. S IBFBDUZ=IBFBINF("FB SUP DUZ")
  1. ;
  1. I IBPRVNPI'="" D
  1. .N DO,X,%,%H,%I,X,IBNOW,DD,Y
  1. .D NOW^%DTC
  1. .S IBNOW=%
  1. .S IBPRVNAM=$$STRIP(IBPRVNAM)
  1. .S IBPRVNAM=$$UP^XLFSTR(IBPRVNAM)
  1. .S IBIEN=$$ACTVNPI(IBPRVNPI) ;returns IEN of record with this NPI as 'active'
  1. .I IBIEN>0 D
  1. ..S IBFBMLT=0 ;FB MULTIPLE NOT YET UPDATED
  1. ..S IBOKNPI=2 ;MATCHED ACTIVE NO UPDATES...will get changed if updates are made
  1. ..S IBOKTXY=0 ;NO TXY UPDATES ATTEMPTED
  1. ..;(#.01) NAME [1F] ; (#.02) PROVIDER TYPE [2S](#.05) STREETADDRESS [5F] ; (#.06) CITY [6F];
  1. ..;(#.07) STATE [7P:5] ^(#.08) ZIP CODE [8F] ; (#.09) FACILITY DEFAULT ID NUMBER[9F] ^(#.1) STREET ADDRESS LINE 2 [10F] ;
  1. ..;(#.13)PRIMARY ID QUALIFIER [13P:355.97];(#41.01) NPI [14F]
  1. ..S IBFLDS=".01;.02;.05;.06;.07;.08;.09;.1;.13;41.01"
  1. ..D GETS^DIQ(355.93,IBIEN_",",IBFLDS,"I","IBRTRN","IBERR") ; 355.93 IB NON/OTHER VA BILLING PROVIDER FILE
  1. ..I $G(IBERR("DIERR")) S IBQUIT=1
  1. ..Q:IBQUIT
  1. ..S IBALLOW=$$FBALLOW(IBIEN) ;FIND OUT IF THIS PROVIDER SHOULD BE EDITED OR NOT
  1. ..Q:IBALLOW=0
  1. ..I IBRTRN(355.93,IBIEN_",",".02","I")=IBPRVTYP D SETIBFDA(.IBRTRN,.IBFBINF,.IBFDA,IBIEN)
  1. ..S IBOK=$$LOCK(IBIEN) ;locks the #355.93 record
  1. ..Q:'IBOK
  1. ..I $D(IBFDA(355.93)) D
  1. ...S XQY0="FB AUTO INTERFACE TO IB" ; MUST be set to pass the .01 input transform defined in PRVFMT^IBCEP8
  1. ...S IBFLPFLP=IBPRVTYP ;needed for input transform
  1. ...D FILE^DIE("","IBFDA","IBERR")
  1. ...I $G(IBERR("DIERR")) S IBQUIT=1 ;FILE ATTEMPT RETURNED DB ERROR
  1. ...Q:IBQUIT
  1. ...S IBFBMLT=$$ADDFB(IBIEN,IBFBDUZ,IBNOW,0)
  1. ...S IBOKNPI=4 ; FOR NPI MATCHED ACTIVE, IB UPDATED;
  1. ..;CHECK TAXONOMY CODE
  1. ..I $G(IBPRVTXY)'="" D
  1. ...S IBOKTXY=$$CHKTXY(IBIEN,IBPRVTXY) ;RETURNS A CODE FROM SET OF CODES - 0 IF NO CHANGES WERE MADE
  1. ...S:('+IBFBMLT)&((IBOKTXY=3)!(IBOKTXY=4)) IBFBMLT=$$ADDFB(IBIEN,IBFBDUZ,IBNOW,0)
  1. ...;add FB mult if not already added for other changes, and the txy was changed
  1. ..D UNLOCK(IBIEN) ;Unlocks the #355.93 record
  1. ..S IBDONE=1 ;We have found a match on NPI
  1. .Q:IBQUIT
  1. .Q:IBDONE
  1. .I IBIEN="" D
  1. ..S IBNPICHK=$$INACTV(IBPRVNPI) ;look for match on currently inactive
  1. ..I IBNPICHK'="" D
  1. ...S IBIEN=IBNPICHK ;THE IEN OF THE record with this NPI as INACTIVE
  1. ...S IBOKNPI=3 ;FOR NPI MATCHED INACTIVE, NO UPDATES;
  1. ...S IBOKTXY=0 ;NO ATTEMPTED UPDATES
  1. ...S IBDONE=1
  1. ..Q:IBDONE
  1. ..S IBNPICHK=$$RULES(IBPRVNPI) ;RETURN OF 0 means no problem
  1. ..I IBNPICHK>0 D
  1. ...;there is a match on an active NPI in the NEW PERSON or the INSTITUTION file
  1. ...S IBOKNPI=2 ;NPI MATCHED ACTIVE NO UPDATES
  1. ...S IBOKTXY=0
  1. ...S IBDONE=1
  1. ..Q:IBDONE
  1. ..;all checks have occurred, now we are going to add this PROVIDER/NPI
  1. ..S IBOK=$$LOCK() ;locks the #355.93 file
  1. ..I 'IBOK Q
  1. ..N DIC,X,Y
  1. ..S DIC="^IBA(355.93,"
  1. ..S X=IBPRVNAM
  1. ..S DIC(0)=""
  1. ..S DIC("DR")=".02///"_IBPRVTYP
  1. ..I IBPRVTYP=1 D ;ADD FACILITY INFORMATION
  1. ...I $G(IBFBINF("FBADD1"))'="" S DIC("DR")=DIC("DR")_";.05///"_IBFBINF("FBADD1")
  1. ...I $G(IBFBINF("FBADD2"))'="" S DIC("DR")=DIC("DR")_";.1///"_IBFBINF("FBADD2")
  1. ...I $G(IBFBINF("FBCITY"))'="" S DIC("DR")=DIC("DR")_";.06///"_IBFBINF("FBCITY")
  1. ...S:$G(IBFBINF("FBSTATE INT")) DIC("DR")=DIC("DR")_";.07///`"_IBFBINF("FBSTATE INT") ;POINTER SO PUT INTO INTERNAL FORMAT
  1. ...S:$G(IBFBINF("FBZIP")) DIC("DR")=DIC("DR")_";.08///"_IBFBINF("FBZIP")
  1. ...I $G(IBFBINF("FBFACID"))'="" S DIC("DR")=DIC("DR")_";.09///"_IBFBINF("FBFACID")
  1. ..S DIC("DR")=DIC("DR")_";41.01///"_IBPRVNPI
  1. ..S XQY0="FB AUTO INTERFACE TO IB" ; MUST be set to pass the .01 input transform defined in PRVFMT^IBCEP8
  1. ..S IBFLPFLP=IBPRVTYP ;needed for successful 'three stuff' validation
  1. ..D FILE^DICN
  1. ..S IBIEN=+Y
  1. ..I IBIEN=-1 D
  1. ...S IBQUIT=1
  1. ...D UNLOCK()
  1. ..Q:IBQUIT
  1. ..S IBOKFB=$$ADDFB(IBIEN,IBFBDUZ,IBNOW,1)
  1. ..S IBOKNPI=$$ADDNPI(IBIEN,IBPRVNPI,IBFBDUZ,IBNOW) ;returns 1 or 0
  1. ..S:IBOKNPI=1 IBOKNPI=5 ;NPI NEW, IB RECORD CREATED
  1. ..I $G(IBPRVTXY)'="" D
  1. ...S IBOK=$$ADDTXY(IBIEN,IBPRVTXY,1)
  1. ...S:IBOK IBOKTXY=4 ;FOR NEW TXY ENTRY CREATED
  1. ...S:'IBOK IBOKTXY=0 ;NO TXY UPDATES ATTEMPTED
  1. ..D UNLOCK() ;unlocks the #355.93 file or a record
  1. S:$G(IBPRVTXY)="" IBOKTXY=0 ;NO TXY UPDATES ATTEMPTED
  1. S:$G(IBPRVNPI)="" IBOKNPI=0 ;NO NPI UPDATES ATTEMPTED
  1. I IBQUIT S IBIEN=""
  1. Q IBIEN_"^"_IBOKNPI_"^"_IBOKTXY
  1. ;
  1. 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
  1. ; IBFBDUZ : IEN of the FB SUPERVISOR who certified the batch
  1. ; IBNOW : FM Date/time
  1. ; IBFBADD : 1 if FB is just created the record 0 if not
  1. ;
  1. N IBFDA,IBIENRET,IBERR
  1. ;
  1. S IBQUIT=0
  1. S IBFDA(355.935,"+1,"_IBIEN_",",.01)=IBNOW ;(#.01) DATE/TIME LAST FB UPDATE [1D]
  1. S IBFDA(355.935,"+1,"_IBIEN_",",.02)=IBFBDUZ ;(#.02) DUZ OFFB SUP [2P:200]
  1. S:IBFBADD IBFDA(355.935,"+1,"_IBIEN_",",.03)=IBFBADD ;(#.03) CREATED BY FB PAID TO IB[3S]
  1. D UPDATE^DIE("","IBFDA","IBIENRET","IBERR")
  1. I $G(IBERR("DIERR"))'="" S IBQUIT=1
  1. Q 'IBQUIT
  1. ;
  1. 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
  1. ; IBNPI : NPI STRING TO BE ADDED if it passes validation rules (we already know this
  1. ; npi does not exist as an 'active' npi for a current entry in this file
  1. ;
  1. N IBFDA,IBERR,IBQUIT
  1. ;
  1. S IBQUIT=0
  1. 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]
  1. S IBFDA(355.9301,"+1,"_IBIEN_",",.02)=1 ;(#.02) STATUS [2S]
  1. S IBFDA(355.9301,"+1,"_IBIEN_",",.03)=IBNPI ;(#.03) NPI [3F]
  1. S IBFDA(355.9301,"+1,"_IBIEN_",",.04)=IBFBDUZ ;(#.04)PERSON AFFECTING LAST CHANGE [4P:200]
  1. D UPDATE^DIE("","IBFDA","","IBERR")
  1. I $G(IBERR("DIERR"))'="" S IBQUIT=1
  1. Q 'IBQUIT
  1. ;
  1. CHKTXY(IBIEN,IBPRVTXY) ;LOOKS FOR TAXONOMY CODE AND MAKES ACTIVE OR ADDS
  1. ;
  1. ;INPUT : IBIEN - THE IEN OF THE IB NON/OTHER VA BILLING PROVIDER BEING UDPATED
  1. ; IBPRVTXY - THE TAXONOMY CODE PROVIDED BY FEE BASIS THAT IS BEING LOOKED FOR
  1. ;
  1. ; RETURNS:
  1. ; '0' FOR NO TXY UPDATES ATTEMPTED;
  1. ; '1' FOR TXY CODE NOT FOUND IN 8932.1;
  1. ; '2' FOR MATCHED PRIMARY,NO UPDATES;
  1. ; '3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;
  1. ; '4' FOR NEW, IB TXY ENTRY CREATED;
  1. ;
  1. N IBDONE,IBERR,IBTXYIEN,IBRETRN,IBACTIV,IBTXYCOD,IBOK
  1. ;
  1. ;GET THE INTERNAL VALUE OF THIS TAXONOMY CODE
  1. S IBTXYIEN=$$FIND1^DIC(8932.1,"","X",IBPRVTXY,"G","","IBERR") ;8932.1 PERSON CLASS FILE
  1. I (IBTXYIEN>0) D
  1. .S IBDONE=0
  1. .S IBPRIM=0
  1. .S IBTXY=0
  1. .F S IBTXY=$O(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY)) Q:(('+IBTXY)!IBDONE) D
  1. ..S IBTXYCOD=$P(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY,0),U,1)
  1. ..S IBPRIM=$P(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY,0),U,2)
  1. ..S IBACTIV=$P(^IBA(355.93,IBIEN,"TAXONOMY",IBTXY,0),U,3)
  1. ..I IBTXYCOD=IBTXYIEN D
  1. ...S IBDONE=1
  1. ...S IBRETRN=2 ;'2' FOR MATCHED PRIMARY,NO UPDATES;
  1. ...I IBPRIM'=1 D
  1. ....S IBFDA(355.9342,IBTXY_","_IBIEN_",",".02")=1 ;355.9342 IB NON/OTHER VA BILLING PROVIDER FILE :TAXONOMY
  1. ....S IBFDA(355.9342,IBTXY_","_IBIEN_",",".03")="A"
  1. ....S IBRETRN=3 ;'3' FOR MATCHED NON-PRIMARY, IB TXY UPDATES;
  1. ....D FILE^DIE("","IBFDA","IBERR")
  1. .I 'IBDONE D
  1. ..S IBOK=$$ADDTXY(IBIEN,IBPRVTXY,1)
  1. ..S:IBOK IBRETRN=4 ; '4' FOR NEW IB TXY ENTRY CREATED
  1. ..S:'IBOK IBRETRN=0 ;'0' FOR NO UPDATES ATTEMPTED
  1. I (IBTXYIEN<=0) S IBRETRN=1 ;THIS CODE IS NOT A POINTER TO THE PERSON CLASS FILE - CAN'T ADD
  1. Q IBRETRN
  1. ;
  1. 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
  1. ; IBTXY : TAXONOMY STRING TO BE ADDED if it passes validation rules
  1. ; IBPRIM : 1 IF THIS IS TO BE ADDED AS PRIMARY CODE, 0 OTHERWISE
  1. ;
  1. ; RETURNS: 0 IF NO UDPATES WERE MADE TO TAXONOMY FILE
  1. ; 1 IF NEW TAXONOMY CODE WAS ADDED
  1. ;
  1. N IBFDA,IBFDAVAL,IBIENRET,IBERR,IBQUIT,IBOK
  1. ;
  1. S IBQUIT=0
  1. S IBFDA(355.9342,"?+1,"_IBIEN_",",.01)=IBTXY ;355.9342 ;IB NON/OTHER VA BILLING PROVIDER FILE :TAXONOMY
  1. S IBFDA(355.9342,"?+1,"_IBIEN_",",.02)=IBPRIM
  1. S IBFDA(355.9342,"?+1,"_IBIEN_",",.03)="A"
  1. D VALS^DIE("","IBFDA","IBFDAVAL","IBERR")
  1. I $G(IBERR("DIERR"))'="" S IBQUIT=1
  1. I 'IBQUIT D
  1. .D UPDATE^DIE("","IBFDAVAL","IBIENRET","IBERR")
  1. .I $G(IBERR("DIERR"))="" D
  1. ..S:$G(IBIENRET(1))'="" IBOK=IBIENRET(1) ;THE IEN WHICH WAS JUST ADDED
  1. ..S:'+IBOK IBQUIT=1
  1. .I $G(IBERR("DIERR"))'="" S IBQUIT=1
  1. Q 'IBQUIT
  1. ;
  1. 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
  1. N IBIEN,IBSUB
  1. S IBIEN=$O(^IBA(355.93,"NPIHISTORY",IBNPI,""),-1) ;Most recent IEN for this NPI
  1. I $G(IBIEN)'="" D
  1. .S IBSUB=$O(^IBA(355.93,IBIEN,"NPISTATUS","C",IBNPI,""),-1) ;MOST recent status for this IEN for this NPI
  1. .S:IBSUB="" IBIEN=""
  1. .Q:IBIEN=""
  1. .S:'$D(^IBA(355.93,IBIEN,"NPISTATUS","NPISTATUS",1,IBSUB)) IBIEN=""
  1. Q IBIEN
  1. ;
  1. 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
  1. N IBIEN,IBSUB
  1. S IBIEN=$O(^IBA(355.93,"NPIHISTORY",IBNPI,""),-1)
  1. I $G(IBIEN)'="" D
  1. .S IBSUB=$O(^IBA(355.93,IBIEN,"NPISTATUS","C",IBNPI,""),-1) ;MOST recent status for this NPI
  1. .S:IBSUB="" IBIEN=""
  1. .Q:IBIEN=""
  1. .S:'$D(^IBA(355.93,IBIEN,"NPISTATUS","NPISTATUS",0,IBSUB)) IBIEN=""
  1. Q IBIEN
  1. ;
  1. 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
  1. ; INPUT IBNPI - the NPI about to be added
  1. ;
  1. ; OUTPUT 0 if no ACTIVE records found 1 if ACTIVE in NEW PERSON FILE, 2 IF ACVTIVE IN INSTUTUTION FILE
  1. N IBIEN1,IBIEN2,IBRETURN
  1. ;
  1. S IBRETURN=0 ;NOT FOUND IN ANY FILES
  1. I IBNPI="" S IBRETURN=""
  1. S:+IBNPI&$D(^VA(200,"ANPI",IBNPI)) IBRETURN=1 ;ACTIVE in the NEW PERSON file
  1. S:+IBNPI&$D(^DIC(4,"ANPI",IBNPI)) IBRETURN=2 ;ACTIVE in the INSTITUTION file
  1. Q IBRETURN
  1. ;
  1. 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
  1. ;
  1. N IBRETURN,IBSUB,IBERR
  1. ;
  1. S IBSUB=9999999
  1. S IBRETURN=1 ;ALLOW updates if no entry has been made
  1. I $O(^IBA(355.93,IBIEN,2))=3 D
  1. .S IBSUB=$O(^IBA(355.93,IBIEN,3,IBSUB),-1) ;get the most recent sub-entry
  1. .S IBRETURN=$$GET1^DIQ(355.9351,IBSUB_","_IBIEN_",",".02","I","","")
  1. .I IBRETURN'=0 S IBRETURN=1
  1. Q IBRETURN
  1. ;
  1. STRIP(FBPRVNAM) ; Strip off leading and trailing spaces
  1. ;
  1. N IBPRVNAM
  1. ;
  1. S IBPRVNAM=FBPRVNAM
  1. F Q:$E(IBPRVNAM)'=" " S IBPRVNAM=$E(IBPRVNAM,2,$L(IBPRVNAM))
  1. F Q:$E(IBPRVNAM,$L(IBPRVNAM))'=" " S IBPRVNAM=$E(FBPRVNAM,1,$L(IBPRVNAM)-1)
  1. Q IBPRVNAM
  1. ;
  1. SETIBFDA(IBRTRN,IBFBINF,IBFDA,IBIEN) ;Populates IBFDA ARRAY with update information
  1. ; INPUT : IBRTRN - an array with current IB information in it
  1. ; IBFBINF - an array with information from FB in it
  1. ; IBFDA - the array which will be used to update the record
  1. ; IBIEN - the IEN of the IB record being updated
  1. ;
  1. ; OUTPUT : POPULATED IBFDA ARRAY IF UPDATES ARE NEEDED
  1. I IBFBINF("IB TYPE")=1 D
  1. .I IBRTRN(355.93,IBIEN_",",".01","I")=IBPRVNAM D
  1. ..I IBRTRN(355.93,IBIEN_",",".05","I")'=$G(IBFBINF("FBADD1")) S IBFDA(355.93,IBIEN_",",.05)=IBFBINF("FBADD1")
  1. ..I IBRTRN(355.93,IBIEN_",",".1","I")'=$G(IBFBINF("FBADD2")) S IBFDA(355.93,IBIEN_",",.1)=IBFBINF("FBADD2")
  1. ..I IBRTRN(355.93,IBIEN_",",".06","I")'=$G(IBFBINF("FBCITY")) S IBFDA(355.93,IBIEN_",",.06)=IBFBINF("FBCITY")
  1. ..I IBRTRN(355.93,IBIEN_",",".07","I")'=$G(IBFBINF("FBSTATE INT")) S IBFDA(355.93,IBIEN_",",.07)=IBFBINF("FBSTATE INT")
  1. ..I IBRTRN(355.93,IBIEN_",",".08","I")'=$G(IBFBINF("FBZIP")) S IBFDA(355.93,IBIEN_",",.08)=IBFBINF("FBZIP")
  1. ..I IBRTRN(355.93,IBIEN_",",".09","I")'=$G(IBFBINF("FBFACID")) S IBFDA(355.93,IBIEN_",",.09)=IBFBINF("FBFACID")
  1. .I (IBRTRN(355.93,IBIEN_",",".01","I")'=IBPRVNAM) D
  1. ..; When the name changes, everything is wiped out, so needs to be saved again
  1. ..S IBFDA(355.93,IBIEN_",",.01)=IBPRVNAM
  1. ..I $G(IBFBINF("FBADD1"))'="" S IBFDA(355.93,IBIEN_",",.05)=IBFBINF("FBADD1")
  1. ..I $G(IBFBINF("FBADD2"))'="" S IBFDA(355.93,IBIEN_",",.1)=IBFBINF("FBADD2")
  1. ..I $G(IBFBINF("FBCITY"))'="" S IBFDA(355.93,IBIEN_",",.06)=IBFBINF("FBCITY")
  1. ..I $G(IBFBINF("FBSTATE"))'="" S IBFDA(355.93,IBIEN_",",.07)=IBFBINF("FBSTATE INT")
  1. ..I $G(IBFBINF("FBZIP"))'="" S IBFDA(355.93,IBIEN_",",.08)=IBFBINF("FBZIP")
  1. ..I $G(IBFBINF("FBFACID"))'="" S IBFDA(355.93,IBIEN_",",.09)=IBFBINF("FBFACID")
  1. I IBFBINF("IB TYPE")=2 D
  1. .I (IBRTRN(355.93,IBIEN_",",".01","I")'=IBPRVNAM) S IBFDA(355.93,IBIEN_",",.01)=IBPRVNAM
  1. Q
  1. ;
  1. 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
  1. N IBLOCK
  1. ;
  1. S IBLOCK=1
  1. I $G(IBIEN)="" D
  1. .L +^IBA(355.93):3
  1. .I '$T S IBLOCK=0
  1. I $G(IBIEN)'="" D
  1. .L +^IBA(355.93,IBIEN):3
  1. .I '$T S IBLOCK=0
  1. Q IBLOCK
  1. ;
  1. 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
  1. I $G(IBIEN)="" L -^IBA(355.93)
  1. I $G(IBIEN)'="" L -^IBA(355.93,IBIEN)
  1. Q