- IB20PT7 ;ALB/ARH - ADD NEW ENTRIES TO TABLE FILES ; 12/20/93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- D DS ; Add new discharge statuses for bills
- D RT ; Add new Rate Types to file #399.3 for CHAMPVA
- D RVC ; Add new revenue codes to file #399.2
- D OSC ; Adding new Occurrence Span Codes
- D VC ; Adding new Value Codes
- Q
- ;
- ;
- DS ; Add new discharge statuses for bills
- W !!,">>> Adding new discharge status for bills..."
- F IBI=1:1 S IBX=$P($T(DSF+IBI),";;",2,999) Q:IBX="" D
- . S IBJ=0 F S IBJ=$O(^DGCR(399.1,IBJ)) Q:'IBJ S IBY=$G(^DGCR(399.1,IBJ,0)) I $P(IBX,U,1)=$P(IBY,U,1),$P(IBX,U,2)=$P(IBY,U,2),$P(IBY,U,6) S IBY=1 Q
- . Q:IBY K DA,DO S DIC="^DGCR(399.1,",DIC(0)="L",X=$P(IBX,U,1) D FILE^DICN K DA,DO Q:Y<0!('$P(Y,U,3))
- . S DA=+Y,DIE=DIC,DR=".02////"_$P(IBX,U,2)_";.13////1" D ^DIE
- K DIC,DIE,DA,DR,Y
- Q
- ;
- RT ; Add new Rate Types to file #399.3 for CHAMPVA
- W !!,">>> Adding new entries to the Rate Type File - CHAMPVA ..."
- F IBI=1:1 S IBX=$P($T(RTF+IBI),";;",2,999) Q:IBX="" D
- . S IBY=$E($P(IBX,U,1),1,30) Q:$D(^DGCR(399.3,"B",IBY))
- . K DD,DO S DIC="^DGCR(399.3,",DIC(0)="L",X=IBY D FILE^DICN K DA,DO Q:Y<0
- . S DA=+Y,DIE=DIC,DR=".02////"_$P(IBX,U,2)_";.03////"_$P(IBX,U,3)_";.04////"_$P(IBX,U,4)_";.05////"_$P(IBX,U,5)_";.06////"_$P(IBX,U,6)_";.07////"_$P(IBX,U,7)_";.08////"_$P(IBX,U,8)_";.09////"_$P(IBX,U,9) D ^DIE
- K DIC,DIE,DA,DR,Y
- Q
- ;
- RVC ; Add new revenue codes to file #399.2
- W !!,">>> Adding new revenue codes..."
- F IBI=1:1 S IBX=$P($T(RVCF+IBI),";;",2,999) Q:IBX="" D
- . S IBY=$P(IBX,U,1),IBZ=$G(^DGCR(399.2,+IBY,0)) Q:(+IBY'=+IBZ)!($P(IBZ,U,2)'="*RESERVED")
- . S DA=+IBY,DIE="^DGCR(399.2,",DR="1////"_$P(IBX,U,2)_";3////"_$P(IBX,U,4) D ^DIE
- K DIC,DIE,DA,DR,Y
- Q
- ;
- OSC ; Adding new Occurrence Span Codes
- W !!,">>> Adding Occurrence Span Codes..."
- F IBI=1:1 S IBX=$P($T(OSCF+IBI),";;",2,999) Q:IBX="" D
- . S IBJ=0 F S IBJ=$O(^DGCR(399.1,IBJ)) Q:'IBJ S IBY=$G(^DGCR(399.1,IBJ,0)) I $P(IBX,U,1)=$P(IBY,U,1),$P(IBX,U,2)=$P(IBY,U,2),$P(IBY,U,10) S IBY=1 Q
- . Q:IBY K DA,DO S DIC="^DGCR(399.1,",DIC(0)="L",X=$P(IBX,U,1) D FILE^DICN K DA,DO Q:Y<0!('$P(Y,U,3))
- . S DA=+Y,DIE=DIC,DR=".02////"_$P(IBX,U,2)_";.11////1;.17////1" D ^DIE
- K DIC,DIE,DA,DR,Y
- Q
- ;
- VC ; Adding new Value Codes
- W !!,">>> Adding Value Codes..."
- F IBI=1:1 S IBX=$P($T(VCF+IBI),";;",2,999) Q:IBX="" D
- . S IBJ=0 F S IBJ=$O(^DGCR(399.1,IBJ)) Q:'IBJ S IBY=$G(^DGCR(399.1,IBJ,0)) I $P(IBX,U,1)=$P(IBY,U,1),$P(IBX,U,2)=$P(IBY,U,2),$P(IBY,U,11) S IBY=1 Q
- . Q:IBY K DA,DO S DIC="^DGCR(399.1,",DIC(0)="L",X=$P(IBX,U,1) D FILE^DICN K DA,DO Q:Y<0!('$P(Y,U,3))
- . S DA=+Y,DIE=DIC,DR=".02////"_$P(IBX,U,2)_";.18////1;.19////"_$P(IBX,U,3) D ^DIE
- K DIC,DIE,DA,DR,Y
- Q
- ;
- ;
- DSF ; - new discharge status, 399.1
- ;;DISCHARGED TO HOME UNDER CARE OF A HOME IV PROVIDER^08
- ;
- ;
- RTF ; - new rate type entries
- ;;CHAMPVA REIMB. INS.^REIMBURSABLE INS.^1^REIM INS^1^^i^1^1
- ;;CHAMPVA^CHAMPVA^1^CHAMPVA^1^^i^1^1
- ;
- ;
- RVCF ; - new revenue codes
- ;;294^MED EQUIP/SUPPLIES/DRUGS^^SUPPLIES/DRUGS FOR DME EFFECTIVENESS HOME-HEALTH AGENCY ONLY
- ;;404^PET SCAN^^POSITRON EMMISSION TOMOGROPHY
- ;;547^AMBUL/PHARMACY^^PHARMACY
- ;;548^AMBUL/TELEPHONIC EKG^^TELEPHONE TRANSMISSION EKG
- ;;636^DRUGS/DETAIL CODE^^DRUGS REQUIRING DETAILED CODING
- ;;761^TREATMENT RM^^TREATMENT ROOM
- ;;762^OBSERVATION RM^^OBSERVATION ROOM
- ;;882^HOME DIALYSIS AID VISIT^^HOME DIALYSIS AID VISIT
- ;;947^CMPLX MED EQUIP-ANC^^COMPLEX MEDICAL EQUIPMENT - ANCILLARY
- ;
- ;
- OSCF ; - add occurrence span codes
- ;;QUALIFYING STAY DATES FOR SNF USE ONLY^70
- ;;PRIOR STAY DATES^71
- ;;FIRST/LAST VISIT^72
- ;;BENEFIT ELIGIBILITY PERIOD^73
- ;;NONCOVERED LEVEL OF CARE^74
- ;;SNF LEVEL OF CARE^75
- ;;PATIENT LIABILITY^76
- ;;PROVIDER LIABILITY PERIOD^77
- ;;SNF PRIOR STAY DATES^78
- ;;PAYER CODE^79
- ;;PRO/UR APPROVED STAY DATES^M0
- ;
- ;
- VCF ; - add value codes
- ;;INPATIENT PROFESSIONAL COMPONENT CHARGES, COMBINED BILLED^04
- ;;NO FAULT, INCLUDING AUTO/OTHER^14^1
- ;;WORKER'S COMPENSATION^15
- ;;ACCIDENT HOUR^45
- ;
- IB20PT7 ;ALB/ARH - ADD NEW ENTRIES TO TABLE FILES ; 12/20/93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- +3 ; Add new discharge statuses for bills
- DO DS
- +4 ; Add new Rate Types to file #399.3 for CHAMPVA
- DO RT
- +5 ; Add new revenue codes to file #399.2
- DO RVC
- +6 ; Adding new Occurrence Span Codes
- DO OSC
- +7 ; Adding new Value Codes
- DO VC
- +8 QUIT
- +9 ;
- +10 ;
- DS ; Add new discharge statuses for bills
- +1 WRITE !!,">>> Adding new discharge status for bills..."
- +2 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(DSF+IBI),";;",2,999)
- IF IBX=""
- QUIT
- Begin DoDot:1
- +3 SET IBJ=0
- FOR
- SET IBJ=$ORDER(^DGCR(399.1,IBJ))
- IF 'IBJ
- QUIT
- SET IBY=$GET(^DGCR(399.1,IBJ,0))
- IF $PIECE(IBX,U,1)=$PIECE(IBY,U,1)
- IF $PIECE(IBX,U,2)=$PIECE(IBY,U,2)
- IF $PIECE(IBY,U,6)
- SET IBY=1
- QUIT
- +4 IF IBY
- QUIT
- KILL DA,DO
- SET DIC="^DGCR(399.1,"
- SET DIC(0)="L"
- SET X=$PIECE(IBX,U,1)
- DO FILE^DICN
- KILL DA,DO
- IF Y<0!('$PIECE(Y,U,3))
- QUIT
- +5 SET DA=+Y
- SET DIE=DIC
- SET DR=".02////"_$PIECE(IBX,U,2)_";.13////1"
- DO ^DIE
- End DoDot:1
- +6 KILL DIC,DIE,DA,DR,Y
- +7 QUIT
- +8 ;
- RT ; Add new Rate Types to file #399.3 for CHAMPVA
- +1 WRITE !!,">>> Adding new entries to the Rate Type File - CHAMPVA ..."
- +2 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(RTF+IBI),";;",2,999)
- IF IBX=""
- QUIT
- Begin DoDot:1
- +3 SET IBY=$EXTRACT($PIECE(IBX,U,1),1,30)
- IF $DATA(^DGCR(399.3,"B",IBY))
- QUIT
- +4 KILL DD,DO
- SET DIC="^DGCR(399.3,"
- SET DIC(0)="L"
- SET X=IBY
- DO FILE^DICN
- KILL DA,DO
- IF Y<0
- QUIT
- +5 SET DA=+Y
- SET DIE=DIC
- SET DR=".02////"_$PIECE(IBX,U,2)_";.03////"_$PIECE(IBX,U,3)_";.04////"_$PIECE(IBX,U,4)_";.05////"_$PIECE(IBX,U,5)_";.06////"_$PIECE(IBX,U,6)_";.07////"_$PIECE(IBX,U,7)_";.08////"_$PIECE(IBX,U,8)_";.09////"_$PIECE(IBX,U,9)
- DO ^DIE
- End DoDot:1
- +6 KILL DIC,DIE,DA,DR,Y
- +7 QUIT
- +8 ;
- RVC ; Add new revenue codes to file #399.2
- +1 WRITE !!,">>> Adding new revenue codes..."
- +2 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(RVCF+IBI),";;",2,999)
- IF IBX=""
- QUIT
- Begin DoDot:1
- +3 SET IBY=$PIECE(IBX,U,1)
- SET IBZ=$GET(^DGCR(399.2,+IBY,0))
- IF (+IBY'=+IBZ)!($PIECE(IBZ,U,2)'="*RESERVED")
- QUIT
- +4 SET DA=+IBY
- SET DIE="^DGCR(399.2,"
- SET DR="1////"_$PIECE(IBX,U,2)_";3////"_$PIECE(IBX,U,4)
- DO ^DIE
- End DoDot:1
- +5 KILL DIC,DIE,DA,DR,Y
- +6 QUIT
- +7 ;
- OSC ; Adding new Occurrence Span Codes
- +1 WRITE !!,">>> Adding Occurrence Span Codes..."
- +2 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(OSCF+IBI),";;",2,999)
- IF IBX=""
- QUIT
- Begin DoDot:1
- +3 SET IBJ=0
- FOR
- SET IBJ=$ORDER(^DGCR(399.1,IBJ))
- IF 'IBJ
- QUIT
- SET IBY=$GET(^DGCR(399.1,IBJ,0))
- IF $PIECE(IBX,U,1)=$PIECE(IBY,U,1)
- IF $PIECE(IBX,U,2)=$PIECE(IBY,U,2)
- IF $PIECE(IBY,U,10)
- SET IBY=1
- QUIT
- +4 IF IBY
- QUIT
- KILL DA,DO
- SET DIC="^DGCR(399.1,"
- SET DIC(0)="L"
- SET X=$PIECE(IBX,U,1)
- DO FILE^DICN
- KILL DA,DO
- IF Y<0!('$PIECE(Y,U,3))
- QUIT
- +5 SET DA=+Y
- SET DIE=DIC
- SET DR=".02////"_$PIECE(IBX,U,2)_";.11////1;.17////1"
- DO ^DIE
- End DoDot:1
- +6 KILL DIC,DIE,DA,DR,Y
- +7 QUIT
- +8 ;
- VC ; Adding new Value Codes
- +1 WRITE !!,">>> Adding Value Codes..."
- +2 FOR IBI=1:1
- SET IBX=$PIECE($TEXT(VCF+IBI),";;",2,999)
- IF IBX=""
- QUIT
- Begin DoDot:1
- +3 SET IBJ=0
- FOR
- SET IBJ=$ORDER(^DGCR(399.1,IBJ))
- IF 'IBJ
- QUIT
- SET IBY=$GET(^DGCR(399.1,IBJ,0))
- IF $PIECE(IBX,U,1)=$PIECE(IBY,U,1)
- IF $PIECE(IBX,U,2)=$PIECE(IBY,U,2)
- IF $PIECE(IBY,U,11)
- SET IBY=1
- QUIT
- +4 IF IBY
- QUIT
- KILL DA,DO
- SET DIC="^DGCR(399.1,"
- SET DIC(0)="L"
- SET X=$PIECE(IBX,U,1)
- DO FILE^DICN
- KILL DA,DO
- IF Y<0!('$PIECE(Y,U,3))
- QUIT
- +5 SET DA=+Y
- SET DIE=DIC
- SET DR=".02////"_$PIECE(IBX,U,2)_";.18////1;.19////"_$PIECE(IBX,U,3)
- DO ^DIE
- End DoDot:1
- +6 KILL DIC,DIE,DA,DR,Y
- +7 QUIT
- +8 ;
- +9 ;
- DSF ; - new discharge status, 399.1
- +1 ;;DISCHARGED TO HOME UNDER CARE OF A HOME IV PROVIDER^08
- +2 ;
- +3 ;
- RTF ; - new rate type entries
- +1 ;;CHAMPVA REIMB. INS.^REIMBURSABLE INS.^1^REIM INS^1^^i^1^1
- +2 ;;CHAMPVA^CHAMPVA^1^CHAMPVA^1^^i^1^1
- +3 ;
- +4 ;
- RVCF ; - new revenue codes
- +1 ;;294^MED EQUIP/SUPPLIES/DRUGS^^SUPPLIES/DRUGS FOR DME EFFECTIVENESS HOME-HEALTH AGENCY ONLY
- +2 ;;404^PET SCAN^^POSITRON EMMISSION TOMOGROPHY
- +3 ;;547^AMBUL/PHARMACY^^PHARMACY
- +4 ;;548^AMBUL/TELEPHONIC EKG^^TELEPHONE TRANSMISSION EKG
- +5 ;;636^DRUGS/DETAIL CODE^^DRUGS REQUIRING DETAILED CODING
- +6 ;;761^TREATMENT RM^^TREATMENT ROOM
- +7 ;;762^OBSERVATION RM^^OBSERVATION ROOM
- +8 ;;882^HOME DIALYSIS AID VISIT^^HOME DIALYSIS AID VISIT
- +9 ;;947^CMPLX MED EQUIP-ANC^^COMPLEX MEDICAL EQUIPMENT - ANCILLARY
- +10 ;
- +11 ;
- OSCF ; - add occurrence span codes
- +1 ;;QUALIFYING STAY DATES FOR SNF USE ONLY^70
- +2 ;;PRIOR STAY DATES^71
- +3 ;;FIRST/LAST VISIT^72
- +4 ;;BENEFIT ELIGIBILITY PERIOD^73
- +5 ;;NONCOVERED LEVEL OF CARE^74
- +6 ;;SNF LEVEL OF CARE^75
- +7 ;;PATIENT LIABILITY^76
- +8 ;;PROVIDER LIABILITY PERIOD^77
- +9 ;;SNF PRIOR STAY DATES^78
- +10 ;;PAYER CODE^79
- +11 ;;PRO/UR APPROVED STAY DATES^M0
- +12 ;
- +13 ;
- VCF ; - add value codes
- +1 ;;INPATIENT PROFESSIONAL COMPONENT CHARGES, COMBINED BILLED^04
- +2 ;;NO FAULT, INCLUDING AUTO/OTHER^14^1
- +3 ;;WORKER'S COMPENSATION^15
- +4 ;;ACCIDENT HOUR^45
- +5 ;