- IBCU7A1 ;ALB/ARH - BILL PROCEDURE MANIPULATIONS (BUNDLED) ; 10-OCT-03
- ;;2.0;INTEGRATED BILLING;**245,270,598**;21-MAR-94;Build 28
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;
- BNDL(IBIFN) ; manipulate a bill's CPT codes, replace bundled codes
- ; on facility and profesional bills global codes should be billed using their components
- ; on freestanding bills component codes should be billed as global
- ; - on facility bill, if a global code is found in the clinical data and on the bill then
- ; replace it on the bill with the institutional components
- ; - on professional bill, if the global code is found in the clinical data and the institutional components
- ; are found on the bill then replace the institutional components with the professional components
- ; - on a freestanding bill if all institutional and professional components are found then
- ; replace them with the global code
- ; maximum of 10 is insurance against infinite loops
- N IB0,IBCT,IBDVTY,IBTYPE,IBI,IBJ,IBLN,IBGLB,IBNLN,IBNEW,IBDEL,IBRPL,IBX,IBMSG,IBCHANGE,IB029,IBMCPT S IBCHANGE=0
- S IB0=$G(^DGCR(399,+$G(IBIFN),0)) Q:IB0=""
- S IBCT=$P(IB0,U,27) Q:'IBCT S IBDVTY=$P($$RCDV^IBCRU8($P(IB0,U,22)),U,3)
- S IBTYPE=$S(IBDVTY=3:3,1:+IBCT)
- ;
- I +$O(^DGCR(399,+$G(IBIFN),"CP","B","94017;ICPT("),-1)<93000 Q ; none of the bundled codes on bill
- ;
- I IBDVTY'=3 D GETSD^IBCU7U(IBIFN) ; for provider based sites global charge should be in clincal data
- ;
- ; loop through list of bundled procedures and find any on bill
- F IBI=1:1 S IBLN=$P($T(IPBI+IBI),";;",2) Q:IBLN="" D
- . S IBGLB=$P(IBLN,":",1),IBCHANGE=0
- .
- . ; *598 procedures split for 0295T
- . S IB029=0
- . I IBGLB="0295T" S IB029=1,IBLN=$$IB029A(IBGLB,IBLN),IBGLB=$P(IBLN,":",1)
- . ;
- . S IBNLN=$$IPB(IBLN,IBTYPE) Q:'IBNLN S IBNEW=$P(IBNLN,":",2),IBDEL=$P(IBNLN,":",1)
- . ;
- . I IBDVTY'=3,'$D(^UTILITY($J,"CPT-CLN",+IBGLB)) Q
- . ;
- . ; search the bill for the list of procedures to be replaced
- . F IBJ=1:1 S IBRPL=$$FND(IBIFN,IBDEL) Q:'IBRPL D Q:IBJ>10
- .. ;
- .. I IBDVTY'=3,'$D(^UTILITY($J,"CPT-CLN",+IBGLB,+IBRPL)) Q
- .. S IBRPL=$P(IBRPL,U,2,999) I $L(IBRPL,U)'=$L(IBDEL,U) Q
- .. ;
- .. I +$$RPL(IBIFN,IBNEW,IBRPL) S IBCHANGE=1 ; replace procedures
- . ;
- . I +IBCHANGE,IB029 S IBDEL=$$IB029C(IBDEL),IBNEW=$$IB029C(IBNEW)
- . I +IBCHANGE S IBMSG(IBI)=$TR(IBDEL,"^",",")_" replaced by "_$TR(IBNEW,"^",",")
- ;
- I '$D(ZTQUEUED),'$G(IBAUTO),+$O(IBMSG(0)) S IBI=0 F S IBI=$O(IBMSG(IBI)) Q:'IBI W !,IBMSG(IBI)
- Q
- ;
- RPL(IBIFN,NEWCPTS,OLDLIST) ; replace procedures on the bill
- ; Input: NEWCPTS - list of CPT codes to add to the bill
- ; OLDLIST - list of procedure ifn's on the bill to be replaced
- ; Output: returns true if changes made
- ; the list of new and replaced may not be the same length
- ; - if more CPT's to be added than exist then the first existing procedure is copied for the new CPT
- ; - if fewer CPT's to be added than exist then the extra entries on the bill are deleted
- N IBJ,IBFFN,IBRFN,IBNCPT,IBFND S IBFND=0
- ;
- S NEWCPTS=$G(NEWCPTS),OLDLIST=$G(OLDLIST),IBFFN=+OLDLIST
- ;
- F IBJ=1:1 S IBRFN=$P(OLDLIST,U,IBJ),IBNCPT=$P(NEWCPTS,U,IBJ) Q:('IBRFN)&('IBNCPT) D Q:'IBFND
- . I +IBRFN,'IBNCPT S IBFND=$$DELCPT^IBCU7U(IBIFN,IBRFN) Q
- . I 'IBRFN,+IBNCPT S IBFND=$$COPYCPT^IBCU7U(IBIFN,IBFFN,IBNCPT) Q
- . I +IBRFN,+IBNCPT D
- .. I '$G(IB029) S IBFND=$$EDITCPT^IBCU7U(IBIFN,IBRFN,IBNCPT) Q
- .. S IBFND=$$IB029B(IBIFN,IBRFN,IBNCPT)
- Q IBFND
- ;
- IB029A(IBGLB,IBLN) ; return ien of cpt code
- ; input: IBGLB = 0295T
- ; IBLN = 0295T:0296T^0297T:0298T
- N IBTXT,IBTCPT S IBTCPT=0
- S IBTXT=$P(IBLN,":",2)
- S IBTCPT=+$$CPT^ICPTCOD(IBGLB)_":"_+$$CPT^ICPTCOD($P(IBTXT,U,1))_U_+$$CPT^ICPTCOD($P(IBTXT,U,2))_":"_+$$CPT^ICPTCOD($P(IBLN,":",3))
- Q IBTCPT
- ;
- IB029B(IBIFN,OLDDA,NEWCPT) ; replace cpt with another
- ; input: OLDDA = ien of cpt in bill cpt multiple to be replaced
- ; NEWCPT = ien of cpt code to be added
- N DA,DIE,IBTCPT,IBFND,IBZ,X,Y S IBFND=0,DA(1)=+$G(IBIFN),DA=+$G(OLDDA),NEWCPT=+$G(NEWCPT),IBTCPT=NEWCPT
- I NEWCPT,$D(^DGCR(399,DA(1),"CP",DA,0)) D FDA^DILF(399.0304,.DA,.01,,IBTCPT_";ICPT(","IBZ"),FILE^DIE(,"IBZ") S IBFND=1
- Q IBFND
- ;
- IB029C(IBMCPT) ; return cpt code(s) for display
- ; input: IBMCPT = ien of cpt to be replaced
- ; output: IBTCPT = cpt code(s) separated by '^'
- N IBZ,IBTXT,IBTCPT S IBTCPT=""
- S IBTXT=$P(IBMCPT,U,1),IBTCPT=$P($$CPT^ICPTCOD(IBTXT),U,2)
- F IBZ=2:1 S IBTXT=$P(IBMCPT,U,IBZ) Q:IBTXT="" S IBTCPT=IBTCPT_U_$P($$CPT^ICPTCOD(IBTXT),U,2)
- Q IBTCPT
- ;
- FND(IBIFN,LIST) ; find first set of the procedures on the bill to be replaced
- ; if all found then returns procedure date followed by 'CP' ifn list
- ; Input: list of CPT's to be replaced separated by '^', internal format
- ; Output: procedure date ^ ifn of procedures in bill CP multiple
- N IBJ,IBC1,IBC1N,IBC1D,IBC2,IBC2N,IBC2D,IBFND,IBNLIST S (IBFND,IBNLIST)=0 I '$G(LIST) G FNDQ
- ;
- ; start with the first procedure to be replaced if it is on the bill then search for the rest on same date
- S IBC1=$P(LIST,U,1)
- S IBC1N=0 F S IBC1N=$O(^DGCR(399,+$G(IBIFN),"CP","B",IBC1_";ICPT(",IBC1N)) Q:'IBC1N D Q:IBFND
- . S IBC1D=$P($G(^DGCR(399,IBIFN,"CP",IBC1N,0)),U,2)
- . S IBFND=1,IBNLIST=IBC1D_U_IBC1N
- . ;
- . ; find other procedures to be replaced for same date
- . F IBJ=2:1 S IBC2=$P(LIST,U,IBJ) Q:'IBC2 S IBFND=0 D Q:'IBFND
- .. S IBC2N=0 F S IBC2N=$O(^DGCR(399,IBIFN,"CP","B",IBC2_";ICPT(",IBC2N)) Q:'IBC2N D Q:IBFND
- ... S IBC2D=$P($G(^DGCR(399,IBIFN,"CP",IBC2N,0)),U,2) I IBC1D'=IBC2D S IBFND=0 Q
- ... S IBFND=1,IBNLIST=IBNLIST_U_IBC2N
- . ;
- . I 'IBFND S IBNLIST=0
- ;
- FNDQ Q IBNLIST
- ;
- CHKIPB(CPT,TYPE) ; return procedures that may replace procedure passed in
- ; Input: TYPE - 1 for institutional, 2 for professional, 3 for Non-Provider Based
- ; Output: Procedures to be replaced ':' Procedures they are replaced with
- N IBX,IBI,IBLN,IBRPL S IBX="",CPT=$G(CPT),TYPE=+$G(TYPE)
- I +TYPE,CPT>92999,CPT<94017 F IBI=1:1 S IBLN=$P($T(IPBI+IBI),";;",2) Q:IBLN="" D Q:+IBX
- . S IBRPL=$$IPB(IBLN,TYPE) I $P(IBRPL,":",1)[CPT S IBX=IBRPL
- Q IBX
- ;
- ;
- IPB(LINE,TYPE) ; return procedures to be replaced and those they are replaced by for the type of bill
- ; Input: LINE - line of bundled procedures from IPBI
- ; TYPE - 1 for institutional, 2 for professional, 3 for Non-Provider Based
- ; Output: Procedures to be replaced ':' Procedures they are replaced with
- ; - institutional type the global is replaced by the technical componentes
- ; - professional type: the institutional components are replaced by the professional components
- ; - non-provider based: the institutional and professional components are preplaced by the global
- ;
- N IBNEW,IBDEL,IBX S (IBX,IBDEL,IBNEW)="",TYPE=$G(TYPE),LINE=$G(LINE)
- I TYPE=1 S IBNEW=$P(LINE,":",2),IBDEL=$P(LINE,":",1)
- I TYPE=2 S IBNEW=$P(LINE,":",3),IBDEL=$P(LINE,":",2)
- I TYPE=3 S IBNEW=$P(LINE,":",1),IBDEL=$P(LINE,":",2)_U_$P(LINE,":",3)
- S IBX=IBDEL_":"_IBNEW
- Q IBX
- ;
- IPBI ; Facility Provider Based Replace Global by Technical Component: global:technical:professional
- ;;93000:93005:93010
- ;;93015:93017:93016^93018
- ;;93040:93041:93042
- ;;93224:93225^93226:93227
- ;;93230:93231^93232:93233
- ;;93235:93236:93237
- ;;93268:93270^93271:93272
- ;;93720:93721:93722
- ;;93784:93786^93788:93790
- ;;94014:94015:94016
- ;;0295T:0296T^0297T:0298T
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCU7A1 7421 printed Feb 18, 2025@23:47:18 Page 2
- IBCU7A1 ;ALB/ARH - BILL PROCEDURE MANIPULATIONS (BUNDLED) ; 10-OCT-03
- +1 ;;2.0;INTEGRATED BILLING;**245,270,598**;21-MAR-94;Build 28
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;
- BNDL(IBIFN) ; manipulate a bill's CPT codes, replace bundled codes
- +1 ; on facility and profesional bills global codes should be billed using their components
- +2 ; on freestanding bills component codes should be billed as global
- +3 ; - on facility bill, if a global code is found in the clinical data and on the bill then
- +4 ; replace it on the bill with the institutional components
- +5 ; - on professional bill, if the global code is found in the clinical data and the institutional components
- +6 ; are found on the bill then replace the institutional components with the professional components
- +7 ; - on a freestanding bill if all institutional and professional components are found then
- +8 ; replace them with the global code
- +9 ; maximum of 10 is insurance against infinite loops
- +10 NEW IB0,IBCT,IBDVTY,IBTYPE,IBI,IBJ,IBLN,IBGLB,IBNLN,IBNEW,IBDEL,IBRPL,IBX,IBMSG,IBCHANGE,IB029,IBMCPT
- SET IBCHANGE=0
- +11 SET IB0=$GET(^DGCR(399,+$GET(IBIFN),0))
- if IB0=""
- QUIT
- +12 SET IBCT=$PIECE(IB0,U,27)
- if 'IBCT
- QUIT
- SET IBDVTY=$PIECE($$RCDV^IBCRU8($PIECE(IB0,U,22)),U,3)
- +13 SET IBTYPE=$SELECT(IBDVTY=3:3,1:+IBCT)
- +14 ;
- +15 ; none of the bundled codes on bill
- IF +$ORDER(^DGCR(399,+$GET(IBIFN),"CP","B","94017;ICPT("),-1)<93000
- QUIT
- +16 ;
- +17 ; for provider based sites global charge should be in clincal data
- IF IBDVTY'=3
- DO GETSD^IBCU7U(IBIFN)
- +18 ;
- +19 ; loop through list of bundled procedures and find any on bill
- +20 FOR IBI=1:1
- SET IBLN=$PIECE($TEXT(IPBI+IBI),";;",2)
- if IBLN=""
- QUIT
- Begin DoDot:1
- +21 SET IBGLB=$PIECE(IBLN,":",1)
- SET IBCHANGE=0
- +22 +23 ; *598 procedures split for 0295T
- +24 SET IB029=0
- +25 IF IBGLB="0295T"
- SET IB029=1
- SET IBLN=$$IB029A(IBGLB,IBLN)
- SET IBGLB=$PIECE(IBLN,":",1)
- +26 ;
- +27 SET IBNLN=$$IPB(IBLN,IBTYPE)
- if 'IBNLN
- QUIT
- SET IBNEW=$PIECE(IBNLN,":",2)
- SET IBDEL=$PIECE(IBNLN,":",1)
- +28 ;
- +29 IF IBDVTY'=3
- IF '$DATA(^UTILITY($JOB,"CPT-CLN",+IBGLB))
- QUIT
- +30 ;
- +31 ; search the bill for the list of procedures to be replaced
- +32 FOR IBJ=1:1
- SET IBRPL=$$FND(IBIFN,IBDEL)
- if 'IBRPL
- QUIT
- Begin DoDot:2
- +33 ;
- +34 IF IBDVTY'=3
- IF '$DATA(^UTILITY($JOB,"CPT-CLN",+IBGLB,+IBRPL))
- QUIT
- +35 SET IBRPL=$PIECE(IBRPL,U,2,999)
- IF $LENGTH(IBRPL,U)'=$LENGTH(IBDEL,U)
- QUIT
- +36 ;
- +37 ; replace procedures
- IF +$$RPL(IBIFN,IBNEW,IBRPL)
- SET IBCHANGE=1
- End DoDot:2
- if IBJ>10
- QUIT
- +38 ;
- +39 IF +IBCHANGE
- IF IB029
- SET IBDEL=$$IB029C(IBDEL)
- SET IBNEW=$$IB029C(IBNEW)
- +40 IF +IBCHANGE
- SET IBMSG(IBI)=$TRANSLATE(IBDEL,"^",",")_" replaced by "_$TRANSLATE(IBNEW,"^",",")
- End DoDot:1
- +41 ;
- +42 IF '$DATA(ZTQUEUED)
- IF '$GET(IBAUTO)
- IF +$ORDER(IBMSG(0))
- SET IBI=0
- FOR
- SET IBI=$ORDER(IBMSG(IBI))
- if 'IBI
- QUIT
- WRITE !,IBMSG(IBI)
- +43 QUIT
- +44 ;
- RPL(IBIFN,NEWCPTS,OLDLIST) ; replace procedures on the bill
- +1 ; Input: NEWCPTS - list of CPT codes to add to the bill
- +2 ; OLDLIST - list of procedure ifn's on the bill to be replaced
- +3 ; Output: returns true if changes made
- +4 ; the list of new and replaced may not be the same length
- +5 ; - if more CPT's to be added than exist then the first existing procedure is copied for the new CPT
- +6 ; - if fewer CPT's to be added than exist then the extra entries on the bill are deleted
- +7 NEW IBJ,IBFFN,IBRFN,IBNCPT,IBFND
- SET IBFND=0
- +8 ;
- +9 SET NEWCPTS=$GET(NEWCPTS)
- SET OLDLIST=$GET(OLDLIST)
- SET IBFFN=+OLDLIST
- +10 ;
- +11 FOR IBJ=1:1
- SET IBRFN=$PIECE(OLDLIST,U,IBJ)
- SET IBNCPT=$PIECE(NEWCPTS,U,IBJ)
- if ('IBRFN)&('IBNCPT)
- QUIT
- Begin DoDot:1
- +12 IF +IBRFN
- IF 'IBNCPT
- SET IBFND=$$DELCPT^IBCU7U(IBIFN,IBRFN)
- QUIT
- +13 IF 'IBRFN
- IF +IBNCPT
- SET IBFND=$$COPYCPT^IBCU7U(IBIFN,IBFFN,IBNCPT)
- QUIT
- +14 IF +IBRFN
- IF +IBNCPT
- Begin DoDot:2
- +15 IF '$GET(IB029)
- SET IBFND=$$EDITCPT^IBCU7U(IBIFN,IBRFN,IBNCPT)
- QUIT
- +16 SET IBFND=$$IB029B(IBIFN,IBRFN,IBNCPT)
- End DoDot:2
- End DoDot:1
- if 'IBFND
- QUIT
- +17 QUIT IBFND
- +18 ;
- IB029A(IBGLB,IBLN) ; return ien of cpt code
- +1 ; input: IBGLB = 0295T
- +2 ; IBLN = 0295T:0296T^0297T:0298T
- +3 NEW IBTXT,IBTCPT
- SET IBTCPT=0
- +4 SET IBTXT=$PIECE(IBLN,":",2)
- +5 SET IBTCPT=+$$CPT^ICPTCOD(IBGLB)_":"_+$$CPT^ICPTCOD($PIECE(IBTXT,U,1))_U_+$$CPT^ICPTCOD($PIECE(IBTXT,U,2))_":"_+$$CPT^ICPTCOD($PIECE(IBLN,":",3))
- +6 QUIT IBTCPT
- +7 ;
- IB029B(IBIFN,OLDDA,NEWCPT) ; replace cpt with another
- +1 ; input: OLDDA = ien of cpt in bill cpt multiple to be replaced
- +2 ; NEWCPT = ien of cpt code to be added
- +3 NEW DA,DIE,IBTCPT,IBFND,IBZ,X,Y
- SET IBFND=0
- SET DA(1)=+$GET(IBIFN)
- SET DA=+$GET(OLDDA)
- SET NEWCPT=+$GET(NEWCPT)
- SET IBTCPT=NEWCPT
- +4 IF NEWCPT
- IF $DATA(^DGCR(399,DA(1),"CP",DA,0))
- DO FDA^DILF(399.0304,.DA,.01,,IBTCPT_";ICPT(","IBZ")
- DO FILE^DIE(,"IBZ")
- SET IBFND=1
- +5 QUIT IBFND
- +6 ;
- IB029C(IBMCPT) ; return cpt code(s) for display
- +1 ; input: IBMCPT = ien of cpt to be replaced
- +2 ; output: IBTCPT = cpt code(s) separated by '^'
- +3 NEW IBZ,IBTXT,IBTCPT
- SET IBTCPT=""
- +4 SET IBTXT=$PIECE(IBMCPT,U,1)
- SET IBTCPT=$PIECE($$CPT^ICPTCOD(IBTXT),U,2)
- +5 FOR IBZ=2:1
- SET IBTXT=$PIECE(IBMCPT,U,IBZ)
- if IBTXT=""
- QUIT
- SET IBTCPT=IBTCPT_U_$PIECE($$CPT^ICPTCOD(IBTXT),U,2)
- +6 QUIT IBTCPT
- +7 ;
- FND(IBIFN,LIST) ; find first set of the procedures on the bill to be replaced
- +1 ; if all found then returns procedure date followed by 'CP' ifn list
- +2 ; Input: list of CPT's to be replaced separated by '^', internal format
- +3 ; Output: procedure date ^ ifn of procedures in bill CP multiple
- +4 NEW IBJ,IBC1,IBC1N,IBC1D,IBC2,IBC2N,IBC2D,IBFND,IBNLIST
- SET (IBFND,IBNLIST)=0
- IF '$GET(LIST)
- GOTO FNDQ
- +5 ;
- +6 ; start with the first procedure to be replaced if it is on the bill then search for the rest on same date
- +7 SET IBC1=$PIECE(LIST,U,1)
- +8 SET IBC1N=0
- FOR
- SET IBC1N=$ORDER(^DGCR(399,+$GET(IBIFN),"CP","B",IBC1_";ICPT(",IBC1N))
- if 'IBC1N
- QUIT
- Begin DoDot:1
- +9 SET IBC1D=$PIECE($GET(^DGCR(399,IBIFN,"CP",IBC1N,0)),U,2)
- +10 SET IBFND=1
- SET IBNLIST=IBC1D_U_IBC1N
- +11 ;
- +12 ; find other procedures to be replaced for same date
- +13 FOR IBJ=2:1
- SET IBC2=$PIECE(LIST,U,IBJ)
- if 'IBC2
- QUIT
- SET IBFND=0
- Begin DoDot:2
- +14 SET IBC2N=0
- FOR
- SET IBC2N=$ORDER(^DGCR(399,IBIFN,"CP","B",IBC2_";ICPT(",IBC2N))
- if 'IBC2N
- QUIT
- Begin DoDot:3
- +15 SET IBC2D=$PIECE($GET(^DGCR(399,IBIFN,"CP",IBC2N,0)),U,2)
- IF IBC1D'=IBC2D
- SET IBFND=0
- QUIT
- +16 SET IBFND=1
- SET IBNLIST=IBNLIST_U_IBC2N
- End DoDot:3
- if IBFND
- QUIT
- End DoDot:2
- if 'IBFND
- QUIT
- +17 ;
- +18 IF 'IBFND
- SET IBNLIST=0
- End DoDot:1
- if IBFND
- QUIT
- +19 ;
- FNDQ QUIT IBNLIST
- +1 ;
- CHKIPB(CPT,TYPE) ; return procedures that may replace procedure passed in
- +1 ; Input: TYPE - 1 for institutional, 2 for professional, 3 for Non-Provider Based
- +2 ; Output: Procedures to be replaced ':' Procedures they are replaced with
- +3 NEW IBX,IBI,IBLN,IBRPL
- SET IBX=""
- SET CPT=$GET(CPT)
- SET TYPE=+$GET(TYPE)
- +4 IF +TYPE
- IF CPT>92999
- IF CPT<94017
- FOR IBI=1:1
- SET IBLN=$PIECE($TEXT(IPBI+IBI),";;",2)
- if IBLN=""
- QUIT
- Begin DoDot:1
- +5 SET IBRPL=$$IPB(IBLN,TYPE)
- IF $PIECE(IBRPL,":",1)[CPT
- SET IBX=IBRPL
- End DoDot:1
- if +IBX
- QUIT
- +6 QUIT IBX
- +7 ;
- +8 ;
- IPB(LINE,TYPE) ; return procedures to be replaced and those they are replaced by for the type of bill
- +1 ; Input: LINE - line of bundled procedures from IPBI
- +2 ; TYPE - 1 for institutional, 2 for professional, 3 for Non-Provider Based
- +3 ; Output: Procedures to be replaced ':' Procedures they are replaced with
- +4 ; - institutional type the global is replaced by the technical componentes
- +5 ; - professional type: the institutional components are replaced by the professional components
- +6 ; - non-provider based: the institutional and professional components are preplaced by the global
- +7 ;
- +8 NEW IBNEW,IBDEL,IBX
- SET (IBX,IBDEL,IBNEW)=""
- SET TYPE=$GET(TYPE)
- SET LINE=$GET(LINE)
- +9 IF TYPE=1
- SET IBNEW=$PIECE(LINE,":",2)
- SET IBDEL=$PIECE(LINE,":",1)
- +10 IF TYPE=2
- SET IBNEW=$PIECE(LINE,":",3)
- SET IBDEL=$PIECE(LINE,":",2)
- +11 IF TYPE=3
- SET IBNEW=$PIECE(LINE,":",1)
- SET IBDEL=$PIECE(LINE,":",2)_U_$PIECE(LINE,":",3)
- +12 SET IBX=IBDEL_":"_IBNEW
- +13 QUIT IBX
- +14 ;
- IPBI ; Facility Provider Based Replace Global by Technical Component: global:technical:professional
- +1 ;;93000:93005:93010
- +2 ;;93015:93017:93016^93018
- +3 ;;93040:93041:93042
- +4 ;;93224:93225^93226:93227
- +5 ;;93230:93231^93232:93233
- +6 ;;93235:93236:93237
- +7 ;;93268:93270^93271:93272
- +8 ;;93720:93721:93722
- +9 ;;93784:93786^93788:93790
- +10 ;;94014:94015:94016
- +11 ;;0295T:0296T^0297T:0298T
- +12 ;;