IBCSC8 ;ALB/MJB/AAS - MCCR SCREEN 8 (BILLING - CLAIM INFORMATION SCREEN) ;27 MAY 88 10:15
;;2.0;INTEGRATED BILLING;**432,447,488,577,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
;
EN D ^IBCSCU S IBSR=8,IBSR1="" S IB("U2")=$G(^DGCR(399,IBIFN,"U2")),IB("U4")=$G(^DGCR(399,IBIFN,"U4")),IB("U5")=$G(^DGCR(399,IBIFN,"U5")),IB("U6")=$G(^DGCR(399,IBIFN,"U6")),IB("U8")=$G(^DGCR(399,IBIFN,"U8"))
D H^IBCSCU
; DEM - IBV is set in EDI^IBCB => S IBAC=1,IBV=0 D EN G Q:'IBAC1,EDI
; IBV=0, or IBV=1 as a flag if field on screen is required
; or not. <Field #> indicates field is not required.
; [Field #]
; Make some sections NOT available for UB04 form
S IBT=$P($G(^DGCR(399,IBIFN,0)),U,19)
;S IBV1=$S(IBT=3:"001011",IBV:"111111",1:"000000")
;JWS;IB*2.0*592 US1108 - Dental
S IBV1=$S(IBT=3:"001011111",IBT=7:"0000",IBV:"111111111",1:"000000000") ; IB*2.0*488 (vd)
I IBT=7 D IBTEETH,DENTAL K IBTEETH ;G REV
;JWS;IB*2.0*592 -end
;JWS;IB*2.0*592 - US1108 add back Property Casualty Claim Number
I IBT'=7 S Z=1,IBW=1 X IBWW W " COB Non-Covered Charge Amt: " S X=$P(IB("U4"),U),X2="2$" I X'="" D COMMA^%DTC W X
S Z=$S(IBT=7:4,1:2) X IBWW W " Property Casualty Information"
;W !,?4,"Claim Number: ",$P(IB("U4"),U,2),?41,"Contact Name: ",$P(IB("U4"),U,9) ;JRA IB*2.0*577 ';'
W !,?4,"Claim Number: ",$P(IB("U4"),U,2) ;JRA IB*2.0*577
I IBT=7 G REV
;JWS;IB*2.0*592 / end
W !,?4,"Contact Name: ",$P(IB("U4"),U,9) ;JRA IB*2.0*577
W !,?4,"Date of 1st Contact: ",$$FMTE^XLFDT($P(IB("U4"),U,3)),?41,"Contact Phone: ",$P(IB("U4"),U,10)," ",$P(IB("U4"),U,11)
; Start IB*2.0*447 BI
;S Z=3 X IBWW W " Ambulance Information"
;W !,?41,"D/O Location: ",$P(IB("U6"),U)
;W !,?4,"P/U Address1: ",$P(IB("U5"),U,2),?41,"D/O Address1: ",$P(IB("U6"),U,2)
;W !,?4,"P/U Address2: ",$P(IB("U5"),U,3),?41,"D/O Address2: ",$P(IB("U6"),U,3)
;W !,?4,"P/U City: ",$P(IB("U5"),U,4),?41,"D/O City: ",$P(IB("U6"),U,4)
;W !,?4,"P/U State/Zip: " W:$P(IB("U5"),U,5)'="" $P($G(^DIC(5,$P(IB("U5"),U,5),0)),U,2)
;W:$P(IB("U5"),U,6)]"" "/"_$P(IB("U5"),U,6)
;W ?41,"D/O State/Zip: " W:$P(IB("U6"),U,5)'="" $P($G(^DIC(5,$P(IB("U6"),U,5),0)),U,2)
;W:$P(IB("U6"),U,6)]"" "/"_$P(IB("U6"),U,6)
;;W !,?4,"P/U Country/SubDiv: ",$P(IB("U5"),U),?41,"D/O Country/SubDiv: "
S Z=3 X IBWW W " Surgical Codes for Anesthesia Claims"
W !,?4,"Primary Code: " W:$P(IB("U4"),U,7)'="" $P($G(^ICPT($P(IB("U4"),U,7),0)),U)
W ?41,"Secondary Code: " W:$P(IB("U4"),U,8)'="" $P($G(^ICPT($P(IB("U4"),U,8),0)),U)
S Z=4 X IBWW W " Paperwork Attachment Information"
W !,?4,"Report Type: " W:$P(IB("U8"),U,2)'="" $P($G(^IBE(353.3,$P(IB("U8"),U,2),0)),U)
W ?41,"Transmission Method: ",$P(IB("U8"),U,3)
W !,?4,"Attachment Control #: ",$P(IB("U8"),U)
S Z=5 X IBWW W " Disability Start Date: ",$$FMTE^XLFDT($P(IB("U4"),U,4)),?41,"Disability End Date: ",$$FMTE^XLFDT($P(IB("U4"),U,5))
S Z=6 X IBWW W " Assumed Care Date: ",$$FMTE^XLFDT($P(IB("U4"),U,13)),?41,"Relinquished Care Date: ",$$FMTE^XLFDT($P(IB("U4"),U,14))
; End IB*2.0*447 BI
;
;/ Beginning of IB*2.0*488 - code moved from IBCSC10H (vd)
S Z=7 X IBWW W " Special Program: " I $P(IB("U2"),U,16)'="" S IBZ=$$EXPAND^IBTRE(399,238,$P(IB("U2"),U,16)) W $S(IBZ'="":IBZ,$$WNRBILL^IBEFUNC(IBIFN):"31",1:"")
S Z=8 X IBWW W " Homebound: ",$$EXPAND^IBTRE(399,236,$P(IB("U2"),U,14))
S Z=9 X IBWW W " Date Last Seen: ",$$EXPAND^IBTRE(399,237,$P(IB("U2"),U,15))
;/ End of IB*2.0*488 (vd)
REV G ^IBCSCP
;JWS;IB*2.0*592 US1108 - Dental
IBTEETH ;Create array of teeth status
N TH
K IBTEETH S IBTEETH=0
S IBTEETH(0)=+$P($G(^DGCR(399,IBIFN,"DEN1",0)),U,4)
S TH=0
F S TH=$O(^DGCR(399,IBIFN,"DEN1",TH)) Q:'TH S IBTEETH(TH)=$G(^DGCR(399,IBIFN,"DEN1",TH,0))
Q
;
DENTAL ;Dental Information for Form Type 7(J430D)
S IB("DEN")=$G(^DGCR(399,IBIFN,"DEN"))
S Z=1,IBW=1 X IBWW W ?4,"Tooth Status"
D WRT:$D(IBTEETH)
S Z=2,IBW=1 X IBWW W ?4,"Orthodontic Information"
W !?4,"Banding Date: " I $P(IB("DEN"),U)'="" W $$FMTE^XLFDT($P(IB("DEN"),U),2)
W !?4,"Treatment Months Count: ",$P(IB("DEN"),U,2)
W !?4,"Treatment Months Remaining Count: ",$P(IB("DEN"),U,3)
W !?4,"Treatment Indicator: ",$$GET1^DIQ(399,IBIFN_",",95,"E")
S Z=3,IBW=1 X IBWW W ?4,"Dental Paperwork Attachment"
W !?4,"Report Type: " I $P(IB("U8"),U,2)'="" W $$GET1^DIQ(353.3,$P(IB("U8"),U,2)_",",.01)," (",$E($$GET1^DIQ(353.3,$P(IB("U8"),U,2)_",",1),1,18),")"
W ?41,"Trans Method: " I $P(IB("U8"),U,3)'="" W $$GET1^DIQ(399,IBIFN_",",286,"I")," (",$E($$GET1^DIQ(399,IBIFN_",",286,"E"),1,20),")"
W !?4,"Attachment Control #: ",$P(IB("U8"),U)
Q
;
WRT ;write out teeth status on screen
N I,J
S J=0 F I=1:1 S J=$O(IBTEETH(J)) Q:'J D I I>6 D MORE Q
. W !?4,"Tooth Number: ",$P(IBTEETH(J),U),?41,"Status Code: ",$$GET1^DIQ(399.096,J_","_IBIFN_",",.02)
Q
;
MORE ;
W !?4,"***There are more teeth statuses associated with this bill.***" S I=0
Q
;end - JWS;IB*2.0*592 US1108 - Dental
;IBCSC8
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCSC8 5049 printed Apr 09, 2024@21:07:14 Page 2
IBCSC8 ;ALB/MJB/AAS - MCCR SCREEN 8 (BILLING - CLAIM INFORMATION SCREEN) ;27 MAY 88 10:15
+1 ;;2.0;INTEGRATED BILLING;**432,447,488,577,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
EN DO ^IBCSCU
SET IBSR=8
SET IBSR1=""
SET IB("U2")=$GET(^DGCR(399,IBIFN,"U2"))
SET IB("U4")=$GET(^DGCR(399,IBIFN,"U4"))
SET IB("U5")=$GET(^DGCR(399,IBIFN,"U5"))
SET IB("U6")=$GET(^DGCR(399,IBIFN,"U6"))
SET IB("U8")=$GET(^DGCR(399,IBIFN,"U8"))
+1 DO H^IBCSCU
+2 ; DEM - IBV is set in EDI^IBCB => S IBAC=1,IBV=0 D EN G Q:'IBAC1,EDI
+3 ; IBV=0, or IBV=1 as a flag if field on screen is required
+4 ; or not. <Field #> indicates field is not required.
+5 ; [Field #]
+6 ; Make some sections NOT available for UB04 form
+7 SET IBT=$PIECE($GET(^DGCR(399,IBIFN,0)),U,19)
+8 ;S IBV1=$S(IBT=3:"001011",IBV:"111111",1:"000000")
+9 ;JWS;IB*2.0*592 US1108 - Dental
+10 ; IB*2.0*488 (vd)
SET IBV1=$SELECT(IBT=3:"001011111",IBT=7:"0000",IBV:"111111111",1:"000000000")
+11 ;G REV
IF IBT=7
DO IBTEETH
DO DENTAL
KILL IBTEETH
+12 ;JWS;IB*2.0*592 -end
+13 ;JWS;IB*2.0*592 - US1108 add back Property Casualty Claim Number
+14 IF IBT'=7
SET Z=1
SET IBW=1
XECUTE IBWW
WRITE " COB Non-Covered Charge Amt: "
SET X=$PIECE(IB("U4"),U)
SET X2="2$"
IF X'=""
DO COMMA^%DTC
WRITE X
+15 SET Z=$SELECT(IBT=7:4,1:2)
XECUTE IBWW
WRITE " Property Casualty Information"
+16 ;W !,?4,"Claim Number: ",$P(IB("U4"),U,2),?41,"Contact Name: ",$P(IB("U4"),U,9) ;JRA IB*2.0*577 ';'
+17 ;JRA IB*2.0*577
WRITE !,?4,"Claim Number: ",$PIECE(IB("U4"),U,2)
+18 IF IBT=7
GOTO REV
+19 ;JWS;IB*2.0*592 / end
+20 ;JRA IB*2.0*577
WRITE !,?4,"Contact Name: ",$PIECE(IB("U4"),U,9)
+21 WRITE !,?4,"Date of 1st Contact: ",$$FMTE^XLFDT($PIECE(IB("U4"),U,3)),?41,"Contact Phone: ",$PIECE(IB("U4"),U,10)," ",$PIECE(IB("U4"),U,11)
+22 ; Start IB*2.0*447 BI
+23 ;S Z=3 X IBWW W " Ambulance Information"
+24 ;W !,?41,"D/O Location: ",$P(IB("U6"),U)
+25 ;W !,?4,"P/U Address1: ",$P(IB("U5"),U,2),?41,"D/O Address1: ",$P(IB("U6"),U,2)
+26 ;W !,?4,"P/U Address2: ",$P(IB("U5"),U,3),?41,"D/O Address2: ",$P(IB("U6"),U,3)
+27 ;W !,?4,"P/U City: ",$P(IB("U5"),U,4),?41,"D/O City: ",$P(IB("U6"),U,4)
+28 ;W !,?4,"P/U State/Zip: " W:$P(IB("U5"),U,5)'="" $P($G(^DIC(5,$P(IB("U5"),U,5),0)),U,2)
+29 ;W:$P(IB("U5"),U,6)]"" "/"_$P(IB("U5"),U,6)
+30 ;W ?41,"D/O State/Zip: " W:$P(IB("U6"),U,5)'="" $P($G(^DIC(5,$P(IB("U6"),U,5),0)),U,2)
+31 ;W:$P(IB("U6"),U,6)]"" "/"_$P(IB("U6"),U,6)
+32 ;;W !,?4,"P/U Country/SubDiv: ",$P(IB("U5"),U),?41,"D/O Country/SubDiv: "
+33 SET Z=3
XECUTE IBWW
WRITE " Surgical Codes for Anesthesia Claims"
+34 WRITE !,?4,"Primary Code: "
if $PIECE(IB("U4"),U,7)'=""
WRITE $PIECE($GET(^ICPT($PIECE(IB("U4"),U,7),0)),U)
+35 WRITE ?41,"Secondary Code: "
if $PIECE(IB("U4"),U,8)'=""
WRITE $PIECE($GET(^ICPT($PIECE(IB("U4"),U,8),0)),U)
+36 SET Z=4
XECUTE IBWW
WRITE " Paperwork Attachment Information"
+37 WRITE !,?4,"Report Type: "
if $PIECE(IB("U8"),U,2)'=""
WRITE $PIECE($GET(^IBE(353.3,$PIECE(IB("U8"),U,2),0)),U)
+38 WRITE ?41,"Transmission Method: ",$PIECE(IB("U8"),U,3)
+39 WRITE !,?4,"Attachment Control #: ",$PIECE(IB("U8"),U)
+40 SET Z=5
XECUTE IBWW
WRITE " Disability Start Date: ",$$FMTE^XLFDT($PIECE(IB("U4"),U,4)),?41,"Disability End Date: ",$$FMTE^XLFDT($PIECE(IB("U4"),U,5))
+41 SET Z=6
XECUTE IBWW
WRITE " Assumed Care Date: ",$$FMTE^XLFDT($PIECE(IB("U4"),U,13)),?41,"Relinquished Care Date: ",$$FMTE^XLFDT($PIECE(IB("U4"),U,14))
+42 ; End IB*2.0*447 BI
+43 ;
+44 ;/ Beginning of IB*2.0*488 - code moved from IBCSC10H (vd)
+45 SET Z=7
XECUTE IBWW
WRITE " Special Program: "
IF $PIECE(IB("U2"),U,16)'=""
SET IBZ=$$EXPAND^IBTRE(399,238,$PIECE(IB("U2"),U,16))
WRITE $SELECT(IBZ'="":IBZ,$$WNRBILL^IBEFUNC(IBIFN):"31",1:"")
+46 SET Z=8
XECUTE IBWW
WRITE " Homebound: ",$$EXPAND^IBTRE(399,236,$PIECE(IB("U2"),U,14))
+47 SET Z=9
XECUTE IBWW
WRITE " Date Last Seen: ",$$EXPAND^IBTRE(399,237,$PIECE(IB("U2"),U,15))
+48 ;/ End of IB*2.0*488 (vd)
REV GOTO ^IBCSCP
+1 ;JWS;IB*2.0*592 US1108 - Dental
IBTEETH ;Create array of teeth status
+1 NEW TH
+2 KILL IBTEETH
SET IBTEETH=0
+3 SET IBTEETH(0)=+$PIECE($GET(^DGCR(399,IBIFN,"DEN1",0)),U,4)
+4 SET TH=0
+5 FOR
SET TH=$ORDER(^DGCR(399,IBIFN,"DEN1",TH))
if 'TH
QUIT
SET IBTEETH(TH)=$GET(^DGCR(399,IBIFN,"DEN1",TH,0))
+6 QUIT
+7 ;
DENTAL ;Dental Information for Form Type 7(J430D)
+1 SET IB("DEN")=$GET(^DGCR(399,IBIFN,"DEN"))
+2 SET Z=1
SET IBW=1
XECUTE IBWW
WRITE ?4,"Tooth Status"
+3 if $DATA(IBTEETH)
DO WRT
+4 SET Z=2
SET IBW=1
XECUTE IBWW
WRITE ?4,"Orthodontic Information"
+5 WRITE !?4,"Banding Date: "
IF $PIECE(IB("DEN"),U)'=""
WRITE $$FMTE^XLFDT($PIECE(IB("DEN"),U),2)
+6 WRITE !?4,"Treatment Months Count: ",$PIECE(IB("DEN"),U,2)
+7 WRITE !?4,"Treatment Months Remaining Count: ",$PIECE(IB("DEN"),U,3)
+8 WRITE !?4,"Treatment Indicator: ",$$GET1^DIQ(399,IBIFN_",",95,"E")
+9 SET Z=3
SET IBW=1
XECUTE IBWW
WRITE ?4,"Dental Paperwork Attachment"
+10 WRITE !?4,"Report Type: "
IF $PIECE(IB("U8"),U,2)'=""
WRITE $$GET1^DIQ(353.3,$PIECE(IB("U8"),U,2)_",",.01)," (",$EXTRACT($$GET1^DIQ(353.3,$PIECE(IB("U8"),U,2)_",",1),1,18),")"
+11 WRITE ?41,"Trans Method: "
IF $PIECE(IB("U8"),U,3)'=""
WRITE $$GET1^DIQ(399,IBIFN_",",286,"I")," (",$EXTRACT($$GET1^DIQ(399,IBIFN_",",286,"E"),1,20),")"
+12 WRITE !?4,"Attachment Control #: ",$PIECE(IB("U8"),U)
+13 QUIT
+14 ;
WRT ;write out teeth status on screen
+1 NEW I,J
+2 SET J=0
FOR I=1:1
SET J=$ORDER(IBTEETH(J))
if 'J
QUIT
Begin DoDot:1
+3 WRITE !?4,"Tooth Number: ",$PIECE(IBTEETH(J),U),?41,"Status Code: ",$$GET1^DIQ(399.096,J_","_IBIFN_",",.02)
End DoDot:1
IF I>6
DO MORE
QUIT
+4 QUIT
+5 ;
MORE ;
+1 WRITE !?4,"***There are more teeth statuses associated with this bill.***"
SET I=0
+2 QUIT
+3 ;end - JWS;IB*2.0*592 US1108 - Dental
+4 ;IBCSC8
