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

FBAAIARD.m

Go to the documentation of this file. 
  1. FBAAIARD ;ALB/ESG - Fee IPAC Vendor Payment Report (Detail) Print ;2/17/2014
  1.  ;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Scratch global built by FBAAIARB (Detail report)
  1.  ;  ^TMP("FBAAIARB",$J,Vendor_Name,Payment_Type,DoD_Invoice#,Date_Of_Service,Pt_Name,IENS) = DATA
  1.  ;
  1.  Q
  1.  ;
  1. PRINT ; entry point for printing the report
  1.  ; Variables assumed to exist from FBAAIARB:  FBIAVEN, FBIABEG, FBIAEND, FBIATYPE, FBIAEXCEL, FBIAADJ, FBIAIGNORE
  1.  ;
  1.  N CRT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FBDODINV,FBIASTOP,FBVENAME,FBZDOS,FBZIENS,FBZPTNM,FBZTYPE,ITSTR,PAGE,RPTG,SEPLINE,X,Y
  1.  S CRT=$S(IOST["C-":1,1:0)
  1.  I FBIAEXCEL S IOSL=999999     ; long screen length for Excel output
  1.  S PAGE=0,FBIASTOP=0,$P(SEPLINE,"-",133)="",ITSTR=$$ITSTR^FBAAIARA(.FBIATYPE)
  1.  ;
  1.  I '$D(^TMP("FBAAIARB",$J)) D HDR W !!?5,"No data found for this report." G PX
  1.  I $G(ZTSTOP) D HDR W !!?5,"This report was halted during compilation by TaskManager Request." G PX
  1.  ;
  1.  I FBIAEXCEL D HDR I FBIASTOP G PRINTX    ; for Excel CSV output, print the Header row first of all
  1.  ;
  1.  S FBVENAME="" F  S FBVENAME=$O(^TMP("FBAAIARB",$J,FBVENAME)) Q:FBVENAME=""!FBIASTOP  D
  1.  . S FBZTYPE="" F  S FBZTYPE=$O(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE)) Q:FBZTYPE=""!FBIASTOP  D
  1.  .. K RPTG
  1.  .. I 'FBIAEXCEL D HDR Q:FBIASTOP   ; page break on type since the column headings change (n/a for Excel)
  1.  .. ;
  1.  .. S FBDODINV="" F  S FBDODINV=$O(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV)) Q:FBDODINV=""!FBIASTOP  D
  1.  ... S FBZDOS=0 F  S FBZDOS=$O(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS)) Q:'FBZDOS!FBIASTOP  D
  1.  .... S FBZPTNM="" F  S FBZPTNM=$O(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM)) Q:FBZPTNM=""!FBIASTOP  D
  1.  ..... S FBZIENS="" F  S FBZIENS=$O(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM,FBZIENS)) Q:FBZIENS=""!FBIASTOP  D
  1.  ...... D RPTLN
  1.  ...... Q
  1.  ..... Q
  1.  .... Q
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  ;
  1.  I FBIASTOP G PRINTX      ; get out right away if stop flag is set
  1.  ;
  1.  I $Y+5>IOSL D HDR I FBIASTOP G PRINTX
  1.  W !!?5,"*** End of Report ***"
  1.  ;
  1. PX ;
  1.  I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
  1. PRINTX ;
  1.  Q
  1.  ;
  1. RPTLN ; display one payment line item detail
  1.  S RPTG=$G(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM,FBZIENS))
  1.  ;
  1.  ; for Excel output, print a CSV line and get out
  1.  I FBIAEXCEL D EXCELN(RPTG) Q
  1.  ;
  1.  I $Y+5>IOSL D HDR Q:FBIASTOP                                    ; check for page break
  1.  W !,$$LJ^XLFSTR(FBDODINV,20)                                    ; DoD invoice#
  1.  W ?21,$$LJ^XLFSTR(FBZPTNM,"16T")                                ; patient name
  1.  W ?38,$E($P(RPTG,U,4),6,10)                                     ; patient ID - last4 (10th digit for "P"seudo SSN)
  1.  W ?44,$$FMTE^XLFDT(FBZDOS,"2Z")                                 ; date of service
  1.  ;
  1.  I +FBZTYPE=1!(+FBZTYPE=4) W ?54,$P(RPTG,U,5),?61,$P(RPTG,U,7)   ; outpat/ancil procedure code/revenue code
  1.  I +FBZTYPE=2,$P(RPTG,U,8) W ?54,$$FMTE^XLFDT($P(RPTG,U,8),"2Z") ; inpatient discharge date
  1.  I +FBZTYPE=3 W ?54,$P(RPTG,U,12)                                ; pharmacy prescription number
  1.  ;
  1.  W ?64,$$RJ^XLFSTR($FN($P(RPTG,U,14),"",2),10)                   ; amount claimed
  1.  W $$RJ^XLFSTR($FN($P(RPTG,U,15),"",2),10)                       ; amount paid
  1.  W $$RJ^XLFSTR($FN($P(RPTG,U,16),"",2),10)                       ; amount adjusted #1
  1.  W ?95,$E($P(RPTG,U,17),1,6)                                     ; adjustment group code-reason code #1
  1.  W ?103,$$FMTE^XLFDT($P(RPTG,U,23),"2Z")                         ; date paid
  1.  W ?113,$E($P(RPTG,U,24),1,8)                                    ; check number
  1.  W ?122,$$RJ^XLFSTR($FN($P(RPTG,U,25),"",2),"10T")               ; disbursed amount
  1.  ;
  1.  ; line 2 data
  1.  W !?3,$P(RPTG,U,20)                                             ; Fee invoice#
  1.  W ?14,$P(RPTG,U,21)                                             ; batch#
  1.  W ?21,$P(RPTG,U,22)                                             ; obligation#
  1.  W ?29,$S($P(RPTG,U,27):"**VOIDED**",1:"")                       ; voided payment indicator
  1.  ;
  1.  I +FBZTYPE'=2,$P(RPTG,U,28)'="" W ?40,"**REJECTED**"            ; rejected payment indicator (not inpat)
  1.  I +FBZTYPE=2 W ?46,$P(RPTG,U,10)                                ; inpatient admitting diagnosis code
  1.  I +FBZTYPE=1!(+FBZTYPE=4) W ?54,$P(RPTG,U,6)                    ; outpat/ancil list of proc modifiers
  1.  I +FBZTYPE=3 W ?54,$E($P(RPTG,U,13),1,29)                       ; pharmacy drug name
  1.  I +FBZTYPE=2,$P(RPTG,U,28)'="" W ?61,"**REJECTED**"             ; rejected payment indicator (inpat)
  1.  ;
  1.  I $P(RPTG,U,18) W ?84,$$RJ^XLFSTR($FN($P(RPTG,U,18),"",2),10)   ; amount adjusted #2
  1.  W ?95,$E($P(RPTG,U,19),1,6)                                     ; adjustment group code-reason code #2
  1.  ;
  1.  I $P(RPTG,U,26) W ?106,"**CANCELLED ",$$FMTE^XLFDT($P(RPTG,U,26),"2Z"),"**"
  1.  ;
  1.  I +FBZTYPE'=2 Q    ; no more data for anything except inpatient
  1.  ;
  1.  ; Inpatient display of up to 25 diagnosis/poa and 25 procedure codes
  1.  I $P(RPTG,U,9)'="" D DIAGDISP($P(RPTG,U,9)) Q:FBIASTOP
  1.  I $P(RPTG,U,11)'="" D PROCDISP($P(RPTG,U,11)) Q:FBIASTOP
  1.  ;
  1. RPTLNX ;
  1.  Q
  1.  ;
  1. DIAGDISP(Z) ; For inpatient, display diagnosis codes and POA codes
  1.  N DELIM,P,DXP
  1.  I $Y+4>IOSL D HDR Q:FBIASTOP     ; check for page break
  1.  S DELIM=", "
  1.  W !?3,"DX(POA): "
  1.  F P=1:1:$L(Z,DELIM) D
  1.  . S DXP=$P(Z,DELIM,P) Q:DXP=""
  1.  . I $X+$L(DXP)+4>IOM W !?12
  1.  . W DXP
  1.  . I $P(Z,DELIM,P+1)'="" W DELIM
  1.  . Q
  1.  Q
  1.  ;
  1. PROCDISP(Z) ; For inpatient, display procedure codes
  1.  N DELIM,P,PRC
  1.  I $Y+4>IOSL D HDR Q:FBIASTOP     ; check for page break
  1.  S DELIM=", "
  1.  W !?6,"PROC: "
  1.  F P=1:1:$L(Z,DELIM) D
  1.  . S PRC=$P(Z,DELIM,P) Q:PRC=""
  1.  . I $X+$L(PRC)+4>IOM W !?12
  1.  . W PRC
  1.  . I $P(Z,DELIM,P+1)'="" W DELIM
  1.  . Q
  1.  Q
  1.  ;
  1. HDR ; report header
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,HTYP,VENID,X,Y
  1.  ;
  1.  ; Do an end of page reader call if page# exists and device is the screen
  1.  I PAGE,CRT S DIR(0)="E" D ^DIR K DIR I 'Y S FBIASTOP=1 G HDRX
  1.  ;
  1.  ; If screen output or page# exists, do a form feed
  1.  I PAGE!CRT W @IOF
  1.  ;
  1.  ; First printer/file page - do a left margin reset
  1.  I 'PAGE,'CRT W $C(13)
  1.  ;
  1.  S PAGE=PAGE+1    ; increment page#
  1.  ;
  1.  ; For Excel CSV format, display the column headers only
  1.  I FBIAEXCEL D EXCELHD G HDRX
  1.  ;
  1.  S HTYP=$G(FBZTYPE)   ; current type being displayed on this page (may not exist)
  1.  ;
  1.  ; Display the report headers
  1.  W "IPAC Vendor Payment Report"
  1.  W ?44,"For Date Range ",$$FMTE^XLFDT(FBIABEG,"5DZ")," - ",$$FMTE^XLFDT(FBIAEND,"5DZ")
  1.  W ?96,$$FMTE^XLFDT($$NOW^XLFDT),?120,"Page: ",PAGE
  1.  W !?3,"Selected Invoice Types: ",ITSTR
  1.  I FBIAADJ W ?102,"**Suspended Payments Only**"
  1.  ;
  1.  I $G(FBVENAME)'="" D
  1.  . W !?3,"Vendor Name: ",FBVENAME
  1.  . S VENID=$P($G(RPTG),U,2)
  1.  . I VENID="" S VENID=$P($G(^TMP("FBAAIARB",$J,FBVENAME)),U,1)
  1.  . I VENID'="" W "  (ID# ",VENID,")"
  1.  . I HTYP="" Q
  1.  . W ?81,"Invoice Type: "
  1.  . I +HTYP=1!(+HTYP=4) W "Outpatient/Civil Hospital Ancillary"
  1.  . I +HTYP=2 W "Civil Hospital Inpatient"
  1.  . I +HTYP=3 W "Pharmacy"
  1.  . Q
  1.  ;
  1.  ; now display the column headers
  1.  W !,"DoD Invoice Number",?21,"Patient Name",?38,"SSN"
  1.  I +HTYP=1!(+HTYP=4) W ?44,"Svc Dt    Proc   Rev"
  1.  I +HTYP=2 W ?44,"Admit Dt  Disch Dt"
  1.  I +HTYP=3 W ?44,"Fill Dt   Rx#"
  1.  W ?66,"Claimed",?79,"Paid",?90,"Adj  Reason",?103,"Dt Paid",?113,"Check#",?123,"Disbursed"
  1.  W !?3,"Fee Inv#",?14,"Bch#",?21,"Oblig#"
  1.  I +HTYP=1!(+HTYP=4) W ?54,"Modifiers"
  1.  I +HTYP=2 W ?46,"Adm Dx"
  1.  I +HTYP=3 W ?54,"Drug Name"
  1.  W !,SEPLINE
  1.  ;
  1.  ; check for a TaskManager stop request
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD() D  G HDRX
  1.  . S (ZTSTOP,FBIASTOP)=1
  1.  . W !!!?5,"*** Report Halted by TaskManager Request ***"
  1.  . Q
  1. HDRX ;
  1.  Q
  1.  ;
  1. EXCELHD ; print an Excel CSV header record (only 1 Excel CSV header should print for the whole report)
  1.  N FBH
  1.  S FBH=$$CSV("","Vendor Name")
  1.  S FBH=$$CSV(FBH,"Vendor ID")
  1.  S FBH=$$CSV(FBH,"Payment Type")
  1.  S FBH=$$CSV(FBH,"DoD Invoice#")
  1.  S FBH=$$CSV(FBH,"Date of Service/Fill Date/Admit Date")
  1.  S FBH=$$CSV(FBH,"Patient Name")
  1.  S FBH=$$CSV(FBH,"Date Finalized")
  1.  S FBH=$$CSV(FBH,"Patient SSN")
  1.  S FBH=$$CSV(FBH,"CPT Procedure Code")
  1.  S FBH=$$CSV(FBH,"CPT Procedure Modifiers")
  1.  S FBH=$$CSV(FBH,"Revenue Code")
  1.  S FBH=$$CSV(FBH,"Discharge Date")
  1.  S FBH=$$CSV(FBH,"Diagnosis/POA Codes")
  1.  S FBH=$$CSV(FBH,"Admitting Diagnosis")
  1.  S FBH=$$CSV(FBH,"Procedure Codes Inpatient")
  1.  S FBH=$$CSV(FBH,"Prescription#")
  1.  S FBH=$$CSV(FBH,"Drug Name")
  1.  S FBH=$$CSV(FBH,"Amount Claimed")
  1.  S FBH=$$CSV(FBH,"Amount Paid")
  1.  S FBH=$$CSV(FBH,"Adjustment Amount #1")
  1.  S FBH=$$CSV(FBH,"Adjustment Reason #1")
  1.  S FBH=$$CSV(FBH,"Adjustment Amount #2")
  1.  S FBH=$$CSV(FBH,"Adjustment Reason #2")
  1.  S FBH=$$CSV(FBH,"Fee Invoice#")
  1.  S FBH=$$CSV(FBH,"Batch#")
  1.  S FBH=$$CSV(FBH,"Obligation#")
  1.  S FBH=$$CSV(FBH,"Date Paid")
  1.  S FBH=$$CSV(FBH,"Check#")
  1.  S FBH=$$CSV(FBH,"Disbursed Amount")
  1.  S FBH=$$CSV(FBH,"Cancellation Date")
  1.  S FBH=$$CSV(FBH,"Voided Payment Flag")
  1.  S FBH=$$CSV(FBH,"Reject Status")
  1.  W FBH
  1.  Q
  1.  ;
  1. EXCELN(RPTG) ; write a line of CSV data
  1.  N FBZ,X,Y
  1.  S X=FBZTYPE
  1.  S Y=$S(+X=1:"Outpatient",+X=2:"Inpatient",+X=3:"Pharmacy",1:"Ancillary")
  1.  ;
  1.  S FBZ=$$CSV("",FBVENAME)                           ; vendor name
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,2))                      ; vendor ID
  1.  S FBZ=$$CSV(FBZ,Y)                                 ; invoice/payment type
  1.  S FBZ=$$CSV(FBZ,FBDODINV)                          ; DoD invoice#
  1.  S FBZ=$$CSV(FBZ,$$FMTE^XLFDT(FBZDOS,"2Z"))         ; date of service/fill date/admit date
  1.  S FBZ=$$CSV(FBZ,FBZPTNM)                           ; pt name
  1.  S FBZ=$$CSV(FBZ,$$FMTE^XLFDT($P(RPTG,U,3),"2Z"))   ; Date line item finalized within the date range of this report
  1.  S FBZ=$$CSV(FBZ,$E($P(RPTG,U,4),6,10))             ; pt ssn last 4
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,5))                      ; cpt procedure code
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,6))                      ; CPT modifiers
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,7))                      ; revenue code
  1.  S FBZ=$$CSV(FBZ,$$FMTE^XLFDT($P(RPTG,U,8),"2Z"))   ; discharge date
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,9))                      ; list of Diag/poa codes
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,10))                     ; admitting dx
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,11))                     ; list of inpatient procedure codes
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,12))                     ; prescription#
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,13))                     ; drug name
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,14))                     ; amt claimed
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,15))                     ; amt paid
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,16))                     ; adjustment amt#1
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,17))                     ; adjustment reason#1
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,18))                     ; adjustment amt#2
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,19))                     ; adjustment reason#2
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,20))                     ; fee basis invoice#
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,21))                     ; batch#
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,22))                     ; obligation#
  1.  S FBZ=$$CSV(FBZ,$$FMTE^XLFDT($P(RPTG,U,23),"2Z"))  ; date paid
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,24))                     ; check#
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,25))                     ; disbursed amt
  1.  S FBZ=$$CSV(FBZ,$$FMTE^XLFDT($P(RPTG,U,26),"2Z"))  ; cancellation date
  1.  S FBZ=$$CSV(FBZ,$S($P(RPTG,U,27):"VOID",1:""))     ; voided payment flag
  1.  S FBZ=$$CSV(FBZ,$P(RPTG,U,28))                     ; reject status
  1.  W !,FBZ
  1.  Q
  1.  ;
  1. CSV(STRING,DATA) ; build the Excel data string for CSV format
  1.  S DATA=$C(34)_$TR(DATA,$C(34),$C(39))_$C(34)
  1.  S STRING=$S(STRING="":DATA,1:STRING_","_DATA)
  1.  Q STRING
  1.  ;