IBVCB ;LITS/MRD - VIEW CANCELLED BILL ;25-JUN-14
;;2.0;INTEGRATED BILLING;**516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
; The View Cancelled Bill option allows the user to view the values
; of many fields of a cancelled bill. The user may select a patient,
; and then pick from a list of that patient's cancelled claims, or
; simply enter a claim number. Claims that do not have a Status of
; 'Cancelled' cannot be selected.
; The user may also select the device to which the report will be
; printed.
; For many of the sections on this report, if there is no data, the
; report will display a message stating 'No Data' rather than print
; the labels without any data following them.
;
EN ; Main Entry Point.
;
N IBHEADER,IBIFN,IBPAGE,IBQUIT,IBTEXT
;
EN1 ;
;
S IBQUIT=0
;
D SELECT I IBQUIT G ENQ
;
D DEVICE I IBQUIT G ENQ
;
D DISPLAY
;
G EN1
;
ENQ ;
;
D ^%ZISC
;
Q
;
SELECT ; Prompt user for patient or bill.
;
N DIC,X,Y
;
W !
S DIC="^DGCR(399,"
S DIC(0)="AEMQZ"
S DIC("A")="Enter BILL NUMBER or PATIENT NAME: "
; Status of bill must be 7/Cancelled.
S DIC("S")="I $P($G(^DGCR(399,Y,0)),U,13)=7"
D ^DIC
;
I X["^"!(X="") S IBQUIT=1 G SELECTQ
;
S IBIFN=$P(Y,U,1)
I IBIFN="" S IBQUIT=1
;
SELECTQ ;
Q
;
DEVICE ; Allow user to select the device.
;
S %ZIS=""
D ^%ZIS
I POP S IBQUIT=1
;
Q
;
DISPLAY ; Display claim information to user.
;
D HEADERA
;
D PART1 I IBQUIT Q
D PART2^IBVCB1 I IBQUIT Q
D PART3^IBVCB2
;
Q
;
;
; IBHEADER = Patient Name ^ Full SSN ^ Last 4 of SSN.
;
S IBHEADER=$$PT^IBEFUNC($$GET1^DIQ(399,IBIFN_",",.02,"I"))
S IBPAGE=0
;
D HEADERB
;
Q
;
;
S IBPAGE=IBPAGE+1
I $E(IOST,1,2)="C-",IBPAGE>1 D CONTINUE
W @IOF ; Print the device-specific form feed sequence.
W !,$P(IBHEADER,U,1)
I $P(IBHEADER,U,3)'="" W " "_$E(IBHEADER,1)_$P(IBHEADER,U,3)
W ?41,$$GET1^DIQ(399,IBIFN_",",.17,"E")
W ?72,"Page ",$J(IBPAGE,2)
W !,"==============================================================================="
;
Q
;
CONTINUE ; Enter return to continue.
;
W !
N DIR
S DIR(0)="E"
D ^DIR
I 'Y S IBQUIT=1
W $C(13)," ",$C(13)
Q
;
LINE(IBTEXT) ; Print the lines of information in the IBTEXT array.
;
; IBTEXT is passed by reference. The first subscript is an integer
; representing the relative line number (1, 2, 3, etc.). The second
; subscript will be '1' or '2'.
; IBTEXT(x,1) = Text to be printed in the 1st column.
; IBTEXT(x,2) = Text to be printed in the 2nd column, if any.
; The IBTEXT array is Killed off before Quitting out. This resets
; the array so the rest of the code does not have to.
;
N IBX
;
; The number of lines to be printed is found by $O(IBTEXT(""),-1).
; $Y represents the line on the page of the printer or line on the
; screen if printing to a terminal. If there is not enough space
; remaining on the current page to display the number of lines
; in IBTEXT, then it calls HEADERB, which Writes a form feed and
; prints the header. $Y is reset to 0 by the statement W @IOF
; in the HEADERB procedure.
;
S IBX=$O(IBTEXT(""),-1) ; How many lines are to be printed.
I $Y>(IOSL-(IBX+3)) D HEADERB
;
S IBX=""
F S IBX=$O(IBTEXT(IBX)) Q:IBX="" D
. W !
. I $D(IBTEXT(IBX,1)) W IBTEXT(IBX,1)
. I $D(IBTEXT(IBX,2)) W ?41,IBTEXT(IBX,2)
. Q
K IBTEXT
Q
;
DOLLAR(X) ; Function to return a formatted dollar amount.
;
I $G(X)="" Q ""
N X2,X3
S X2="2$",X3=0
D COMMA^%DTC
Q X
;
PART1 ; General Claim Data, Other Care, Codes.
;
N IBBT,IBFIND,IBX
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="General Claim Data"
S IBTEXT(3,1)="------------------"
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Primary Bill: "_$$GET1^DIQ(399,IBIFN_",",.17,"E")
S IBTEXT(1,2)="Event Date: "_$$GET1^DIQ(399,IBIFN_",",.03,"E")
S IBTEXT(2,1)="Rate Type: "_$$GET1^DIQ(399,IBIFN_",",.07,"E")
S IBTEXT(2,2)="Outpt Visit Date: "
S IBX=$O(^DGCR(399,IBIFN,"OP",0))
I IBX'="" S IBTEXT(2,2)=IBTEXT(2,2)_$$GET1^DIQ(399.043,IBX_","_IBIFN_",",.01,"E")
D LINE(.IBTEXT)
; Look for more Outpt Visit Dates.
F S IBX=$O(^DGCR(399,IBIFN,"OP",IBX)) Q:'IBX D
. S IBTEXT(1,2)="Outpt Visit Date: "_$$GET1^DIQ(399.043,IBX_","_IBIFN_",",.01,"E")
. D LINE(.IBTEXT)
. Q
;
S IBTEXT(1,1)="Responsible Party: "_$$GET1^DIQ(399,IBIFN_",",.11,"E")
S IBTEXT(1,2)="Service Fac. Taxonomy: "_$$GET1^DIQ(399,IBIFN_",",243,"E")
S IBTEXT(2,1)="Responsible Institution: "_$$GET1^DIQ(399,IBIFN_",",111,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Timeframe: "_$$GET1^DIQ(399,IBIFN_",",.06,"E")
S IBTEXT(1,2)="Default Division: "_$$GET1^DIQ(399,IBIFN_",",.22,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Charge Type: "_$$GET1^DIQ(399,IBIFN_",",.27,"E")
S IBTEXT(1,2)="Assignment of Benefits: "_$$GET1^DIQ(399,IBIFN_",",156,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="LOC: "_$$GET1^DIQ(399,IBIFN_",",.04,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="D/C Status: "_$$GET1^DIQ(399,IBIFN_",",162,"E")
S IBTEXT(2,1)="D/C Bedsection: "_$$GET1^DIQ(399,IBIFN_",",161,"E")
S IBTEXT(2,2)="Form Type: "_$$GET1^DIQ(399,IBIFN_",",.19,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Bill Classification: "_$$GET1^DIQ(399,IBIFN_",",.05,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Statement From: "_$$GET1^DIQ(399,IBIFN_",",151,"E")
S IBTEXT(1,2)="Statement To: "_$$GET1^DIQ(399,IBIFN_",",152,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Sensitive?: "_$$GET1^DIQ(399,IBIFN_",",155,"E")
S IBTEXT(1,2)="ROI Complete?: "_$$GET1^DIQ(399,IBIFN_",",157,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Admission Type: "_$$GET1^DIQ(399,IBIFN_",",158,"E")
S IBTEXT(1,2)="Admission Source: "_$$GET1^DIQ(399,IBIFN_",",159,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Non-PTF Admission Hr.: "_$$GET1^DIQ(399,IBIFN_",",159.5,"E")
S IBTEXT(1,2)="Admitting DX: "_$$GET1^DIQ(399,IBIFN_",",215,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Accident Hr.: "_$$GET1^DIQ(399,IBIFN_",",160,"E")
S IBTEXT(1,2)="Co-Insurance Days: "_$$GET1^DIQ(399,IBIFN_",",221,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Covered Days: "_$$GET1^DIQ(399,IBIFN_",",216,"E")
S IBTEXT(1,2)="Non-Covered Days: "_$$GET1^DIQ(399,IBIFN_",",217,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Length of Stay: "_$$GET1^DIQ(399,IBIFN_",",165,"E")
S IBTEXT(1,2)="PPS: "_$$GET1^DIQ(399,IBIFN_",",170,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Total Charge: "_$$DOLLAR($$GET1^DIQ(399,IBIFN_",",201,"E"))
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Unable to Work From: "_$$GET1^DIQ(399,IBIFN_",",166,"E")
S IBTEXT(1,2)="Unable to Work To: "_$$GET1^DIQ(399,IBIFN_",",167,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Current Payer Seq.: "_$$GET1^DIQ(399,IBIFN_",",.21,"E")
S IBTEXT(1,2)="SC: "_$$GET1^DIQ(399,IBIFN_",",.18,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Status: "_$$GET1^DIQ(399,IBIFN_",",.13,"E")
S IBTEXT(1,2)="Status Date: "_$$GET1^DIQ(399,IBIFN_",",.14,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Bill Copied From: "_$$GET1^DIQ(399,IBIFN_",",.15,"E")
S IBTEXT(1,2)="PTF Record #: "_$$GET1^DIQ(399,IBIFN_",",.08,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Procedure Coding Method: "_$$GET1^DIQ(399,IBIFN_",",.09,"E")
D LINE(.IBTEXT)
;
S IBBT=$$GET1^DIQ(399,IBIFN_",",.25,"I")
I IBBT'="" S IBBT=$P($G(^DGCR(399.1,IBBT,0)),U,2),IBBT=$$GET1^DIQ(399,IBIFN_",",.24,"I")_IBBT_$$GET1^DIQ(399,IBIFN_",",.26,"I")
;
S IBTEXT(1,1)="Bill Type: "_IBBT
S IBTEXT(1,2)="Non-VA D/C Date: "_$$GET1^DIQ(399,IBIFN_",",.16,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Mammography No.: "_$$GET1^DIQ(399,IBIFN_",",242,"E")
S IBTEXT(1,2)="CLIA No.: "_$$GET1^DIQ(399,IBIFN_",",235,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Special Program Indicator: "_$$GET1^DIQ(399,IBIFN_",",238,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Forced to Print: "_$$GET1^DIQ(399,IBIFN_",",27,"E")
S IBTEXT(1,2)="MRA Secondary Forced to Print: "_$$GET1^DIQ(399,IBIFN_",",28,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="COB Total Non-Covered Amt: "_$$DOLLAR($$GET1^DIQ(399,IBIFN_",",260,"E"))
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Disability Start Date: "_$$GET1^DIQ(399,IBIFN_",",263,"E")
S IBTEXT(1,2)="Disability End Date: "_$$GET1^DIQ(399,IBIFN_",",264,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Prim Surgical Proc: "_$$GET1^DIQ(399,IBIFN_",",266,"E")
S IBTEXT(1,2)="Sec Surgical Proc: "_$$GET1^DIQ(399,IBIFN_",",267,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Relinquish Care Date: "_$$GET1^DIQ(399,IBIFN_",",283,"E")
S IBTEXT(1,2)="Assumed Care Date: "_$$GET1^DIQ(399,IBIFN_",",282,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)="Attachment Report Type: "_$$GET1^DIQ(399,IBIFN_",",285,"E")
S IBTEXT(2,1)="Attachment Report Transmit Method: "_$$GET1^DIQ(399,IBIFN_",",286,"E")
S IBTEXT(3,1)="Attachment Control No.: "_$$GET1^DIQ(399,IBIFN_",",284,"E")
D LINE(.IBTEXT)
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Other Care"
S IBTEXT(3,1)="----------"
D LINE(.IBTEXT)
;
S IBFIND=0,IBX=0
F S IBX=$O(^DGCR(399,IBIFN,"OT",IBX)) Q:'IBX D
. S IBFIND=1
. S IBTEXT(1,1)="Other Care: "_$$GET1^DIQ(399.048,IBX_","_IBIFN_",",.01,"E")
. S IBTEXT(2,1)="Other Care Date(s): "_$$GET1^DIQ(399.048,IBX_","_IBIFN_",",.02,"E")_" - "_$$GET1^DIQ(399.048,IBX_","_IBIFN_",",.03,"E")
. D LINE(.IBTEXT)
. Q
I 'IBFIND D
. S IBTEXT(1,1)="*** No Other Care Data Found ***"
. D LINE(.IBTEXT)
. Q
;
S IBTEXT(1,1)=""
S IBTEXT(2,1)="Codes"
S IBTEXT(3,1)="-----"
D LINE(.IBTEXT)
;
S IBFIND=0,IBX=0
F S IBX=$O(^DGCR(399,IBIFN,"CC",IBX)) Q:'IBX D
. S IBFIND=1
. S IBTEXT(1,1)="Condition Code: "_$$GET1^DIQ(399.04,IBX_","_IBIFN_",",.01,"E")
. D LINE(.IBTEXT)
. Q
I 'IBFIND D
. S IBTEXT(1,1)="*** No Condition Codes Found ***"
. D LINE(.IBTEXT)
. Q
;
S IBFIND=0,IBX=0
F S IBX=$O(^DGCR(399,IBIFN,"OC",IBX)) Q:'IBX D
. S IBFIND=1
. S IBTEXT(1,1)="Occurrence Code: "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.01,"E")
. S IBTEXT(1,2)="Occurrence State: "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.03,"E")
. S IBTEXT(2,1)="Occ. Date(s): "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.02,"E")_" - "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.04,"E")
. D LINE(.IBTEXT)
. Q
I 'IBFIND D
. S IBTEXT(1,1)="*** No Occurrence Codes Found ***"
. D LINE(.IBTEXT)
. Q
;
S IBFIND=0,IBX=0
F S IBX=$O(^DGCR(399,IBIFN,"CV",IBX)) Q:'IBX D
. S IBFIND=1
. S IBTEXT(1,1)="Value Code: "_$$GET1^DIQ(399.047,IBX_","_IBIFN_",",.01,"E")
. S IBTEXT(1,2)="Value: "_$$GET1^DIQ(399.047,IBX_","_IBIFN_",",.02,"E")
. D LINE(.IBTEXT)
. Q
I 'IBFIND D
. S IBTEXT(1,1)="*** No Value Codes Found ***"
. D LINE(.IBTEXT)
. Q
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBVCB 10820 printed Oct 16, 2024@18:30 Page 2
IBVCB ;LITS/MRD - VIEW CANCELLED BILL ;25-JUN-14
+1 ;;2.0;INTEGRATED BILLING;**516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; The View Cancelled Bill option allows the user to view the values
+5 ; of many fields of a cancelled bill. The user may select a patient,
+6 ; and then pick from a list of that patient's cancelled claims, or
+7 ; simply enter a claim number. Claims that do not have a Status of
+8 ; 'Cancelled' cannot be selected.
+9 ; The user may also select the device to which the report will be
+10 ; printed.
+11 ; For many of the sections on this report, if there is no data, the
+12 ; report will display a message stating 'No Data' rather than print
+13 ; the labels without any data following them.
+14 ;
EN ; Main Entry Point.
+1 ;
+2 NEW IBHEADER,IBIFN,IBPAGE,IBQUIT,IBTEXT
+3 ;
EN1 ;
+1 ;
+2 SET IBQUIT=0
+3 ;
+4 DO SELECT
IF IBQUIT
GOTO ENQ
+5 ;
+6 DO DEVICE
IF IBQUIT
GOTO ENQ
+7 ;
+8 DO DISPLAY
+9 ;
+10 GOTO EN1
+11 ;
ENQ ;
+1 ;
+2 DO ^%ZISC
+3 ;
+4 QUIT
+5 ;
SELECT ; Prompt user for patient or bill.
+1 ;
+2 NEW DIC,X,Y
+3 ;
+4 WRITE !
+5 SET DIC="^DGCR(399,"
+6 SET DIC(0)="AEMQZ"
+7 SET DIC("A")="Enter BILL NUMBER or PATIENT NAME: "
+8 ; Status of bill must be 7/Cancelled.
+9 SET DIC("S")="I $P($G(^DGCR(399,Y,0)),U,13)=7"
+10 DO ^DIC
+11 ;
+12 IF X["^"!(X="")
SET IBQUIT=1
GOTO SELECTQ
+13 ;
+14 SET IBIFN=$PIECE(Y,U,1)
+15 IF IBIFN=""
SET IBQUIT=1
+16 ;
SELECTQ ;
+1 QUIT
+2 ;
DEVICE ; Allow user to select the device.
+1 ;
+2 SET %ZIS=""
+3 DO ^%ZIS
+4 IF POP
SET IBQUIT=1
+5 ;
+6 QUIT
+7 ;
DISPLAY ; Display claim information to user.
+1 ;
+2 DO HEADERA
+3 ;
+4 DO PART1
IF IBQUIT
QUIT
+5 DO PART2^IBVCB1
IF IBQUIT
QUIT
+6 DO PART3^IBVCB2
+7 ;
+8 QUIT
+9 ;
+1 ;
+2 ; IBHEADER = Patient Name ^ Full SSN ^ Last 4 of SSN.
+3 ;
+4 SET IBHEADER=$$PT^IBEFUNC($$GET1^DIQ(399,IBIFN_",",.02,"I"))
+5 SET IBPAGE=0
+6 ;
+7 DO HEADERB
+8 ;
+9 QUIT
+10 ;
+1 ;
+2 SET IBPAGE=IBPAGE+1
+3 IF $EXTRACT(IOST,1,2)="C-"
IF IBPAGE>1
DO CONTINUE
+4 ; Print the device-specific form feed sequence.
WRITE @IOF
+5 WRITE !,$PIECE(IBHEADER,U,1)
+6 IF $PIECE(IBHEADER,U,3)'=""
WRITE " "_$EXTRACT(IBHEADER,1)_$PIECE(IBHEADER,U,3)
+7 WRITE ?41,$$GET1^DIQ(399,IBIFN_",",.17,"E")
+8 WRITE ?72,"Page ",$JUSTIFY(IBPAGE,2)
+9 WRITE !,"==============================================================================="
+10 ;
+11 QUIT
+12 ;
CONTINUE ; Enter return to continue.
+1 ;
+2 WRITE !
+3 NEW DIR
+4 SET DIR(0)="E"
+5 DO ^DIR
+6 IF 'Y
SET IBQUIT=1
+7 WRITE $CHAR(13)," ",$CHAR(13)
+8 QUIT
+9 ;
LINE(IBTEXT) ; Print the lines of information in the IBTEXT array.
+1 ;
+2 ; IBTEXT is passed by reference. The first subscript is an integer
+3 ; representing the relative line number (1, 2, 3, etc.). The second
+4 ; subscript will be '1' or '2'.
+5 ; IBTEXT(x,1) = Text to be printed in the 1st column.
+6 ; IBTEXT(x,2) = Text to be printed in the 2nd column, if any.
+7 ; The IBTEXT array is Killed off before Quitting out. This resets
+8 ; the array so the rest of the code does not have to.
+9 ;
+10 NEW IBX
+11 ;
+12 ; The number of lines to be printed is found by $O(IBTEXT(""),-1).
+13 ; $Y represents the line on the page of the printer or line on the
+14 ; screen if printing to a terminal. If there is not enough space
+15 ; remaining on the current page to display the number of lines
+16 ; in IBTEXT, then it calls HEADERB, which Writes a form feed and
+17 ; prints the header. $Y is reset to 0 by the statement W @IOF
+18 ; in the HEADERB procedure.
+19 ;
+20 ; How many lines are to be printed.
SET IBX=$ORDER(IBTEXT(""),-1)
+21 IF $Y>(IOSL-(IBX+3))
DO HEADERB
+22 ;
+23 SET IBX=""
+24 FOR
SET IBX=$ORDER(IBTEXT(IBX))
if IBX=""
QUIT
Begin DoDot:1
+25 WRITE !
+26 IF $DATA(IBTEXT(IBX,1))
WRITE IBTEXT(IBX,1)
+27 IF $DATA(IBTEXT(IBX,2))
WRITE ?41,IBTEXT(IBX,2)
+28 QUIT
End DoDot:1
+29 KILL IBTEXT
+30 QUIT
+31 ;
DOLLAR(X) ; Function to return a formatted dollar amount.
+1 ;
+2 IF $GET(X)=""
QUIT ""
+3 NEW X2,X3
+4 SET X2="2$"
SET X3=0
+5 DO COMMA^%DTC
+6 QUIT X
+7 ;
PART1 ; General Claim Data, Other Care, Codes.
+1 ;
+2 NEW IBBT,IBFIND,IBX
+3 ;
+4 SET IBTEXT(1,1)=""
+5 SET IBTEXT(2,1)="General Claim Data"
+6 SET IBTEXT(3,1)="------------------"
+7 DO LINE(.IBTEXT)
+8 ;
+9 SET IBTEXT(1,1)="Primary Bill: "_$$GET1^DIQ(399,IBIFN_",",.17,"E")
+10 SET IBTEXT(1,2)="Event Date: "_$$GET1^DIQ(399,IBIFN_",",.03,"E")
+11 SET IBTEXT(2,1)="Rate Type: "_$$GET1^DIQ(399,IBIFN_",",.07,"E")
+12 SET IBTEXT(2,2)="Outpt Visit Date: "
+13 SET IBX=$ORDER(^DGCR(399,IBIFN,"OP",0))
+14 IF IBX'=""
SET IBTEXT(2,2)=IBTEXT(2,2)_$$GET1^DIQ(399.043,IBX_","_IBIFN_",",.01,"E")
+15 DO LINE(.IBTEXT)
+16 ; Look for more Outpt Visit Dates.
+17 FOR
SET IBX=$ORDER(^DGCR(399,IBIFN,"OP",IBX))
if 'IBX
QUIT
Begin DoDot:1
+18 SET IBTEXT(1,2)="Outpt Visit Date: "_$$GET1^DIQ(399.043,IBX_","_IBIFN_",",.01,"E")
+19 DO LINE(.IBTEXT)
+20 QUIT
End DoDot:1
+21 ;
+22 SET IBTEXT(1,1)="Responsible Party: "_$$GET1^DIQ(399,IBIFN_",",.11,"E")
+23 SET IBTEXT(1,2)="Service Fac. Taxonomy: "_$$GET1^DIQ(399,IBIFN_",",243,"E")
+24 SET IBTEXT(2,1)="Responsible Institution: "_$$GET1^DIQ(399,IBIFN_",",111,"E")
+25 DO LINE(.IBTEXT)
+26 ;
+27 SET IBTEXT(1,1)="Timeframe: "_$$GET1^DIQ(399,IBIFN_",",.06,"E")
+28 SET IBTEXT(1,2)="Default Division: "_$$GET1^DIQ(399,IBIFN_",",.22,"E")
+29 DO LINE(.IBTEXT)
+30 ;
+31 SET IBTEXT(1,1)="Charge Type: "_$$GET1^DIQ(399,IBIFN_",",.27,"E")
+32 SET IBTEXT(1,2)="Assignment of Benefits: "_$$GET1^DIQ(399,IBIFN_",",156,"E")
+33 DO LINE(.IBTEXT)
+34 ;
+35 SET IBTEXT(1,1)="LOC: "_$$GET1^DIQ(399,IBIFN_",",.04,"E")
+36 DO LINE(.IBTEXT)
+37 ;
+38 SET IBTEXT(1,1)="D/C Status: "_$$GET1^DIQ(399,IBIFN_",",162,"E")
+39 SET IBTEXT(2,1)="D/C Bedsection: "_$$GET1^DIQ(399,IBIFN_",",161,"E")
+40 SET IBTEXT(2,2)="Form Type: "_$$GET1^DIQ(399,IBIFN_",",.19,"E")
+41 DO LINE(.IBTEXT)
+42 ;
+43 SET IBTEXT(1,1)="Bill Classification: "_$$GET1^DIQ(399,IBIFN_",",.05,"E")
+44 DO LINE(.IBTEXT)
+45 ;
+46 SET IBTEXT(1,1)="Statement From: "_$$GET1^DIQ(399,IBIFN_",",151,"E")
+47 SET IBTEXT(1,2)="Statement To: "_$$GET1^DIQ(399,IBIFN_",",152,"E")
+48 DO LINE(.IBTEXT)
+49 ;
+50 SET IBTEXT(1,1)="Sensitive?: "_$$GET1^DIQ(399,IBIFN_",",155,"E")
+51 SET IBTEXT(1,2)="ROI Complete?: "_$$GET1^DIQ(399,IBIFN_",",157,"E")
+52 DO LINE(.IBTEXT)
+53 ;
+54 SET IBTEXT(1,1)="Admission Type: "_$$GET1^DIQ(399,IBIFN_",",158,"E")
+55 SET IBTEXT(1,2)="Admission Source: "_$$GET1^DIQ(399,IBIFN_",",159,"E")
+56 DO LINE(.IBTEXT)
+57 ;
+58 SET IBTEXT(1,1)="Non-PTF Admission Hr.: "_$$GET1^DIQ(399,IBIFN_",",159.5,"E")
+59 SET IBTEXT(1,2)="Admitting DX: "_$$GET1^DIQ(399,IBIFN_",",215,"E")
+60 DO LINE(.IBTEXT)
+61 ;
+62 SET IBTEXT(1,1)="Accident Hr.: "_$$GET1^DIQ(399,IBIFN_",",160,"E")
+63 SET IBTEXT(1,2)="Co-Insurance Days: "_$$GET1^DIQ(399,IBIFN_",",221,"E")
+64 DO LINE(.IBTEXT)
+65 ;
+66 SET IBTEXT(1,1)="Covered Days: "_$$GET1^DIQ(399,IBIFN_",",216,"E")
+67 SET IBTEXT(1,2)="Non-Covered Days: "_$$GET1^DIQ(399,IBIFN_",",217,"E")
+68 DO LINE(.IBTEXT)
+69 ;
+70 SET IBTEXT(1,1)="Length of Stay: "_$$GET1^DIQ(399,IBIFN_",",165,"E")
+71 SET IBTEXT(1,2)="PPS: "_$$GET1^DIQ(399,IBIFN_",",170,"E")
+72 DO LINE(.IBTEXT)
+73 ;
+74 SET IBTEXT(1,1)="Total Charge: "_$$DOLLAR($$GET1^DIQ(399,IBIFN_",",201,"E"))
+75 DO LINE(.IBTEXT)
+76 ;
+77 SET IBTEXT(1,1)="Unable to Work From: "_$$GET1^DIQ(399,IBIFN_",",166,"E")
+78 SET IBTEXT(1,2)="Unable to Work To: "_$$GET1^DIQ(399,IBIFN_",",167,"E")
+79 DO LINE(.IBTEXT)
+80 ;
+81 SET IBTEXT(1,1)="Current Payer Seq.: "_$$GET1^DIQ(399,IBIFN_",",.21,"E")
+82 SET IBTEXT(1,2)="SC: "_$$GET1^DIQ(399,IBIFN_",",.18,"E")
+83 DO LINE(.IBTEXT)
+84 ;
+85 SET IBTEXT(1,1)="Status: "_$$GET1^DIQ(399,IBIFN_",",.13,"E")
+86 SET IBTEXT(1,2)="Status Date: "_$$GET1^DIQ(399,IBIFN_",",.14,"E")
+87 DO LINE(.IBTEXT)
+88 ;
+89 SET IBTEXT(1,1)="Bill Copied From: "_$$GET1^DIQ(399,IBIFN_",",.15,"E")
+90 SET IBTEXT(1,2)="PTF Record #: "_$$GET1^DIQ(399,IBIFN_",",.08,"E")
+91 DO LINE(.IBTEXT)
+92 ;
+93 SET IBTEXT(1,1)="Procedure Coding Method: "_$$GET1^DIQ(399,IBIFN_",",.09,"E")
+94 DO LINE(.IBTEXT)
+95 ;
+96 SET IBBT=$$GET1^DIQ(399,IBIFN_",",.25,"I")
+97 IF IBBT'=""
SET IBBT=$PIECE($GET(^DGCR(399.1,IBBT,0)),U,2)
SET IBBT=$$GET1^DIQ(399,IBIFN_",",.24,"I")_IBBT_$$GET1^DIQ(399,IBIFN_",",.26,"I")
+98 ;
+99 SET IBTEXT(1,1)="Bill Type: "_IBBT
+100 SET IBTEXT(1,2)="Non-VA D/C Date: "_$$GET1^DIQ(399,IBIFN_",",.16,"E")
+101 DO LINE(.IBTEXT)
+102 ;
+103 SET IBTEXT(1,1)="Mammography No.: "_$$GET1^DIQ(399,IBIFN_",",242,"E")
+104 SET IBTEXT(1,2)="CLIA No.: "_$$GET1^DIQ(399,IBIFN_",",235,"E")
+105 DO LINE(.IBTEXT)
+106 ;
+107 SET IBTEXT(1,1)="Special Program Indicator: "_$$GET1^DIQ(399,IBIFN_",",238,"E")
+108 DO LINE(.IBTEXT)
+109 ;
+110 SET IBTEXT(1,1)="Forced to Print: "_$$GET1^DIQ(399,IBIFN_",",27,"E")
+111 SET IBTEXT(1,2)="MRA Secondary Forced to Print: "_$$GET1^DIQ(399,IBIFN_",",28,"E")
+112 DO LINE(.IBTEXT)
+113 ;
+114 SET IBTEXT(1,1)="COB Total Non-Covered Amt: "_$$DOLLAR($$GET1^DIQ(399,IBIFN_",",260,"E"))
+115 DO LINE(.IBTEXT)
+116 ;
+117 SET IBTEXT(1,1)="Disability Start Date: "_$$GET1^DIQ(399,IBIFN_",",263,"E")
+118 SET IBTEXT(1,2)="Disability End Date: "_$$GET1^DIQ(399,IBIFN_",",264,"E")
+119 DO LINE(.IBTEXT)
+120 ;
+121 SET IBTEXT(1,1)="Prim Surgical Proc: "_$$GET1^DIQ(399,IBIFN_",",266,"E")
+122 SET IBTEXT(1,2)="Sec Surgical Proc: "_$$GET1^DIQ(399,IBIFN_",",267,"E")
+123 DO LINE(.IBTEXT)
+124 ;
+125 SET IBTEXT(1,1)="Relinquish Care Date: "_$$GET1^DIQ(399,IBIFN_",",283,"E")
+126 SET IBTEXT(1,2)="Assumed Care Date: "_$$GET1^DIQ(399,IBIFN_",",282,"E")
+127 DO LINE(.IBTEXT)
+128 ;
+129 SET IBTEXT(1,1)="Attachment Report Type: "_$$GET1^DIQ(399,IBIFN_",",285,"E")
+130 SET IBTEXT(2,1)="Attachment Report Transmit Method: "_$$GET1^DIQ(399,IBIFN_",",286,"E")
+131 SET IBTEXT(3,1)="Attachment Control No.: "_$$GET1^DIQ(399,IBIFN_",",284,"E")
+132 DO LINE(.IBTEXT)
+133 ;
+134 SET IBTEXT(1,1)=""
+135 SET IBTEXT(2,1)="Other Care"
+136 SET IBTEXT(3,1)="----------"
+137 DO LINE(.IBTEXT)
+138 ;
+139 SET IBFIND=0
SET IBX=0
+140 FOR
SET IBX=$ORDER(^DGCR(399,IBIFN,"OT",IBX))
if 'IBX
QUIT
Begin DoDot:1
+141 SET IBFIND=1
+142 SET IBTEXT(1,1)="Other Care: "_$$GET1^DIQ(399.048,IBX_","_IBIFN_",",.01,"E")
+143 SET IBTEXT(2,1)="Other Care Date(s): "_$$GET1^DIQ(399.048,IBX_","_IBIFN_",",.02,"E")_" - "_$$GET1^DIQ(399.048,IBX_","_IBIFN_",",.03,"E")
+144 DO LINE(.IBTEXT)
+145 QUIT
End DoDot:1
+146 IF 'IBFIND
Begin DoDot:1
+147 SET IBTEXT(1,1)="*** No Other Care Data Found ***"
+148 DO LINE(.IBTEXT)
+149 QUIT
End DoDot:1
+150 ;
+151 SET IBTEXT(1,1)=""
+152 SET IBTEXT(2,1)="Codes"
+153 SET IBTEXT(3,1)="-----"
+154 DO LINE(.IBTEXT)
+155 ;
+156 SET IBFIND=0
SET IBX=0
+157 FOR
SET IBX=$ORDER(^DGCR(399,IBIFN,"CC",IBX))
if 'IBX
QUIT
Begin DoDot:1
+158 SET IBFIND=1
+159 SET IBTEXT(1,1)="Condition Code: "_$$GET1^DIQ(399.04,IBX_","_IBIFN_",",.01,"E")
+160 DO LINE(.IBTEXT)
+161 QUIT
End DoDot:1
+162 IF 'IBFIND
Begin DoDot:1
+163 SET IBTEXT(1,1)="*** No Condition Codes Found ***"
+164 DO LINE(.IBTEXT)
+165 QUIT
End DoDot:1
+166 ;
+167 SET IBFIND=0
SET IBX=0
+168 FOR
SET IBX=$ORDER(^DGCR(399,IBIFN,"OC",IBX))
if 'IBX
QUIT
Begin DoDot:1
+169 SET IBFIND=1
+170 SET IBTEXT(1,1)="Occurrence Code: "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.01,"E")
+171 SET IBTEXT(1,2)="Occurrence State: "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.03,"E")
+172 SET IBTEXT(2,1)="Occ. Date(s): "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.02,"E")_" - "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.04,"E")
+173 DO LINE(.IBTEXT)
+174 QUIT
End DoDot:1
+175 IF 'IBFIND
Begin DoDot:1
+176 SET IBTEXT(1,1)="*** No Occurrence Codes Found ***"
+177 DO LINE(.IBTEXT)
+178 QUIT
End DoDot:1
+179 ;
+180 SET IBFIND=0
SET IBX=0
+181 FOR
SET IBX=$ORDER(^DGCR(399,IBIFN,"CV",IBX))
if 'IBX
QUIT
Begin DoDot:1
+182 SET IBFIND=1
+183 SET IBTEXT(1,1)="Value Code: "_$$GET1^DIQ(399.047,IBX_","_IBIFN_",",.01,"E")
+184 SET IBTEXT(1,2)="Value: "_$$GET1^DIQ(399.047,IBX_","_IBIFN_",",.02,"E")
+185 DO LINE(.IBTEXT)
+186 QUIT
End DoDot:1
+187 IF 'IBFIND
Begin DoDot:1
+188 SET IBTEXT(1,1)="*** No Value Codes Found ***"
+189 DO LINE(.IBTEXT)
+190 QUIT
End DoDot:1
+191 ;
+192 QUIT
+193 ;
