- 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 Feb 18, 2025@23:42:11 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