- IBCREF ;ALB/ARH - RATES: CM FILE ENTRIES (CI,BI) ; 22-MAY-1996
- ;;2.0;INTEGRATED BILLING;**52,106,138,245**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;
- ADDCI(CS,ITEM,EFDT,CHG,RVCD,MOD,INAC,BASE) ; adds new charge item entries, does not check for duplicates or zero charge
- ; Input: CS, ITEM, EFDT are required, rest will be set if they have values
- ; Output: IFN of new entry
- ;
- N IBCS0,IBCI,IBEFDT,IBBI,IBFILE,DIC,DIE,DA,D0,DLAYGO,DR,X,Y S IBCI=0 I '$G(ITEM) G ADDCIQ
- S IBCS0=$G(^IBE(363.1,+$G(CS),0)) I IBCS0="" G ADDCIQ
- S IBEFDT=$G(EFDT)\1 I IBEFDT'?7N G ADDCIQ
- ;
- S IBBI=$P($$CSBR^IBCRU3(CS),U,4) I 'IBBI G ADDCIQ
- S IBFILE=$P($$BIFILE^IBCRU2(IBBI),U,1) I IBFILE="" G ADDCIQ
- I '$$ITFILE^IBCRU2(IBBI,ITEM,IBEFDT) G ADDCIQ
- ;
- S DIC("DR")=".02////"_CS_";.03////"_IBEFDT
- K DD,DO S DLAYGO=363.2,DIC="^IBA(363.2,",DIC(0)="L",X=+ITEM_IBFILE
- D FILE^DICN K DIC,DLAYGO,X I Y<1 G ADDCIQ
- ;
- S IBCI=+Y D EDITCI(IBCI,$G(CHG),$G(RVCD),$G(MOD),$G(INAC),$G(BASE))
- ;
- ADDCIQ Q IBCI
- ;
- EDITCI(CI,CHG,RVCD,MOD,INAC,BASE) ; edit certain fields of a charge item
- ;
- N DIC,DIE,DA,D0,DR,X,Y S DR=""
- S:$G(INAC)'="" DR=".04////"_INAC_";" S:$G(CHG)'="" DR=DR_".05////"_+$FN(CHG,"",2)_";" S:$G(BASE)'="" DR=DR_".08////"_+$FN(BASE,"",2)_";"
- S:$G(RVCD)'="" DR=DR_".06////"_RVCD_";" S:$G(MOD)'="" DR=DR_".07////"_MOD
- I DR'="",+$G(CI),$G(^IBA(363.2,+CI,0))'="" S DIE="^IBA(363.2,",DA=+CI D ^DIE
- Q
- ;
- ADDBI(TYPE,NAME,DUP) ; add a new Billing Item entry (363.21), check for duplicates optional
- ; Input: TYPE - data type (363.21,.02), NAME - billing item name, DUP - 1 if add without duplicate check
- ; Output: 0 - not added, BI IFN ^ 0 - already exists, BI IFN ^ 1 - new entry added
- N IBX,IBTYPE,IBBI,DIC,DIE,DA,D0,DLAYGO,DR,X,Y S IBBI=0
- ;
- S IBTYPE=$G(TYPE),IBTYPE=$S(IBTYPE["NDC":1,IBTYPE["MISCELLANEOUS":9,1:IBTYPE) I 'IBTYPE!($G(NAME)="") G ADDBIQ
- I IBTYPE=1,NAME'?1N.N1"-"1N.N1"-"1N.N G ADDBIQ
- I '$G(DUP) S IBX=$$FNDBI^IBCRU2(IBTYPE,NAME) I +IBX S IBBI=+IBX_U_0 G ADDBIQ
- ;
- S DIC("DR")=".02////"_IBTYPE
- K DD,DO S DLAYGO=363.21,DIC="^IBA(363.21,",DIC(0)="L",X=NAME D FILE^DICN K DIC,DLAYGO,X I Y<1 G ADDCIQ
- S IBBI=+Y_U_1
- ADDBIQ Q IBBI
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCREF 2219 printed Feb 18, 2025@23:45:27 Page 2
- IBCREF ;ALB/ARH - RATES: CM FILE ENTRIES (CI,BI) ; 22-MAY-1996
- +1 ;;2.0;INTEGRATED BILLING;**52,106,138,245**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;
- ADDCI(CS,ITEM,EFDT,CHG,RVCD,MOD,INAC,BASE) ; adds new charge item entries, does not check for duplicates or zero charge
- +1 ; Input: CS, ITEM, EFDT are required, rest will be set if they have values
- +2 ; Output: IFN of new entry
- +3 ;
- +4 NEW IBCS0,IBCI,IBEFDT,IBBI,IBFILE,DIC,DIE,DA,D0,DLAYGO,DR,X,Y
- SET IBCI=0
- IF '$GET(ITEM)
- GOTO ADDCIQ
- +5 SET IBCS0=$GET(^IBE(363.1,+$GET(CS),0))
- IF IBCS0=""
- GOTO ADDCIQ
- +6 SET IBEFDT=$GET(EFDT)\1
- IF IBEFDT'?7N
- GOTO ADDCIQ
- +7 ;
- +8 SET IBBI=$PIECE($$CSBR^IBCRU3(CS),U,4)
- IF 'IBBI
- GOTO ADDCIQ
- +9 SET IBFILE=$PIECE($$BIFILE^IBCRU2(IBBI),U,1)
- IF IBFILE=""
- GOTO ADDCIQ
- +10 IF '$$ITFILE^IBCRU2(IBBI,ITEM,IBEFDT)
- GOTO ADDCIQ
- +11 ;
- +12 SET DIC("DR")=".02////"_CS_";.03////"_IBEFDT
- +13 KILL DD,DO
- SET DLAYGO=363.2
- SET DIC="^IBA(363.2,"
- SET DIC(0)="L"
- SET X=+ITEM_IBFILE
- +14 DO FILE^DICN
- KILL DIC,DLAYGO,X
- IF Y<1
- GOTO ADDCIQ
- +15 ;
- +16 SET IBCI=+Y
- DO EDITCI(IBCI,$GET(CHG),$GET(RVCD),$GET(MOD),$GET(INAC),$GET(BASE))
- +17 ;
- ADDCIQ QUIT IBCI
- +1 ;
- EDITCI(CI,CHG,RVCD,MOD,INAC,BASE) ; edit certain fields of a charge item
- +1 ;
- +2 NEW DIC,DIE,DA,D0,DR,X,Y
- SET DR=""
- +3 if $GET(INAC)'=""
- SET DR=".04////"_INAC_";"
- if $GET(CHG)'=""
- SET DR=DR_".05////"_+$FNUMBER(CHG,"",2)_";"
- if $GET(BASE)'=""
- SET DR=DR_".08////"_+$FNUMBER(BASE,"",2)_";"
- +4 if $GET(RVCD)'=""
- SET DR=DR_".06////"_RVCD_";"
- if $GET(MOD)'=""
- SET DR=DR_".07////"_MOD
- +5 IF DR'=""
- IF +$GET(CI)
- IF $GET(^IBA(363.2,+CI,0))'=""
- SET DIE="^IBA(363.2,"
- SET DA=+CI
- DO ^DIE
- +6 QUIT
- +7 ;
- ADDBI(TYPE,NAME,DUP) ; add a new Billing Item entry (363.21), check for duplicates optional
- +1 ; Input: TYPE - data type (363.21,.02), NAME - billing item name, DUP - 1 if add without duplicate check
- +2 ; Output: 0 - not added, BI IFN ^ 0 - already exists, BI IFN ^ 1 - new entry added
- +3 NEW IBX,IBTYPE,IBBI,DIC,DIE,DA,D0,DLAYGO,DR,X,Y
- SET IBBI=0
- +4 ;
- +5 SET IBTYPE=$GET(TYPE)
- SET IBTYPE=$SELECT(IBTYPE["NDC":1,IBTYPE["MISCELLANEOUS":9,1:IBTYPE)
- IF 'IBTYPE!($GET(NAME)="")
- GOTO ADDBIQ
- +6 IF IBTYPE=1
- IF NAME'?1N.N1"-"1N.N1"-"1N.N
- GOTO ADDBIQ
- +7 IF '$GET(DUP)
- SET IBX=$$FNDBI^IBCRU2(IBTYPE,NAME)
- IF +IBX
- SET IBBI=+IBX_U_0
- GOTO ADDBIQ
- +8 ;
- +9 SET DIC("DR")=".02////"_IBTYPE
- +10 KILL DD,DO
- SET DLAYGO=363.21
- SET DIC="^IBA(363.21,"
- SET DIC(0)="L"
- SET X=NAME
- DO FILE^DICN
- KILL DIC,DLAYGO,X
- IF Y<1
- GOTO ADDCIQ
- +11 SET IBBI=+Y_U_1
- ADDBIQ QUIT IBBI