Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBVCB

IBVCB.m

Go to the documentation of this file. 
  1. IBVCB ;LITS/MRD - VIEW CANCELLED BILL ;25-JUN-14
  1.  ;;2.0;INTEGRATED BILLING;**516**;21-MAR-94;Build 123
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; The View Cancelled Bill option allows the user to view the values
  1.  ; of many fields of a cancelled bill.  The user may select a patient,
  1.  ; and then pick from a list of that patient's cancelled claims, or
  1.  ; simply enter a claim number.  Claims that do not have a Status of
  1.  ; 'Cancelled' cannot be selected.
  1.  ; The user may also select the device to which the report will be
  1.  ; printed.
  1.  ; For many of the sections on this report, if there is no data, the
  1.  ; report will display a message stating 'No Data' rather than print
  1.  ; the labels without any data following them.
  1.  ; 
  1. EN ; Main Entry Point.
  1.  ;
  1.  N IBHEADER,IBIFN,IBPAGE,IBQUIT,IBTEXT
  1.  ;
  1. EN1 ;
  1.  ;
  1.  S IBQUIT=0
  1.  ;
  1.  D SELECT I IBQUIT G ENQ
  1.  ;
  1.  D DEVICE I IBQUIT G ENQ
  1.  ;
  1.  D DISPLAY
  1.  ;
  1.  G EN1
  1.  ;
  1. ENQ ;
  1.  ;
  1.  D ^%ZISC
  1.  ;
  1.  Q
  1.  ;
  1. SELECT ; Prompt user for patient or bill.
  1.  ;
  1.  N DIC,X,Y
  1.  ;
  1.  W !
  1.  S DIC="^DGCR(399,"
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Enter BILL NUMBER or PATIENT NAME: "
  1.  ; Status of bill must be 7/Cancelled.
  1.  S DIC("S")="I $P($G(^DGCR(399,Y,0)),U,13)=7"
  1.  D ^DIC
  1.  ;
  1.  I X["^"!(X="") S IBQUIT=1 G SELECTQ
  1.  ;
  1.  S IBIFN=$P(Y,U,1)
  1.  I IBIFN="" S IBQUIT=1
  1.  ;
  1. SELECTQ ;
  1.  Q
  1.  ;
  1. DEVICE ; Allow user to select the device.
  1.  ;
  1.  S %ZIS=""
  1.  D ^%ZIS
  1.  I POP S IBQUIT=1
  1.  ;
  1.  Q
  1.  ;
  1. DISPLAY ; Display claim information to user.
  1.  ;
  1.  D HEADERA
  1.  ;
  1.  D PART1 I IBQUIT Q
  1.  D PART2^IBVCB1 I IBQUIT Q
  1.  D PART3^IBVCB2
  1.  ;
  1.  Q
  1.  ;
  1. HEADERA ; Pull header information.
  1.  ;
  1.  ; IBHEADER = Patient Name ^ Full SSN ^ Last 4 of SSN.
  1.  ;
  1.  S IBHEADER=$$PT^IBEFUNC($$GET1^DIQ(399,IBIFN_",",.02,"I"))
  1.  S IBPAGE=0
  1.  ;
  1.  D HEADERB
  1.  ;
  1.  Q
  1.  ;
  1. HEADERB ; Print header information.
  1.  ;
  1.  S IBPAGE=IBPAGE+1
  1.  I $E(IOST,1,2)="C-",IBPAGE>1 D CONTINUE
  1.  W @IOF  ; Print the device-specific form feed sequence.
  1.  W !,$P(IBHEADER,U,1)
  1.  I $P(IBHEADER,U,3)'="" W "   "_$E(IBHEADER,1)_$P(IBHEADER,U,3)
  1.  W ?41,$$GET1^DIQ(399,IBIFN_",",.17,"E")
  1.  W ?72,"Page ",$J(IBPAGE,2)
  1.  W !,"==============================================================================="
  1.  ;
  1.  Q
  1.  ;
  1. CONTINUE ; Enter return to continue.
  1.  ;
  1.  W !
  1.  N DIR
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  I 'Y S IBQUIT=1
  1.  W $C(13),"                                                  ",$C(13)
  1.  Q
  1.  ;
  1. LINE(IBTEXT) ; Print the lines of information in the IBTEXT array.
  1.  ;
  1.  ; IBTEXT is passed by reference.  The first subscript is an integer
  1.  ; representing the relative line number (1, 2, 3, etc.).  The second
  1.  ; subscript will be '1' or '2'.
  1.  ;     IBTEXT(x,1) = Text to be printed in the 1st column.
  1.  ;     IBTEXT(x,2) = Text to be printed in the 2nd column, if any.
  1.  ; The IBTEXT array is Killed off before Quitting out.  This resets
  1.  ; the array so the rest of the code does not have to.
  1.  ;
  1.  N IBX
  1.  ;
  1.  ; The number of lines to be printed is found by $O(IBTEXT(""),-1).
  1.  ; $Y represents the line on the page of the printer or line on the
  1.  ; screen if printing to a terminal.  If there is not enough space
  1.  ; remaining on the current page to display the number of lines
  1.  ; in IBTEXT, then it calls HEADERB, which Writes a form feed and
  1.  ; prints the header.  $Y is reset to 0 by the statement W @IOF
  1.  ; in the HEADERB procedure.
  1.  ;
  1.  S IBX=$O(IBTEXT(""),-1)  ; How many lines are to be printed.
  1.  I $Y>(IOSL-(IBX+3)) D HEADERB
  1.  ;
  1.  S IBX=""
  1.  F  S IBX=$O(IBTEXT(IBX)) Q:IBX=""  D
  1.  . W !
  1.  . I $D(IBTEXT(IBX,1)) W IBTEXT(IBX,1)
  1.  . I $D(IBTEXT(IBX,2)) W ?41,IBTEXT(IBX,2)
  1.  . Q
  1.  K IBTEXT
  1.  Q
  1.  ;
  1. DOLLAR(X) ; Function to return a formatted dollar amount.
  1.  ;
  1.  I $G(X)="" Q ""
  1.  N X2,X3
  1.  S X2="2$",X3=0
  1.  D COMMA^%DTC
  1.  Q X
  1.  ;
  1. PART1 ; General Claim Data, Other Care, Codes.
  1.  ;
  1.  N IBBT,IBFIND,IBX
  1.  ;
  1.  S IBTEXT(1,1)=""
  1.  S IBTEXT(2,1)="General Claim Data"
  1.  S IBTEXT(3,1)="------------------"
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Primary Bill: "_$$GET1^DIQ(399,IBIFN_",",.17,"E")
  1.  S IBTEXT(1,2)="Event Date: "_$$GET1^DIQ(399,IBIFN_",",.03,"E")
  1.  S IBTEXT(2,1)="Rate Type: "_$$GET1^DIQ(399,IBIFN_",",.07,"E")
  1.  S IBTEXT(2,2)="Outpt Visit Date: "
  1.  S IBX=$O(^DGCR(399,IBIFN,"OP",0))
  1.  I IBX'="" S IBTEXT(2,2)=IBTEXT(2,2)_$$GET1^DIQ(399.043,IBX_","_IBIFN_",",.01,"E")
  1.  D LINE(.IBTEXT)
  1.  ; Look for more Outpt Visit Dates.
  1.  F  S IBX=$O(^DGCR(399,IBIFN,"OP",IBX)) Q:'IBX  D
  1.  . S IBTEXT(1,2)="Outpt Visit Date: "_$$GET1^DIQ(399.043,IBX_","_IBIFN_",",.01,"E")
  1.  . D LINE(.IBTEXT)
  1.  . Q
  1.  ;
  1.  S IBTEXT(1,1)="Responsible Party: "_$$GET1^DIQ(399,IBIFN_",",.11,"E")
  1.  S IBTEXT(1,2)="Service Fac. Taxonomy: "_$$GET1^DIQ(399,IBIFN_",",243,"E")
  1.  S IBTEXT(2,1)="Responsible Institution: "_$$GET1^DIQ(399,IBIFN_",",111,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Timeframe: "_$$GET1^DIQ(399,IBIFN_",",.06,"E")
  1.  S IBTEXT(1,2)="Default Division: "_$$GET1^DIQ(399,IBIFN_",",.22,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Charge Type: "_$$GET1^DIQ(399,IBIFN_",",.27,"E")
  1.  S IBTEXT(1,2)="Assignment of Benefits: "_$$GET1^DIQ(399,IBIFN_",",156,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="LOC: "_$$GET1^DIQ(399,IBIFN_",",.04,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="D/C Status: "_$$GET1^DIQ(399,IBIFN_",",162,"E")
  1.  S IBTEXT(2,1)="D/C Bedsection: "_$$GET1^DIQ(399,IBIFN_",",161,"E")
  1.  S IBTEXT(2,2)="Form Type: "_$$GET1^DIQ(399,IBIFN_",",.19,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Bill Classification: "_$$GET1^DIQ(399,IBIFN_",",.05,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Statement From: "_$$GET1^DIQ(399,IBIFN_",",151,"E")
  1.  S IBTEXT(1,2)="Statement To: "_$$GET1^DIQ(399,IBIFN_",",152,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Sensitive?: "_$$GET1^DIQ(399,IBIFN_",",155,"E")
  1.  S IBTEXT(1,2)="ROI Complete?: "_$$GET1^DIQ(399,IBIFN_",",157,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Admission Type: "_$$GET1^DIQ(399,IBIFN_",",158,"E")
  1.  S IBTEXT(1,2)="Admission Source: "_$$GET1^DIQ(399,IBIFN_",",159,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Non-PTF Admission Hr.: "_$$GET1^DIQ(399,IBIFN_",",159.5,"E")
  1.  S IBTEXT(1,2)="Admitting DX: "_$$GET1^DIQ(399,IBIFN_",",215,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Accident Hr.: "_$$GET1^DIQ(399,IBIFN_",",160,"E")
  1.  S IBTEXT(1,2)="Co-Insurance Days: "_$$GET1^DIQ(399,IBIFN_",",221,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Covered Days: "_$$GET1^DIQ(399,IBIFN_",",216,"E")
  1.  S IBTEXT(1,2)="Non-Covered Days: "_$$GET1^DIQ(399,IBIFN_",",217,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Length of Stay: "_$$GET1^DIQ(399,IBIFN_",",165,"E")
  1.  S IBTEXT(1,2)="PPS: "_$$GET1^DIQ(399,IBIFN_",",170,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Total Charge: "_$$DOLLAR($$GET1^DIQ(399,IBIFN_",",201,"E"))
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Unable to Work From: "_$$GET1^DIQ(399,IBIFN_",",166,"E")
  1.  S IBTEXT(1,2)="Unable to Work To: "_$$GET1^DIQ(399,IBIFN_",",167,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Current Payer Seq.: "_$$GET1^DIQ(399,IBIFN_",",.21,"E")
  1.  S IBTEXT(1,2)="SC: "_$$GET1^DIQ(399,IBIFN_",",.18,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Status: "_$$GET1^DIQ(399,IBIFN_",",.13,"E")
  1.  S IBTEXT(1,2)="Status Date: "_$$GET1^DIQ(399,IBIFN_",",.14,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Bill Copied From: "_$$GET1^DIQ(399,IBIFN_",",.15,"E")
  1.  S IBTEXT(1,2)="PTF Record #: "_$$GET1^DIQ(399,IBIFN_",",.08,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Procedure Coding Method: "_$$GET1^DIQ(399,IBIFN_",",.09,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBBT=$$GET1^DIQ(399,IBIFN_",",.25,"I")
  1.  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")
  1.  ;
  1.  S IBTEXT(1,1)="Bill Type: "_IBBT
  1.  S IBTEXT(1,2)="Non-VA D/C Date: "_$$GET1^DIQ(399,IBIFN_",",.16,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Mammography No.: "_$$GET1^DIQ(399,IBIFN_",",242,"E")
  1.  S IBTEXT(1,2)="CLIA No.: "_$$GET1^DIQ(399,IBIFN_",",235,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Special Program Indicator: "_$$GET1^DIQ(399,IBIFN_",",238,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Forced to Print: "_$$GET1^DIQ(399,IBIFN_",",27,"E")
  1.  S IBTEXT(1,2)="MRA Secondary Forced to Print: "_$$GET1^DIQ(399,IBIFN_",",28,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="COB Total Non-Covered Amt: "_$$DOLLAR($$GET1^DIQ(399,IBIFN_",",260,"E"))
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Disability Start Date: "_$$GET1^DIQ(399,IBIFN_",",263,"E")
  1.  S IBTEXT(1,2)="Disability End Date: "_$$GET1^DIQ(399,IBIFN_",",264,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Prim Surgical Proc: "_$$GET1^DIQ(399,IBIFN_",",266,"E")
  1.  S IBTEXT(1,2)="Sec Surgical Proc: "_$$GET1^DIQ(399,IBIFN_",",267,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Relinquish Care Date: "_$$GET1^DIQ(399,IBIFN_",",283,"E")
  1.  S IBTEXT(1,2)="Assumed Care Date: "_$$GET1^DIQ(399,IBIFN_",",282,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)="Attachment Report Type: "_$$GET1^DIQ(399,IBIFN_",",285,"E")
  1.  S IBTEXT(2,1)="Attachment Report Transmit Method: "_$$GET1^DIQ(399,IBIFN_",",286,"E")
  1.  S IBTEXT(3,1)="Attachment Control No.: "_$$GET1^DIQ(399,IBIFN_",",284,"E")
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBTEXT(1,1)=""
  1.  S IBTEXT(2,1)="Other Care"
  1.  S IBTEXT(3,1)="----------"
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBFIND=0,IBX=0
  1.  F  S IBX=$O(^DGCR(399,IBIFN,"OT",IBX)) Q:'IBX  D
  1.  . S IBFIND=1
  1.  . S IBTEXT(1,1)="Other Care: "_$$GET1^DIQ(399.048,IBX_","_IBIFN_",",.01,"E")
  1.  . S IBTEXT(2,1)="Other Care Date(s): "_$$GET1^DIQ(399.048,IBX_","_IBIFN_",",.02,"E")_" - "_$$GET1^DIQ(399.048,IBX_","_IBIFN_",",.03,"E")
  1.  . D LINE(.IBTEXT)
  1.  . Q
  1.  I 'IBFIND D
  1.  . S IBTEXT(1,1)="*** No Other Care Data Found ***"
  1.  . D LINE(.IBTEXT)
  1.  . Q
  1.  ;
  1.  S IBTEXT(1,1)=""
  1.  S IBTEXT(2,1)="Codes"
  1.  S IBTEXT(3,1)="-----"
  1.  D LINE(.IBTEXT)
  1.  ;
  1.  S IBFIND=0,IBX=0
  1.  F  S IBX=$O(^DGCR(399,IBIFN,"CC",IBX)) Q:'IBX  D
  1.  . S IBFIND=1
  1.  . S IBTEXT(1,1)="Condition Code: "_$$GET1^DIQ(399.04,IBX_","_IBIFN_",",.01,"E")
  1.  . D LINE(.IBTEXT)
  1.  . Q
  1.  I 'IBFIND D
  1.  . S IBTEXT(1,1)="*** No Condition Codes Found ***"
  1.  . D LINE(.IBTEXT)
  1.  . Q
  1.  ;
  1.  S IBFIND=0,IBX=0
  1.  F  S IBX=$O(^DGCR(399,IBIFN,"OC",IBX)) Q:'IBX  D
  1.  . S IBFIND=1
  1.  . S IBTEXT(1,1)="Occurrence Code: "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.01,"E")
  1.  . S IBTEXT(1,2)="Occurrence State: "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.03,"E")
  1.  . S IBTEXT(2,1)="Occ. Date(s): "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.02,"E")_" - "_$$GET1^DIQ(399.041,IBX_","_IBIFN_",",.04,"E")
  1.  . D LINE(.IBTEXT)
  1.  . Q
  1.  I 'IBFIND D
  1.  . S IBTEXT(1,1)="*** No Occurrence Codes Found ***"
  1.  . D LINE(.IBTEXT)
  1.  . Q
  1.  ;
  1.  S IBFIND=0,IBX=0
  1.  F  S IBX=$O(^DGCR(399,IBIFN,"CV",IBX)) Q:'IBX  D
  1.  . S IBFIND=1
  1.  . S IBTEXT(1,1)="Value Code: "_$$GET1^DIQ(399.047,IBX_","_IBIFN_",",.01,"E")
  1.  . S IBTEXT(1,2)="Value: "_$$GET1^DIQ(399.047,IBX_","_IBIFN_",",.02,"E")
  1.  . D LINE(.IBTEXT)
  1.  . Q
  1.  I 'IBFIND D
  1.  . S IBTEXT(1,1)="*** No Value Codes Found ***"
  1.  . D LINE(.IBTEXT)
  1.  . Q
  1.  ;
  1.  Q
  1.  ;