IBCA0 ;ALB/AAS - ADD NEW BILLING RECORD-CONT. ;01 JUN 88 12:00
;;2.0;INTEGRATED BILLING;**51,714**;21-MAR-94;Build 8
;;Per VHA Directive 10-93-142, this routine should not be modified.
; DBIA REFERENCE TO ^DGPM("ATID1") = DBIA419
; reference to ^DGPT(0), piece 14 = DBIA418
;
;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(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 IBIDS(.28)=$P($P(^DGPT(IBIDS(.08),0),U,14),".") ; IB*2.0*714
.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 I IBCNT D
. 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",!
E D
. W !!?4,"Enter a DATE in the past for which there is a Non-VA Admission",!?4,"without an associated PTF record",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCA0 4045 printed Nov 22, 2024@17:18:35 Page 2
IBCA0 ;ALB/AAS - ADD NEW BILLING RECORD-CONT. ;01 JUN 88 12:00
+1 ;;2.0;INTEGRATED BILLING;**51,714**;21-MAR-94;Build 8
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ; DBIA REFERENCE TO ^DGPM("ATID1") = DBIA419
+4 ; reference to ^DGPT(0), piece 14 = DBIA418
+5 ;
+6 ;MAP TO DGCRA0
+7 ;
+8 ;moved from IBA (4.5) to split routine
+9 ;
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(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 ; IB*2.0*714
SET IBIDS(.28)=$PIECE($PIECE(^DGPT(IBIDS(.08),0),U,14),".")
+3 SET PTF=IBIDS(.08)
DO SC1^IBCSC6
+4 WRITE !?4,"PTF record indicates ",IBSCM," of ",IBM," movements are for Service Connected Care."
+5 IF IBSCM
IF IBSCM=IBM
WRITE !?4,*7,"Warning, PTF record indicates all movements are for Service Connected Care.",*7
End DoDot:1
+6 ;
+7 KILL IBCNT,IBI,IBJ,DGPERCNT,IBX,%,%DT
QUIT
+8 ;
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 IF IBCNT
Begin DoDot:1
+1 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."
+2 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",!
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 WRITE !!?4,"Enter a DATE in the past for which there is a Non-VA Admission",!?4,"without an associated PTF record",!
End DoDot:1
+5 QUIT
