IBCNHPR2 ;ALB/CJS - HPID ADDED TO BILLING CLAIM REPORT (PRINT) ;15-DEC-14
;;2.0;INTEGRATED BILLING;**525**;21-MAR-94;Build 105
;;Per VA Directive 6402, this routine should not be modified.
;
; Print the report.
;
; Input Parameter: IBOUT = "R" for Report format or "E" for Excel format (defaults to "R")
; Required Input:
; Global print array ^TMP($J,"IBHP",HPID edit date,Bill/Claim IEN,HPID edit index)=
; patient name^last 4 SSN^insurance company name^HPID^station number-claim number^user name^date HPID added^professional ID^institutional ID
;
EN(IBOUT) N %,IBHDT,IBI,IBJ,IBK,IBLN,IBPAG,IBQUIT
;
I '$D(^TMP($J,"IBHP")) W !,"*** No claim-level HPIDs added within date range ***" D PAUSE G END
;
I "^R^E^"'[(U_$G(IBOUT)_U) S IBOUT="R"
S (IBI,IBJ,IBK,IBQUIT,IBPAG)=0
S IBLN=""
D NOW^%DTC S IBHDT=$$DAT2^IBOUTL($E(%,1,12))
;
;Excel header
I IBOUT="E" D PHDL
;
;Report header
I IBOUT="R" D HDR
;
;Data output
F S IBI=$O(^TMP($J,"IBHP",IBI)) Q:'IBI D Q:IBQUIT
.S IBJ=0 F S IBJ=$O(^TMP($J,"IBHP",IBI,IBJ)) Q:'IBJ D Q:IBQUIT
..S IBK=0 F S IBK=$O(^TMP($J,"IBHP",IBI,IBJ,IBK)) Q:IBK="" S IBLN=$G(^(IBK)) D Q:IBQUIT
...I IBOUT="E" W !,IBLN Q
...I $Y>(IOSL-4) D PAUSE Q:IBQUIT D HDR
...D LINE
;
I 'IBQUIT D PAUSE
;
END K IBI,IBJ,IBK,IBLN,IBQUIT,IBPAG,IBHDT
Q
;
;
HDR ; Print header
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !,"MANUALLY ADDED HPIDs TO BILLING CLAIM REPORT"
W ?IOM-34,IBHDT,?IOM-10,"Page: ",IBPAG
;
; - sub-header
W !!,"PT NAME",?21,"SSN",?27,"PAYER",?47,"HPID",?59,"CLAIM #",?72,"USER NAME",?93,"DATE HPID ADDED"
W ?110,"PROF ID",?121,"INST ID"
W !,$TR($J(" ",IOM)," ","-")
Q
;
LINE ; Print claim information.
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)
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)
Q
;
PAUSE ; Pause for screen output.
N IBJJ,DIR,DIRUT,DTOUT,DUOUT
Q:$E(IOST,1,2)'["C-"
;F IBJJ=$Y:1:(IOSL-7) W ! ; IB*2.0*525 - CJS - Fix scrolling problem
S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
Q
;
PHDL ; - Print the header line for the Excel spreadsheet
N X
S X="Patient Name^SSN^Payer^HPID^Claim Number^User Name^Date HPID Added^"
S X=X_"Professional ID^Institutional ID"
W !,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNHPR2 2439 printed Sep 23, 2025@19:52:01 Page 2
IBCNHPR2 ;ALB/CJS - HPID ADDED TO BILLING CLAIM REPORT (PRINT) ;15-DEC-14
+1 ;;2.0;INTEGRATED BILLING;**525**;21-MAR-94;Build 105
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Print the report.
+5 ;
+6 ; Input Parameter: IBOUT = "R" for Report format or "E" for Excel format (defaults to "R")
+7 ; Required Input:
+8 ; Global print array ^TMP($J,"IBHP",HPID edit date,Bill/Claim IEN,HPID edit index)=
+9 ; patient name^last 4 SSN^insurance company name^HPID^station number-claim number^user name^date HPID added^professional ID^institutional ID
+10 ;
EN(IBOUT) NEW %,IBHDT,IBI,IBJ,IBK,IBLN,IBPAG,IBQUIT
+1 ;
+2 IF '$DATA(^TMP($JOB,"IBHP"))
WRITE !,"*** No claim-level HPIDs added within date range ***"
DO PAUSE
GOTO END
+3 ;
+4 IF "^R^E^"'[(U_$GET(IBOUT)_U)
SET IBOUT="R"
+5 SET (IBI,IBJ,IBK,IBQUIT,IBPAG)=0
+6 SET IBLN=""
+7 DO NOW^%DTC
SET IBHDT=$$DAT2^IBOUTL($EXTRACT(%,1,12))
+8 ;
+9 ;Excel header
+10 IF IBOUT="E"
DO PHDL
+11 ;
+12 ;Report header
+13 IF IBOUT="R"
DO HDR
+14 ;
+15 ;Data output
+16 FOR
SET IBI=$ORDER(^TMP($JOB,"IBHP",IBI))
if 'IBI
QUIT
Begin DoDot:1
+17 SET IBJ=0
FOR
SET IBJ=$ORDER(^TMP($JOB,"IBHP",IBI,IBJ))
if 'IBJ
QUIT
Begin DoDot:2
+18 SET IBK=0
FOR
SET IBK=$ORDER(^TMP($JOB,"IBHP",IBI,IBJ,IBK))
if IBK=""
QUIT
SET IBLN=$GET(^(IBK))
Begin DoDot:3
+19 IF IBOUT="E"
WRITE !,IBLN
QUIT
+20 IF $Y>(IOSL-4)
DO PAUSE
if IBQUIT
QUIT
DO HDR
+21 DO LINE
End DoDot:3
if IBQUIT
QUIT
End DoDot:2
if IBQUIT
QUIT
End DoDot:1
if IBQUIT
QUIT
+22 ;
+23 IF 'IBQUIT
DO PAUSE
+24 ;
END KILL IBI,IBJ,IBK,IBLN,IBQUIT,IBPAG,IBHDT
+1 QUIT
+2 ;
+3 ;
HDR ; Print header
+1 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+2 SET IBPAG=IBPAG+1
+3 WRITE !,"MANUALLY ADDED HPIDs TO BILLING CLAIM REPORT"
+4 WRITE ?IOM-34,IBHDT,?IOM-10,"Page: ",IBPAG
+5 ;
+6 ; - sub-header
+7 WRITE !!,"PT NAME",?21,"SSN",?27,"PAYER",?47,"HPID",?59,"CLAIM #",?72,"USER NAME",?93,"DATE HPID ADDED"
+8 WRITE ?110,"PROF ID",?121,"INST ID"
+9 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+10 QUIT
+11 ;
LINE ; Print claim information.
+1 WRITE !,$EXTRACT($PIECE(IBLN,U),1,18),?21,$PIECE(IBLN,U,2),?27,$EXTRACT($PIECE(IBLN,U,3),1,18),?47,$PIECE(IBLN,U,4),?59,$EXTRACT($PIECE(IBLN,U,5),1,11)
+2 WRITE ?72,$EXTRACT($PIECE(IBLN,U,6),1,18),?94,$EXTRACT($PIECE(IBLN,U,7),1,10),?110,$EXTRACT($PIECE(IBLN,U,8),1,10),?121,$EXTRACT($PIECE(IBLN,U,9),1,10)
+3 QUIT
+4 ;
PAUSE ; Pause for screen output.
+1 NEW IBJJ,DIR,DIRUT,DTOUT,DUOUT
+2 if $EXTRACT(IOST,1,2)'["C-"
QUIT
+3 ;F IBJJ=$Y:1:(IOSL-7) W ! ; IB*2.0*525 - CJS - Fix scrolling problem
+4 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBQUIT=1
KILL DIRUT,DTOUT,DUOUT
+5 QUIT
+6 ;
PHDL ; - Print the header line for the Excel spreadsheet
+1 NEW X
+2 SET X="Patient Name^SSN^Payer^HPID^Claim Number^User Name^Date HPID Added^"
+3 SET X=X_"Professional ID^Institutional ID"
+4 WRITE !,X
+5 QUIT
