- IB20P532 ;ALB/CXW - UB-04 BILL CLASSIFICATION UPDATE; 07/15/2014
- ;;2.0;INTEGRATED BILLING;**532**;21-MAR-94;Build 26
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- POST ;
- ; UB-04 bill classification in mccr utility file 399.1
- N IBX,U S U="^"
- D MSG(" IB*2.0*532 Post-Install starts .....")
- D MCR
- D MSG(" IB*2.0*532 Post-Install is complete.")
- Q
- ;
- MCR ; UB-04 bill classification in field (#.23/piece 2)
- ; #4 HUMANIT. EMERG (OPT/ESRD) needs to be replaced
- N IBCOD,IBFN,IBPE,IBI,IBNW,IBX,DA,DD,DO,DIC,DIE,DLAYGO,DR,X,Y
- S IBPE=23 D MSG("")
- D MSG(">>> Adding new UB-04 Bill Classification entries to MCCR Utility file (#399.1)")
- F IBI=1:1 S IBX=$P($T(BILCS+IBI),";;",2) Q:IBX="" D
- . S IBNW=$P(IBX,U),IBCOD=$P(IBX,U,2)
- . S IBFN=+$$EXCODE(IBCOD,IBPE)
- . ; quit if it's found in the file
- . I IBFN,($P($G(^DGCR(399.1,IBFN,0)),U)=IBNW) D MSG(" #"_IBCOD_" "_IBNW_" already exists in the file") Q
- . K DD,DO S DLAYGO=399.1,DIC="^DGCR(399.1,",DIC(0)="L",X=IBNW D FILE^DICN
- . I Y<1 D MSG(" >> ERROR when adding the UB-04 Bill Classification for "_IBNW_" to the file, Log a Remedy ticket!") Q
- . S DIE=DIC,DA=+Y,DR=".02///"_IBCOD_";.23///"_$P(IBX,U,3)_";.24///"_$P(IBX,U,4) D ^DIE
- . D MSG(" #"_IBCOD_" "_IBNW_" added")
- D MSG("")
- Q
- ;
- MSG(IBX) ;
- D MES^XPDUTL(IBX) Q
- ;
- EXCODE(IBCOD,IBPE) ; Returns IEN if code found in the IBPE piece
- N IBX,IBY S IBY=""
- I $G(IBCOD)'="" S IBX=0 F S IBX=$O(^DGCR(399.1,"C",IBCOD,IBX)) Q:'IBX I $P($G(^DGCR(399.1,IBX,0)),U,+$G(IBPE)) S IBY=IBX
- Q IBY
- ;
- BILCS ; name^code^bill classification^valid location of care values
- ;;LABORATORY SERVICES PROVIDED TO NON-PATIENTS^4^1^1,3
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P532 1698 printed Apr 23, 2025@18:17:59 Page 2
- IB20P532 ;ALB/CXW - UB-04 BILL CLASSIFICATION UPDATE; 07/15/2014
- +1 ;;2.0;INTEGRATED BILLING;**532**;21-MAR-94;Build 26
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- POST ;
- +1 ; UB-04 bill classification in mccr utility file 399.1
- +2 NEW IBX,U
- SET U="^"
- +3 DO MSG(" IB*2.0*532 Post-Install starts .....")
- +4 DO MCR
- +5 DO MSG(" IB*2.0*532 Post-Install is complete.")
- +6 QUIT
- +7 ;
- MCR ; UB-04 bill classification in field (#.23/piece 2)
- +1 ; #4 HUMANIT. EMERG (OPT/ESRD) needs to be replaced
- +2 NEW IBCOD,IBFN,IBPE,IBI,IBNW,IBX,DA,DD,DO,DIC,DIE,DLAYGO,DR,X,Y
- +3 SET IBPE=23
- DO MSG("")
- +4 DO MSG(">>> Adding new UB-04 Bill Classification entries to MCCR Utility file (#399.1)")
- +5 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(BILCS+IBI),";;",2)
- if IBX=""
- QUIT
- Begin DoDot:1
- +6 SET IBNW=$PIECE(IBX,U)
- SET IBCOD=$PIECE(IBX,U,2)
- +7 SET IBFN=+$$EXCODE(IBCOD,IBPE)
- +8 ; quit if it's found in the file
- +9 IF IBFN
- IF ($PIECE($GET(^DGCR(399.1,IBFN,0)),U)=IBNW)
- DO MSG(" #"_IBCOD_" "_IBNW_" already exists in the file")
- QUIT
- +10 KILL DD,DO
- SET DLAYGO=399.1
- SET DIC="^DGCR(399.1,"
- SET DIC(0)="L"
- SET X=IBNW
- DO FILE^DICN
- +11 IF Y<1
- DO MSG(" >> ERROR when adding the UB-04 Bill Classification for "_IBNW_" to the file, Log a Remedy ticket!")
- QUIT
- +12 SET DIE=DIC
- SET DA=+Y
- SET DR=".02///"_IBCOD_";.23///"_$PIECE(IBX,U,3)_";.24///"_$PIECE(IBX,U,4)
- DO ^DIE
- +13 DO MSG(" #"_IBCOD_" "_IBNW_" added")
- End DoDot:1
- +14 DO MSG("")
- +15 QUIT
- +16 ;
- MSG(IBX) ;
- +1 DO MES^XPDUTL(IBX)
- QUIT
- +2 ;
- EXCODE(IBCOD,IBPE) ; Returns IEN if code found in the IBPE piece
- +1 NEW IBX,IBY
- SET IBY=""
- +2 IF $GET(IBCOD)'=""
- SET IBX=0
- FOR
- SET IBX=$ORDER(^DGCR(399.1,"C",IBCOD,IBX))
- if 'IBX
- QUIT
- IF $PIECE($GET(^DGCR(399.1,IBX,0)),U,+$GET(IBPE))
- SET IBY=IBX
- +3 QUIT IBY
- +4 ;
- BILCS ; name^code^bill classification^valid location of care values
- +1 ;;LABORATORY SERVICES PROVIDED TO NON-PATIENTS^4^1^1,3
- +2 ;
