IBCSC7 ;ALB/MJB - MCCR SCREEN 7 (INPT. BILLING INFO) ;27 MAY 88 10:19
;;2.0;INTEGRATED BILLING;**52,80,109,106,343,400,432,623**;21-MAR-94;Build 70
;;Per VA Directive 6402, this routine should not be modified.
;
;MAP TO DGCRSC7
;
I $P(^DGCR(399,IBIFN,0),"^",5)'>2 G ^IBCSC8
I $D(DGRVRCAL) D ^IBCU6 K DGRVRCAL
EN D ^IBCSCU S IBSR=7,IBSR1="",IBV1="0000000" S:IBV IBV1="1111111" F I="U","U1",0,"U2","U3" S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")
D H^IBCSCU
D 4^IBCVA1,5^IBCVA1
S IBBT=$P(IB(0),U,24)_$P($G(^DGCR(399.1,+$P(IB(0),U,25),0)),U,2)_$P(IB(0),U,26)
S Z=1,IBW=1 X IBWW W " Bill Type : ",$S('$D(IBBT):IBU,IBBT="":IBU,1:IBBT)
W $J("",14),"Loc. of Care: ",$E($G(IBBTP1),1,30) K IBBTP1
; IB*2.0*432 - remove Covered, Non-covered and co-insurance days
;W !?4,"Covered Days: ",$S(IB("U2")="":IBU,$P(IB("U2"),U,2)'="":$P(IB("U2"),U,2),1:IBU)
W !?4,"Charge Type : ",$S($P(IB(0),U,27)=1:"INSTITUTIONAL",$P(IB(0),U,27)=2:"PROFESSIONAL",1:IBU)
W ?37,"Disch Stat: ",$E($$EXTERNAL^DILFD(399,162,"",$P(IB("U"),U,12)),1,30)
W !?4,"Form Type : ",$P($G(^IBE(353,+$P(IB(0),U,19),0)),U,1)
W ?38,"Timeframe: ",$S($D(IBBTP3):$E(IBBTP3,1,30),1:"") K IBBTP3
W !,?4,"Bill Classif: ",$E($G(IBBTP2),1,30) K IBBTP2
;W !?4,"Non-Cov Days: ",$S(IB("U2")="":IBU,$P(IB("U2"),U,3)'="":$P(IB("U2"),U,3),1:IBU)
W ?39,"Division: ",$E($P($G(^DG(40.8,+$P(IB(0),U,22),0)),U,1),1,30)
;
ROI S Z=2,IBW=1 X IBWW
W " Sensitive? : ",$S(IB("U")="":IBU,$P(IB("U"),U,5)="":IBU,$P(IB("U"),U,5)=1:"YES",1:"NO")
W ?46,"Assignment: ",$S(IB("U")="":IBU,$P(IB("U"),U,6)="":IBU,$P(IB("U"),U,6)["n":"NO",$P(IB("U"),U,6)["N":"NO",$P(IB("U"),U,6)=0:"NO",1:"YES")
;/vd - IB*2.0*623 (US4995) - Modified the following line of code with the following conditional to validate that a
; claim is ROI Eligible based upon the Date of Service.
;I $P(IB("U"),U,5)=1 W !?4,"R.O.I. Form : ",$S($P(IB("U"),U,7)=1:"COMPLETED",$P(IB("U"),U,7)=0:"NOT COMPLETED",1:"STATUS UNKNOWN")
I $$ROIDTCK^IBCEU7(IBIFN) D
. I $P(IB("U"),U,5)=1 W !?4,"R.O.I. Form : ",$S($P(IB("U"),U,7)=1:"COMPLETED",$P(IB("U"),U,7)=0:"NOT COMPLETED",1:"STATUS UNKNOWN")
S IBOA="01^02^03^04^05^06^" F I=1:1:5 Q:'$D(IBOCN(I)) I IBOA[IBOCN(I)_"^" S IBOX=1
W:$D(IBOX) !,?4,"Pow of Atty : ",$S($P(IB("U"),U,3)=1:"COMPLETED",$P(IB("U"),U,3)=0:"NOT COMPLETED",1:"STATUS UNKNOWN")
;
S Z=3,IBW=1 X IBWW D FROMTO^IBCSC6
;
OP S Z=4,IBW=1 X IBWW W " OP Visits : " F I=0:0 S I=$O(^DGCR(399,IBIFN,"OP",I)) Q:'I S Y=I X ^DD("DD") W:$X>67 !?18 W Y_", "
I '$O(^DGCR(399,IBIFN,"OP",0)) W IBU
;
G REV^IBCSC6
;
;IBCSC7
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCSC7 2622 printed Apr 09, 2024@21:34:12 Page 2
IBCSC7 ;ALB/MJB - MCCR SCREEN 7 (INPT. BILLING INFO) ;27 MAY 88 10:19
+1 ;;2.0;INTEGRATED BILLING;**52,80,109,106,343,400,432,623**;21-MAR-94;Build 70
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCRSC7
+5 ;
+6 IF $PIECE(^DGCR(399,IBIFN,0),"^",5)'>2
GOTO ^IBCSC8
+7 IF $DATA(DGRVRCAL)
DO ^IBCU6
KILL DGRVRCAL
EN DO ^IBCSCU
SET IBSR=7
SET IBSR1=""
SET IBV1="0000000"
if IBV
SET IBV1="1111111"
FOR I="U","U1",0,"U2","U3"
SET IB(I)=$SELECT($DATA(^DGCR(399,IBIFN,I)):^(I),1:"")
+1 DO H^IBCSCU
+2 DO 4^IBCVA1
DO 5^IBCVA1
+3 SET IBBT=$PIECE(IB(0),U,24)_$PIECE($GET(^DGCR(399.1,+$PIECE(IB(0),U,25),0)),U,2)_$PIECE(IB(0),U,26)
+4 SET Z=1
SET IBW=1
XECUTE IBWW
WRITE " Bill Type : ",$SELECT('$DATA(IBBT):IBU,IBBT="":IBU,1:IBBT)
+5 WRITE $JUSTIFY("",14),"Loc. of Care: ",$EXTRACT($GET(IBBTP1),1,30)
KILL IBBTP1
+6 ; IB*2.0*432 - remove Covered, Non-covered and co-insurance days
+7 ;W !?4,"Covered Days: ",$S(IB("U2")="":IBU,$P(IB("U2"),U,2)'="":$P(IB("U2"),U,2),1:IBU)
+8 WRITE !?4,"Charge Type : ",$SELECT($PIECE(IB(0),U,27)=1:"INSTITUTIONAL",$PIECE(IB(0),U,27)=2:"PROFESSIONAL",1:IBU)
+9 WRITE ?37,"Disch Stat: ",$EXTRACT($$EXTERNAL^DILFD(399,162,"",$PIECE(IB("U"),U,12)),1,30)
+10 WRITE !?4,"Form Type : ",$PIECE($GET(^IBE(353,+$PIECE(IB(0),U,19),0)),U,1)
+11 WRITE ?38,"Timeframe: ",$SELECT($DATA(IBBTP3):$EXTRACT(IBBTP3,1,30),1:"")
KILL IBBTP3
+12 WRITE !,?4,"Bill Classif: ",$EXTRACT($GET(IBBTP2),1,30)
KILL IBBTP2
+13 ;W !?4,"Non-Cov Days: ",$S(IB("U2")="":IBU,$P(IB("U2"),U,3)'="":$P(IB("U2"),U,3),1:IBU)
+14 WRITE ?39,"Division: ",$EXTRACT($PIECE($GET(^DG(40.8,+$PIECE(IB(0),U,22),0)),U,1),1,30)
+15 ;
ROI SET Z=2
SET IBW=1
XECUTE IBWW
+1 WRITE " Sensitive? : ",$SELECT(IB("U")="":IBU,$PIECE(IB("U"),U,5)="":IBU,$PIECE(IB("U"),U,5)=1:"YES",1:"NO")
+2 WRITE ?46,"Assignment: ",$SELECT(IB("U")="":IBU,$PIECE(IB("U"),U,6)="":IBU,$PIECE(IB("U"),U,6)["n":"NO",$PIECE(IB("U"),U,6)["N":"NO",$PIECE(IB("U"),U,6)=0:"NO",1:"YES")
+3 ;/vd - IB*2.0*623 (US4995) - Modified the following line of code with the following conditional to validate that a
+4 ; claim is ROI Eligible based upon the Date of Service.
+5 ;I $P(IB("U"),U,5)=1 W !?4,"R.O.I. Form : ",$S($P(IB("U"),U,7)=1:"COMPLETED",$P(IB("U"),U,7)=0:"NOT COMPLETED",1:"STATUS UNKNOWN")
+6 IF $$ROIDTCK^IBCEU7(IBIFN)
Begin DoDot:1
+7 IF $PIECE(IB("U"),U,5)=1
WRITE !?4,"R.O.I. Form : ",$SELECT($PIECE(IB("U"),U,7)=1:"COMPLETED",$PIECE(IB("U"),U,7)=0:"NOT COMPLETED",1:"STATUS UNKNOWN")
End DoDot:1
+8 SET IBOA="01^02^03^04^05^06^"
FOR I=1:1:5
if '$DATA(IBOCN(I))
QUIT
IF IBOA[IBOCN(I)_"^"
SET IBOX=1
+9 if $DATA(IBOX)
WRITE !,?4,"Pow of Atty : ",$SELECT($PIECE(IB("U"),U,3)=1:"COMPLETED",$PIECE(IB("U"),U,3)=0:"NOT COMPLETED",1:"STATUS UNKNOWN")
+10 ;
+11 SET Z=3
SET IBW=1
XECUTE IBWW
DO FROMTO^IBCSC6
+12 ;
OP SET Z=4
SET IBW=1
XECUTE IBWW
WRITE " OP Visits : "
FOR I=0:0
SET I=$ORDER(^DGCR(399,IBIFN,"OP",I))
if 'I
QUIT
SET Y=I
XECUTE ^DD("DD")
if $X>67
WRITE !?18
WRITE Y_", "
+1 IF '$ORDER(^DGCR(399,IBIFN,"OP",0))
WRITE IBU
+2 ;
+3 GOTO REV^IBCSC6
+4 ;
+5 ;IBCSC7
