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

IBCNHPR2.m

Go to the documentation of this file.
  1. IBCNHPR2 ;ALB/CJS - HPID ADDED TO BILLING CLAIM REPORT (PRINT) ;15-DEC-14
  1. ;;2.0;INTEGRATED BILLING;**525**;21-MAR-94;Build 105
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Print the report.
  1. ;
  1. ; Input Parameter: IBOUT = "R" for Report format or "E" for Excel format (defaults to "R")
  1. ; Required Input:
  1. ; Global print array ^TMP($J,"IBHP",HPID edit date,Bill/Claim IEN,HPID edit index)=
  1. ; patient name^last 4 SSN^insurance company name^HPID^station number-claim number^user name^date HPID added^professional ID^institutional ID
  1. ;
  1. EN(IBOUT) N %,IBHDT,IBI,IBJ,IBK,IBLN,IBPAG,IBQUIT
  1. ;
  1. I '$D(^TMP($J,"IBHP")) W !,"*** No claim-level HPIDs added within date range ***" D PAUSE G END
  1. ;
  1. I "^R^E^"'[(U_$G(IBOUT)_U) S IBOUT="R"
  1. S (IBI,IBJ,IBK,IBQUIT,IBPAG)=0
  1. S IBLN=""
  1. D NOW^%DTC S IBHDT=$$DAT2^IBOUTL($E(%,1,12))
  1. ;
  1. ;Excel header
  1. I IBOUT="E" D PHDL
  1. ;
  1. ;Report header
  1. I IBOUT="R" D HDR
  1. ;
  1. ;Data output
  1. F S IBI=$O(^TMP($J,"IBHP",IBI)) Q:'IBI D Q:IBQUIT
  1. .S IBJ=0 F S IBJ=$O(^TMP($J,"IBHP",IBI,IBJ)) Q:'IBJ D Q:IBQUIT
  1. ..S IBK=0 F S IBK=$O(^TMP($J,"IBHP",IBI,IBJ,IBK)) Q:IBK="" S IBLN=$G(^(IBK)) D Q:IBQUIT
  1. ...I IBOUT="E" W !,IBLN Q
  1. ...I $Y>(IOSL-4) D PAUSE Q:IBQUIT D HDR
  1. ...D LINE
  1. ;
  1. I 'IBQUIT D PAUSE
  1. ;
  1. END K IBI,IBJ,IBK,IBLN,IBQUIT,IBPAG,IBHDT
  1. Q
  1. ;
  1. ;
  1. HDR ; Print header
  1. I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
  1. S IBPAG=IBPAG+1
  1. W !,"MANUALLY ADDED HPIDs TO BILLING CLAIM REPORT"
  1. W ?IOM-34,IBHDT,?IOM-10,"Page: ",IBPAG
  1. ;
  1. ; - sub-header
  1. W !!,"PT NAME",?21,"SSN",?27,"PAYER",?47,"HPID",?59,"CLAIM #",?72,"USER NAME",?93,"DATE HPID ADDED"
  1. W ?110,"PROF ID",?121,"INST ID"
  1. W !,$TR($J(" ",IOM)," ","-")
  1. Q
  1. ;
  1. LINE ; Print claim information.
  1. W !,$E($P(IBLN,U),1,18),?21,$P(IBLN,U,2),?27,$E($P(IBLN,U,3),1,18),?47,$P(IBLN,U,4),?59,$E($P(IBLN,U,5),1,11)
  1. W ?72,$E($P(IBLN,U,6),1,18),?94,$E($P(IBLN,U,7),1,10),?110,$E($P(IBLN,U,8),1,10),?121,$E($P(IBLN,U,9),1,10)
  1. Q
  1. ;
  1. PAUSE ; Pause for screen output.
  1. N IBJJ,DIR,DIRUT,DTOUT,DUOUT
  1. Q:$E(IOST,1,2)'["C-"
  1. ;F IBJJ=$Y:1:(IOSL-7) W ! ; IB*2.0*525 - CJS - Fix scrolling problem
  1. S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
  1. Q
  1. ;
  1. PHDL ; - Print the header line for the Excel spreadsheet
  1. N X
  1. S X="Patient Name^SSN^Payer^HPID^Claim Number^User Name^Date HPID Added^"
  1. S X=X_"Professional ID^Institutional ID"
  1. W !,X
  1. Q