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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20PT7 4087 printed Apr 09, 2024@21:27:40 Page 2
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 ;
