- IBCA0 ;ALB/AAS - ADD NEW BILLING RECORD-CONT. ;01 JUN 88 12:00
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;MAP TO DGCRA0
- ;
- ;moved from IBA (4.5) to split routine
- ;
- CEOC1 W !!,"ARE YOU BILLING FOR A CONTINUING EPISODE OF CARE" S %=2 D YN^DICN G CHKINQ:%=2,NREC^IBCA:%=-1
- I '% W !!?4,"YES - If this bill is for continuing care which has already been partially",!?9,"billed for on another bill.",!?4,"NO - If this is the initial bill for an episode of care." G CEOC1
- W ! D EN4^IBCA3 I '$D(IBIDS(.17)) G CEOC1
- CHKINQ Q
- ;
- IP W !!?4,"ARE YOU BILLING FOR AN UNDISPLAYED EPISODE OF CARE" S %=2 D YN^DICN
- I '% W !!?4,"YES - If this bill is for an episode of care at a Non-VA facility",!?4," for which no PTF record exists.",!?4,"NO - If for VA care or you just made a mistake." G IP
- W ! S DGPERCNT=% I DGPERCNT=1 S IBIDS(162)=$O(^DGCR(399.1,"B","STILL PATIENT",0))
- IP1 Q:DGPERCNT'=1 S %DT="AEXP",%DT(0)=IBX,%DT("A")=" NON-VA DISCHARGE DATE: " D ^%DT K %DT Q:X="" I Y<1!(Y>DT) W !!,"Enter a DISCHARGE DATE after the admission date and not greater than today!",! G IP1
- S IBIDS(.16)=Y,IBIDS(162)=$O(^DGCR(399.1,"B",$E("DISCHARGED TO HOME OR SELF CARE",1,30),0))
- Q
- DISPAD ;display admissions
- K IBIDS(.03),IBIDS(.08),IBI,IBJ,IBDSDT S (IBI,IBJ)="",IBCNT=0
- F I=0:0 S IBI=$O(^DGPM("ATID1",DFN,IBI)) Q:IBI="" S IBCNT=IBCNT+1,IBI1=9999999.9999999-IBI,IBI(IBCNT)=IBI1,IBI(IBI1\1)=IBI1
- F J=0:0 S IBJ=$O(^DGPT("AFEE",DFN,IBJ)) Q:IBJ="" S IBCNT=IBCNT+1,IBJ(IBCNT)=IBJ,IBJ(IBJ)=IBJ
- I 'IBCNT W !!,"Patient has no admissions on file."
- ;
- W !?4,$S($O(IBI(0))="":"THERE ARE NO INPATIENT EVENT (ADMISSION) DATES.",1:"Select INPATIENT EVENT (ADMISSION) DATE:")
- F I=1:2 Q:'$D(IBI(I)) S Y=IBI(I) X ^DD("DD") W !?8,I_" ",Y I $D(IBI(I+1)) S Y=IBI(I+1) X ^DD("DD") W ?40,I+1," ",Y
- S J=$O(IBJ(0)) I J]"" W !?4,"OR",!?4,"Select NON-VA INPATIENT EVENT (ADMISSION) DATE:" F J=J:2 Q:'$D(IBJ(J)) S Y=IBJ(J) X ^DD("DD") W !?8,J_" ",Y I $D(IBJ(J+1)) S Y=IBJ(J+1) X ^DD("DD") W ?40,J+1," ",Y
- W !!?4,$S(IBCNT:"CHOOSE 1-"_IBCNT_" or ",1:""),"Enter DATE: " R IBX:DTIME G:IBX="^"!(IBX="")!('$T) ENDDIS
- I IBX'?.N!(IBX<1)!(IBX>IBCNT) S X=IBX,%DT="EXP",%DT(0)="-NOW" D ^%DT S IBX=Y I Y<1 D HELPAD G DISPAD
- I IBX?7N.N D IP I DGPERCNT=1 S IBIDS(.03)=IBX,IBDSDT=$S($D(IBIDS(.16)):IBIDS(.16),1:""),IBIDS(160)=99,IBIDS(159)=2,IBIDS(158)=2 G ENDDIS
- I $D(IBI(IBX)) S IBIDS(.03)=IBI(IBX),IBIDS(.08)=$O(^DGPM("ATID1",DFN,9999999.9999999-IBI(IBX),0))
- I $D(IBIDS(.08)),$D(^DGPM(IBIDS(.08),0)) S IBIDS(.08)=$P(^(0),"^",16) S:$P(^(0),"^",17)]"" IBDSDT=+^DGPM($P(^(0),"^",17),0) D NOPTF G:'$D(IBIDS(.08)) DISPAD G ENDDIS
- I $D(IBJ(IBX)) S IBIDS(.03)=IBJ(IBX),IBIDS(.08)=$O(^DGPT("AFEE",DFN,IBJ(IBX),0)) S:$D(^DGPT(IBIDS(.08),70)) IBDSDT=+^(70) D NOPTF G:'$D(IBIDS(.08)) DISPAD G ENDDIS
- D HELPAD G DISPAD
- ;
- ENDDIS I $G(IBIDS(.08)) D
- .N PTF Q:'$D(^DGPT(IBIDS(.08),"M"))
- .S PTF=IBIDS(.08) D SC1^IBCSC6
- .W !?4,"PTF record indicates ",IBSCM," of ",IBM," movements are for Service Connected Care."
- .I IBSCM,IBSCM=IBM W !?4,*7,"Warning, PTF record indicates all movements are for Service Connected Care.",*7
- ;
- K IBCNT,IBI,IBJ,DGPERCNT,IBX,%,%DT Q
- ;
- NOPTF I $S(IBIDS(.08)="":1,'$D(^DGPT(IBIDS(.08),0)):1,1:0) K IBIDS(.08) W !!?4,*7,"PTF Record for this Admission is Missing",! Q
- Q
- HELPAD W !!?4,"Enter a number from 1 to ",IBCNT," to select the EVENT DATE. Inpatient",!?4,"admission dates are admissions for this VA Facility. Non-VA admissions",!?4,"are for Fee Basis admissions with associated PTF records."
- W !!?4,"Or you may enter a DATE in the past for which there is a Non-VA Admission",!?4,"without an associated PTF record",!
- Q
- IBCA0 ;ALB/AAS - ADD NEW BILLING RECORD-CONT. ;01 JUN 88 12:00
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;MAP TO DGCRA0
- +5 ;
- +6 ;moved from IBA (4.5) to split routine
- +7 ;
- CEOC1 WRITE !!,"ARE YOU BILLING FOR A CONTINUING EPISODE OF CARE"
- SET %=2
- DO YN^DICN
- IF %=2
- GOTO CHKINQ
- IF %=-1
- GOTO NREC^IBCA
- +1 IF '%
- WRITE !!?4,"YES - If this bill is for continuing care which has already been partially",!?9,"billed for on another bill.",!?4,"NO - If this is the initial bill for an episode of care."
- GOTO CEOC1
- +2 WRITE !
- DO EN4^IBCA3
- IF '$DATA(IBIDS(.17))
- GOTO CEOC1
- CHKINQ QUIT
- +1 ;
- IP WRITE !!?4,"ARE YOU BILLING FOR AN UNDISPLAYED EPISODE OF CARE"
- SET %=2
- DO YN^DICN
- +1 IF '%
- WRITE !!?4,"YES - If this bill is for an episode of care at a Non-VA facility",!?4," for which no PTF record exists.",!?4,"NO - If for VA care or you just made a mistake."
- GOTO IP
- +2 WRITE !
- SET DGPERCNT=%
- IF DGPERCNT=1
- SET IBIDS(162)=$ORDER(^DGCR(399.1,"B","STILL PATIENT",0))
- IP1 IF DGPERCNT'=1
- QUIT
- SET %DT="AEXP"
- SET %DT(0)=IBX
- SET %DT("A")=" NON-VA DISCHARGE DATE: "
- DO ^%DT
- KILL %DT
- IF X=""
- QUIT
- IF Y<1!(Y>DT)
- WRITE !!,"Enter a DISCHARGE DATE after the admission date and not greater than today!",!
- GOTO IP1
- +1 SET IBIDS(.16)=Y
- SET IBIDS(162)=$ORDER(^DGCR(399.1,"B",$EXTRACT("DISCHARGED TO HOME OR SELF CARE",1,30),0))
- +2 QUIT
- DISPAD ;display admissions
- +1 KILL IBIDS(.03),IBIDS(.08),IBI,IBJ,IBDSDT
- SET (IBI,IBJ)=""
- SET IBCNT=0
- +2 FOR I=0:0
- SET IBI=$ORDER(^DGPM("ATID1",DFN,IBI))
- IF IBI=""
- QUIT
- SET IBCNT=IBCNT+1
- SET IBI1=9999999.9999999-IBI
- SET IBI(IBCNT)=IBI1
- SET IBI(IBI1\1)=IBI1
- +3 FOR J=0:0
- SET IBJ=$ORDER(^DGPT("AFEE",DFN,IBJ))
- IF IBJ=""
- QUIT
- SET IBCNT=IBCNT+1
- SET IBJ(IBCNT)=IBJ
- SET IBJ(IBJ)=IBJ
- +4 IF 'IBCNT
- WRITE !!,"Patient has no admissions on file."
- +5 ;
- +6 WRITE !?4,$SELECT($ORDER(IBI(0))="":"THERE ARE NO INPATIENT EVENT (ADMISSION) DATES.",1:"Select INPATIENT EVENT (ADMISSION) DATE:")
- +7 FOR I=1:2
- IF '$DATA(IBI(I))
- QUIT
- SET Y=IBI(I)
- XECUTE ^DD("DD")
- WRITE !?8,I_" ",Y
- IF $DATA(IBI(I+1))
- SET Y=IBI(I+1)
- XECUTE ^DD("DD")
- WRITE ?40,I+1," ",Y
- +8 SET J=$ORDER(IBJ(0))
- IF J]""
- WRITE !?4,"OR",!?4,"Select NON-VA INPATIENT EVENT (ADMISSION) DATE:"
- FOR J=J:2
- IF '$DATA(IBJ(J))
- QUIT
- SET Y=IBJ(J)
- XECUTE ^DD("DD")
- WRITE !?8,J_" ",Y
- IF $DATA(IBJ(J+1))
- SET Y=IBJ(J+1)
- XECUTE ^DD("DD")
- WRITE ?40,J+1," ",Y
- +9 WRITE !!?4,$SELECT(IBCNT:"CHOOSE 1-"_IBCNT_" or ",1:""),"Enter DATE: "
- READ IBX:DTIME
- IF IBX="^"!(IBX="")!('$TEST)
- GOTO ENDDIS
- +10 IF IBX'?.N!(IBX<1)!(IBX>IBCNT)
- SET X=IBX
- SET %DT="EXP"
- SET %DT(0)="-NOW"
- DO ^%DT
- SET IBX=Y
- IF Y<1
- DO HELPAD
- GOTO DISPAD
- +11 IF IBX?7N.N
- DO IP
- IF DGPERCNT=1
- SET IBIDS(.03)=IBX
- SET IBDSDT=$SELECT($DATA(IBIDS(.16)):IBIDS(.16),1:"")
- SET IBIDS(160)=99
- SET IBIDS(159)=2
- SET IBIDS(158)=2
- GOTO ENDDIS
- +12 IF $DATA(IBI(IBX))
- SET IBIDS(.03)=IBI(IBX)
- SET IBIDS(.08)=$ORDER(^DGPM("ATID1",DFN,9999999.9999999-IBI(IBX),0))
- +13 IF $DATA(IBIDS(.08))
- IF $DATA(^DGPM(IBIDS(.08),0))
- SET IBIDS(.08)=$PIECE(^(0),"^",16)
- IF $PIECE(^(0),"^",17)]""
- SET IBDSDT=+^DGPM($PIECE(^(0),"^",17),0)
- DO NOPTF
- IF '$DATA(IBIDS(.08))
- GOTO DISPAD
- GOTO ENDDIS
- +14 IF $DATA(IBJ(IBX))
- SET IBIDS(.03)=IBJ(IBX)
- SET IBIDS(.08)=$ORDER(^DGPT("AFEE",DFN,IBJ(IBX),0))
- IF $DATA(^DGPT(IBIDS(.08),70))
- SET IBDSDT=+^(70)
- DO NOPTF
- IF '$DATA(IBIDS(.08))
- GOTO DISPAD
- GOTO ENDDIS
- +15 DO HELPAD
- GOTO DISPAD
- +16 ;
- ENDDIS IF $GET(IBIDS(.08))
- Begin DoDot:1
- +1 NEW PTF
- IF '$DATA(^DGPT(IBIDS(.08),"M"))
- QUIT
- +2 SET PTF=IBIDS(.08)
- DO SC1^IBCSC6
- +3 WRITE !?4,"PTF record indicates ",IBSCM," of ",IBM," movements are for Service Connected Care."
- +4 IF IBSCM
- IF IBSCM=IBM
- WRITE !?4,*7,"Warning, PTF record indicates all movements are for Service Connected Care.",*7
- End DoDot:1
- +5 ;
- +6 KILL IBCNT,IBI,IBJ,DGPERCNT,IBX,%,%DT
- QUIT
- +7 ;
- NOPTF IF $SELECT(IBIDS(.08)="":1,'$DATA(^DGPT(IBIDS(.08),0)):1,1:0)
- KILL IBIDS(.08)
- WRITE !!?4,*7,"PTF Record for this Admission is Missing",!
- QUIT
- +1 QUIT
- HELPAD WRITE !!?4,"Enter a number from 1 to ",IBCNT," to select the EVENT DATE. Inpatient",!?4,"admission dates are admissions for this VA Facility. Non-VA admissions",!?4,"are for Fee Basis admissions with associated PTF records."
- +1 WRITE !!?4,"Or you may enter a DATE in the past for which there is a Non-VA Admission",!?4,"without an associated PTF record",!
- +2 QUIT
