BPSRPAY ;BHAM ISC/BEE - ECME REPORTS ;11/15/07 14:13
;;1.0;E CLAIMS MGMT ENGINE;**1,7,10,15,19**;JUN 2004;Build 18
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; Payer Sheet Display Report
;
;User Prompts
EN N BPFILE,BPIEN,BPSCR,BPQ
S BPFILE=9002313.92
;
;Select Payer Sheet
I $D(IOF) W @IOF
W !,"Payer Sheet Detail Report",!!
S BPIEN=$$BPIEN(BPFILE)
;
;Check for Valid Entry
I BPIEN=-1 G EXIT
;
;Select Device
I $$DEVICE=-1 G EXIT
;
;Display Data
D RUN(BPFILE,BPIEN)
;
;Exit
EXIT Q
;
;Display the Payer Sheet Info
;
RUN(BPFILE,BPIEN) N BPQ
D PSPRNT(BPFILE,BPIEN)
Q
;
; Select a payer sheet
BPIEN(BPFILE) N DIC,DIRUT,DTOUT,DUOUT,X,Y
S DIC=$$ROOT^DILFD(BPFILE),DIC(0)="AEMQ"
S DIC("A")="Select Payer Sheet: "
D ^DIC
Q +Y
;
;Select the output Device
DEVICE() N %ZIS,ZTSK,ZTRTN,ZTIO,ZTSAVE,ZTDESC,POP,BPQ
S BPQ=0
S %ZIS="QM"
W ! D ^%ZIS
I POP Q -1
S BPSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
I $D(IO("Q")) D S BPQ=-1
. S ZTRTN="RUN^BPSRPAY(BPFILE,BPIEN)"
. S ZTIO=ION
. S ZTSAVE("*")=""
. S ZTDESC="PAYER SHEET DETAIL REPORT"
. D ^%ZTLOAD
. W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
. D HOME^%ZIS
U IO
Q BPQ
;
; Payer Sheet Display
PSPRNT(BPFILE,EN) N BPSHDR,BPIEN,BPPAGE,BPQ,CD,L,N,N1,N2,NAME,NM,NUM,SEG,SP
N SEGNM,TB,WP,X,X0,X5,ZTREQ
;
; Build List of Segment Header Names
D INIT
;
; Get header information
S BPIEN=EN_","
D GETS^DIQ(BPFILE,EN,".01;1.02;1.06;1.14","","BPSHDR")
;
; Display Header Information
S BPQ=0,BPPAGE=0,SEGNM=""
D HDR
;
; Field Detail Information
; Loop through Segments
S SEG=99 F S SEG=$O(^BPSF(BPFILE,EN,SEG)) Q:+SEG=0!(SEG>300) D I BPQ Q
. ;
. ;Make sure there are entries for the segment
. I $P($G(^BPSF(BPFILE,EN,SEG,0)),U,4)<1 Q
. ;
. ; Get and display Segment Name
. S SEGNM=$G(NAME(SEG))
. ; Check that we can display the Segment Name and at least one additional field
. D CHKP(2) I BPQ Q
. I BPPAGE=1!($Y>5) W !,?((60-$L(SEGNM)+8)/2),"*** ",SEGNM," ***"
. ; Loop through the Field via the Sequence Number
. S N=0 F S N=$O(^BPSF(BPFILE,EN,SEG,"B",N)) Q:N="" D I BPQ Q
.. S N1=0 F S N1=$O(^BPSF(BPFILE,EN,SEG,"B",N,N1)) Q:N1="" D I BPQ Q
... ;
... ; Get Field Data and Format the Field Number
... S X=$G(^BPSF(BPFILE,EN,SEG,N1,0))
... S NUM=$P(X,U,2),SP=$P(X,U,3)
... I NUM S X0=$G(^BPSF(9002313.91,NUM,0)),X5=$G(^BPSF(9002313.91,NUM,5))
... E S (X0,X5)=""
... S NUM=$P(X0,U,1)_"-"_$P(X5,U,1),NM=$P(X0,U,3)
... ;
... ; Display the field information
... D CHKP(1) I BPQ Q
... W !,N,?5,NUM,?17,NM,?71,$J(SP,9)
... ;
... ; If there is special code, display it
... I SP="X" S N2=0 F S N2=$O(^BPSF(BPFILE,EN,SEG,N1,1,N2)) Q:N2="" D I BPQ Q
.... S CD=$G(^BPSF(BPFILE,EN,SEG,N1,1,N2,0))
.... S TB=19,L=61,WP=0
.... F D CHKP(1) Q:BPQ W ! D Q:CD=""
..... W:N2=1 ?5,"Special Code: "
..... W:WP=1 ?12,"<cont>"
..... W ?19,$E(CD,1,L)
..... S CD=$E(CD,L+1,200) Q:CD=""
..... S WP=1
. I BPQ Q
.D CHKP(1) Q:BPQ W !
I 'BPSCR W !,@IOF
E I 'BPQ D PAUSE2
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
XPRT Q
;
;Display Report Header
;
HDR S BPPAGE=$G(BPPAGE)+1
W @IOF
W "Payer Sheet Detail Report"
W ?48,"Print Date: "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
W " Page:",$J(BPPAGE,3)
W !,$J("Payer Sheet Name: ",20),$G(BPSHDR(BPFILE,BPIEN,.01))
W ?40,$J("Version Number: ",20),$G(BPSHDR(BPFILE,BPIEN,1.14))
I BPPAGE=1 D
. W !,$J("Status: ",20),$G(BPSHDR(BPFILE,BPIEN,1.06))
. W ?40,$J("NCPDP Version: ",20),$G(BPSHDR(BPFILE,BPIEN,1.02))
;
; Display subheader
W !!,"Seq",?5,"Field",?17,"Field Name",?71,"Proc Mode"
W !,"---",?5,"-----",?17,"----------",?71,"---------"
I $G(SEGNM)]"" W !,?((60-$L(SEGNM)+8)/2),"*** ",SEGNM," ***"
Q
;
;Check for End of Page
;
; Input variable -> BPLINES - Number of lines from bottom
; CONT - 0 = New Entry, 1 = Continue Entry
;
CHKP(BPLINES) S BPLINES=BPLINES+1
I $G(BPSCR) S BPLINES=BPLINES+3
I $Y>(IOSL-BPLINES) D:$G(BPSCR) PAUSE Q:$G(BPQ) 0 D HDR Q 1
Q 0
;
PAUSE ;
N X
U IO(0)
R !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
I '$T S X="^"
I X["^" S BPQ=1
U IO
Q
;
PAUSE2 ;
N X
U IO(0)
R !,"Press RETURN to continue: ",X:DTIME
U IO
Q
;
INIT ; Create local array of segment header names
S NAME(100)="Transaction Header Segment",NAME(110)="Patient Segment"
S NAME(120)="Insurance Segment",NAME(130)="Claim Segment"
S NAME(140)="Pharmacy Provider Segment",NAME(150)="Prescriber Segment"
S NAME(160)="COB/Other Payments Segment",NAME(170)="Workers' Compensation Segment"
S NAME(180)="DUR/PPS Segment",NAME(190)="Pricing Segment"
S NAME(200)="Coupon Segment",NAME(210)="Compound Segment"
S NAME(220)="Prior Authorization Segment",NAME(230)="Clinical Segment"
S NAME(240)="Additional Documentation Segment",NAME(250)="Facility Segment"
S NAME(260)="Narrative Segment"
; New segments added - BPS*1*15
S NAME(270)="Purchaser Segment"
S NAME(280)="Service Provider Segment"
; New segments added - BPS*1*19
S NAME(290)="Intermediary Segment"
S NAME(300)="Last Known 4Rx Segment"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRPAY 5254 printed Nov 22, 2024@17:02:45 Page 2
BPSRPAY ;BHAM ISC/BEE - ECME REPORTS ;11/15/07 14:13
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,7,10,15,19**;JUN 2004;Build 18
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; Payer Sheet Display Report
+7 ;
+8 ;User Prompts
EN NEW BPFILE,BPIEN,BPSCR,BPQ
+1 SET BPFILE=9002313.92
+2 ;
+3 ;Select Payer Sheet
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !,"Payer Sheet Detail Report",!!
+6 SET BPIEN=$$BPIEN(BPFILE)
+7 ;
+8 ;Check for Valid Entry
+9 IF BPIEN=-1
GOTO EXIT
+10 ;
+11 ;Select Device
+12 IF $$DEVICE=-1
GOTO EXIT
+13 ;
+14 ;Display Data
+15 DO RUN(BPFILE,BPIEN)
+16 ;
+17 ;Exit
EXIT QUIT
+1 ;
+2 ;Display the Payer Sheet Info
+3 ;
RUN(BPFILE,BPIEN) NEW BPQ
+1 DO PSPRNT(BPFILE,BPIEN)
+2 QUIT
+3 ;
+4 ; Select a payer sheet
BPIEN(BPFILE) NEW DIC,DIRUT,DTOUT,DUOUT,X,Y
+1 SET DIC=$$ROOT^DILFD(BPFILE)
SET DIC(0)="AEMQ"
+2 SET DIC("A")="Select Payer Sheet: "
+3 DO ^DIC
+4 QUIT +Y
+5 ;
+6 ;Select the output Device
DEVICE() NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTSAVE,ZTDESC,POP,BPQ
+1 SET BPQ=0
+2 SET %ZIS="QM"
+3 WRITE !
DO ^%ZIS
+4 IF POP
QUIT -1
+5 SET BPSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTRTN="RUN^BPSRPAY(BPFILE,BPIEN)"
+8 SET ZTIO=ION
+9 SET ZTSAVE("*")=""
+10 SET ZTDESC="PAYER SHEET DETAIL REPORT"
+11 DO ^%ZTLOAD
+12 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+13 DO HOME^%ZIS
End DoDot:1
SET BPQ=-1
+14 USE IO
+15 QUIT BPQ
+16 ;
+17 ; Payer Sheet Display
PSPRNT(BPFILE,EN) NEW BPSHDR,BPIEN,BPPAGE,BPQ,CD,L,N,N1,N2,NAME,NM,NUM,SEG,SP
+1 NEW SEGNM,TB,WP,X,X0,X5,ZTREQ
+2 ;
+3 ; Build List of Segment Header Names
+4 DO INIT
+5 ;
+6 ; Get header information
+7 SET BPIEN=EN_","
+8 DO GETS^DIQ(BPFILE,EN,".01;1.02;1.06;1.14","","BPSHDR")
+9 ;
+10 ; Display Header Information
+11 SET BPQ=0
SET BPPAGE=0
SET SEGNM=""
+12 DO HDR
+13 ;
+14 ; Field Detail Information
+15 ; Loop through Segments
+16 SET SEG=99
FOR
SET SEG=$ORDER(^BPSF(BPFILE,EN,SEG))
if +SEG=0!(SEG>300)
QUIT
Begin DoDot:1
+17 ;
+18 ;Make sure there are entries for the segment
+19 IF $PIECE($GET(^BPSF(BPFILE,EN,SEG,0)),U,4)<1
QUIT
+20 ;
+21 ; Get and display Segment Name
+22 SET SEGNM=$GET(NAME(SEG))
+23 ; Check that we can display the Segment Name and at least one additional field
+24 DO CHKP(2)
IF BPQ
QUIT
+25 IF BPPAGE=1!($Y>5)
WRITE !,?((60-$LENGTH(SEGNM)+8)/2),"*** ",SEGNM," ***"
+26 ; Loop through the Field via the Sequence Number
+27 SET N=0
FOR
SET N=$ORDER(^BPSF(BPFILE,EN,SEG,"B",N))
if N=""
QUIT
Begin DoDot:2
+28 SET N1=0
FOR
SET N1=$ORDER(^BPSF(BPFILE,EN,SEG,"B",N,N1))
if N1=""
QUIT
Begin DoDot:3
+29 ;
+30 ; Get Field Data and Format the Field Number
+31 SET X=$GET(^BPSF(BPFILE,EN,SEG,N1,0))
+32 SET NUM=$PIECE(X,U,2)
SET SP=$PIECE(X,U,3)
+33 IF NUM
SET X0=$GET(^BPSF(9002313.91,NUM,0))
SET X5=$GET(^BPSF(9002313.91,NUM,5))
+34 IF '$TEST
SET (X0,X5)=""
+35 SET NUM=$PIECE(X0,U,1)_"-"_$PIECE(X5,U,1)
SET NM=$PIECE(X0,U,3)
+36 ;
+37 ; Display the field information
+38 DO CHKP(1)
IF BPQ
QUIT
+39 WRITE !,N,?5,NUM,?17,NM,?71,$JUSTIFY(SP,9)
+40 ;
+41 ; If there is special code, display it
+42 IF SP="X"
SET N2=0
FOR
SET N2=$ORDER(^BPSF(BPFILE,EN,SEG,N1,1,N2))
if N2=""
QUIT
Begin DoDot:4
+43 SET CD=$GET(^BPSF(BPFILE,EN,SEG,N1,1,N2,0))
+44 SET TB=19
SET L=61
SET WP=0
+45 FOR
DO CHKP(1)
if BPQ
QUIT
WRITE !
Begin DoDot:5
+46 if N2=1
WRITE ?5,"Special Code: "
+47 if WP=1
WRITE ?12,"<cont>"
+48 WRITE ?19,$EXTRACT(CD,1,L)
+49 SET CD=$EXTRACT(CD,L+1,200)
if CD=""
QUIT
+50 SET WP=1
End DoDot:5
if CD=""
QUIT
End DoDot:4
IF BPQ
QUIT
End DoDot:3
IF BPQ
QUIT
End DoDot:2
IF BPQ
QUIT
+51 IF BPQ
QUIT
+52 DO CHKP(1)
if BPQ
QUIT
WRITE !
End DoDot:1
IF BPQ
QUIT
+53 IF 'BPSCR
WRITE !,@IOF
+54 IF '$TEST
IF 'BPQ
DO PAUSE2
+55 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+56 DO ^%ZISC
XPRT QUIT
+1 ;
+2 ;Display Report Header
+3 ;
HDR SET BPPAGE=$GET(BPPAGE)+1
+1 WRITE @IOF
+2 WRITE "Payer Sheet Detail Report"
+3 WRITE ?48,"Print Date: "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+4 WRITE " Page:",$JUSTIFY(BPPAGE,3)
+5 WRITE !,$JUSTIFY("Payer Sheet Name: ",20),$GET(BPSHDR(BPFILE,BPIEN,.01))
+6 WRITE ?40,$JUSTIFY("Version Number: ",20),$GET(BPSHDR(BPFILE,BPIEN,1.14))
+7 IF BPPAGE=1
Begin DoDot:1
+8 WRITE !,$JUSTIFY("Status: ",20),$GET(BPSHDR(BPFILE,BPIEN,1.06))
+9 WRITE ?40,$JUSTIFY("NCPDP Version: ",20),$GET(BPSHDR(BPFILE,BPIEN,1.02))
End DoDot:1
+10 ;
+11 ; Display subheader
+12 WRITE !!,"Seq",?5,"Field",?17,"Field Name",?71,"Proc Mode"
+13 WRITE !,"---",?5,"-----",?17,"----------",?71,"---------"
+14 IF $GET(SEGNM)]""
WRITE !,?((60-$LENGTH(SEGNM)+8)/2),"*** ",SEGNM," ***"
+15 QUIT
+16 ;
+17 ;Check for End of Page
+18 ;
+19 ; Input variable -> BPLINES - Number of lines from bottom
+20 ; CONT - 0 = New Entry, 1 = Continue Entry
+21 ;
CHKP(BPLINES) SET BPLINES=BPLINES+1
+1 IF $GET(BPSCR)
SET BPLINES=BPLINES+3
+2 IF $Y>(IOSL-BPLINES)
if $GET(BPSCR)
DO PAUSE
if $GET(BPQ)
QUIT 0
DO HDR
QUIT 1
+3 QUIT 0
+4 ;
PAUSE ;
+1 NEW X
+2 USE IO(0)
+3 READ !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
+4 IF '$TEST
SET X="^"
+5 IF X["^"
SET BPQ=1
+6 USE IO
+7 QUIT
+8 ;
PAUSE2 ;
+1 NEW X
+2 USE IO(0)
+3 READ !,"Press RETURN to continue: ",X:DTIME
+4 USE IO
+5 QUIT
+6 ;
INIT ; Create local array of segment header names
+1 SET NAME(100)="Transaction Header Segment"
SET NAME(110)="Patient Segment"
+2 SET NAME(120)="Insurance Segment"
SET NAME(130)="Claim Segment"
+3 SET NAME(140)="Pharmacy Provider Segment"
SET NAME(150)="Prescriber Segment"
+4 SET NAME(160)="COB/Other Payments Segment"
SET NAME(170)="Workers' Compensation Segment"
+5 SET NAME(180)="DUR/PPS Segment"
SET NAME(190)="Pricing Segment"
+6 SET NAME(200)="Coupon Segment"
SET NAME(210)="Compound Segment"
+7 SET NAME(220)="Prior Authorization Segment"
SET NAME(230)="Clinical Segment"
+8 SET NAME(240)="Additional Documentation Segment"
SET NAME(250)="Facility Segment"
+9 SET NAME(260)="Narrative Segment"
+10 ; New segments added - BPS*1*15
+11 SET NAME(270)="Purchaser Segment"
+12 SET NAME(280)="Service Provider Segment"
+13 ; New segments added - BPS*1*19
+14 SET NAME(290)="Intermediary Segment"
+15 SET NAME(300)="Last Known 4Rx Segment"
+16 QUIT
