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

BPSRPAY.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. ; Payer Sheet Display Report
  1. ;
  1. ;User Prompts
  1. EN N BPFILE,BPIEN,BPSCR,BPQ
  1. S BPFILE=9002313.92
  1. ;
  1. ;Select Payer Sheet
  1. I $D(IOF) W @IOF
  1. W !,"Payer Sheet Detail Report",!!
  1. S BPIEN=$$BPIEN(BPFILE)
  1. ;
  1. ;Check for Valid Entry
  1. I BPIEN=-1 G EXIT
  1. ;
  1. ;Select Device
  1. I $$DEVICE=-1 G EXIT
  1. ;
  1. ;Display Data
  1. D RUN(BPFILE,BPIEN)
  1. ;
  1. ;Exit
  1. EXIT Q
  1. ;
  1. ;Display the Payer Sheet Info
  1. ;
  1. RUN(BPFILE,BPIEN) N BPQ
  1. D PSPRNT(BPFILE,BPIEN)
  1. Q
  1. ;
  1. ; Select a payer sheet
  1. BPIEN(BPFILE) N DIC,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIC=$$ROOT^DILFD(BPFILE),DIC(0)="AEMQ"
  1. S DIC("A")="Select Payer Sheet: "
  1. D ^DIC
  1. Q +Y
  1. ;
  1. ;Select the output Device
  1. DEVICE() N %ZIS,ZTSK,ZTRTN,ZTIO,ZTSAVE,ZTDESC,POP,BPQ
  1. S BPQ=0
  1. S %ZIS="QM"
  1. W ! D ^%ZIS
  1. I POP Q -1
  1. S BPSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
  1. I $D(IO("Q")) D S BPQ=-1
  1. . S ZTRTN="RUN^BPSRPAY(BPFILE,BPIEN)"
  1. . S ZTIO=ION
  1. . S ZTSAVE("*")=""
  1. . S ZTDESC="PAYER SHEET DETAIL REPORT"
  1. . D ^%ZTLOAD
  1. . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
  1. . D HOME^%ZIS
  1. U IO
  1. Q BPQ
  1. ;
  1. ; Payer Sheet Display
  1. PSPRNT(BPFILE,EN) N BPSHDR,BPIEN,BPPAGE,BPQ,CD,L,N,N1,N2,NAME,NM,NUM,SEG,SP
  1. N SEGNM,TB,WP,X,X0,X5,ZTREQ
  1. ;
  1. ; Build List of Segment Header Names
  1. D INIT
  1. ;
  1. ; Get header information
  1. S BPIEN=EN_","
  1. D GETS^DIQ(BPFILE,EN,".01;1.02;1.06;1.14","","BPSHDR")
  1. ;
  1. ; Display Header Information
  1. S BPQ=0,BPPAGE=0,SEGNM=""
  1. D HDR
  1. ;
  1. ; Field Detail Information
  1. ; Loop through Segments
  1. S SEG=99 F S SEG=$O(^BPSF(BPFILE,EN,SEG)) Q:+SEG=0!(SEG>300) D I BPQ Q
  1. . ;
  1. . ;Make sure there are entries for the segment
  1. . I $P($G(^BPSF(BPFILE,EN,SEG,0)),U,4)<1 Q
  1. . ;
  1. . ; Get and display Segment Name
  1. . S SEGNM=$G(NAME(SEG))
  1. . ; Check that we can display the Segment Name and at least one additional field
  1. . D CHKP(2) I BPQ Q
  1. . I BPPAGE=1!($Y>5) W !,?((60-$L(SEGNM)+8)/2),"*** ",SEGNM," ***"
  1. . ; Loop through the Field via the Sequence Number
  1. . S N=0 F S N=$O(^BPSF(BPFILE,EN,SEG,"B",N)) Q:N="" D I BPQ Q
  1. .. S N1=0 F S N1=$O(^BPSF(BPFILE,EN,SEG,"B",N,N1)) Q:N1="" D I BPQ Q
  1. ... ;
  1. ... ; Get Field Data and Format the Field Number
  1. ... S X=$G(^BPSF(BPFILE,EN,SEG,N1,0))
  1. ... S NUM=$P(X,U,2),SP=$P(X,U,3)
  1. ... I NUM S X0=$G(^BPSF(9002313.91,NUM,0)),X5=$G(^BPSF(9002313.91,NUM,5))
  1. ... E S (X0,X5)=""
  1. ... S NUM=$P(X0,U,1)_"-"_$P(X5,U,1),NM=$P(X0,U,3)
  1. ... ;
  1. ... ; Display the field information
  1. ... D CHKP(1) I BPQ Q
  1. ... W !,N,?5,NUM,?17,NM,?71,$J(SP,9)
  1. ... ;
  1. ... ; If there is special code, display it
  1. ... I SP="X" S N2=0 F S N2=$O(^BPSF(BPFILE,EN,SEG,N1,1,N2)) Q:N2="" D I BPQ Q
  1. .... S CD=$G(^BPSF(BPFILE,EN,SEG,N1,1,N2,0))
  1. .... S TB=19,L=61,WP=0
  1. .... F D CHKP(1) Q:BPQ W ! D Q:CD=""
  1. ..... W:N2=1 ?5,"Special Code: "
  1. ..... W:WP=1 ?12,"<cont>"
  1. ..... W ?19,$E(CD,1,L)
  1. ..... S CD=$E(CD,L+1,200) Q:CD=""
  1. ..... S WP=1
  1. . I BPQ Q
  1. .D CHKP(1) Q:BPQ W !
  1. I 'BPSCR W !,@IOF
  1. E I 'BPQ D PAUSE2
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. D ^%ZISC
  1. XPRT Q
  1. ;
  1. ;Display Report Header
  1. ;
  1. HDR S BPPAGE=$G(BPPAGE)+1
  1. W @IOF
  1. W "Payer Sheet Detail Report"
  1. W ?48,"Print Date: "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
  1. W " Page:",$J(BPPAGE,3)
  1. W !,$J("Payer Sheet Name: ",20),$G(BPSHDR(BPFILE,BPIEN,.01))
  1. W ?40,$J("Version Number: ",20),$G(BPSHDR(BPFILE,BPIEN,1.14))
  1. I BPPAGE=1 D
  1. . W !,$J("Status: ",20),$G(BPSHDR(BPFILE,BPIEN,1.06))
  1. . W ?40,$J("NCPDP Version: ",20),$G(BPSHDR(BPFILE,BPIEN,1.02))
  1. ;
  1. ; Display subheader
  1. W !!,"Seq",?5,"Field",?17,"Field Name",?71,"Proc Mode"
  1. W !,"---",?5,"-----",?17,"----------",?71,"---------"
  1. I $G(SEGNM)]"" W !,?((60-$L(SEGNM)+8)/2),"*** ",SEGNM," ***"
  1. Q
  1. ;
  1. ;Check for End of Page
  1. ;
  1. ; Input variable -> BPLINES - Number of lines from bottom
  1. ; CONT - 0 = New Entry, 1 = Continue Entry
  1. ;
  1. CHKP(BPLINES) S BPLINES=BPLINES+1
  1. I $G(BPSCR) S BPLINES=BPLINES+3
  1. I $Y>(IOSL-BPLINES) D:$G(BPSCR) PAUSE Q:$G(BPQ) 0 D HDR Q 1
  1. Q 0
  1. ;
  1. PAUSE ;
  1. N X
  1. U IO(0)
  1. R !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
  1. I '$T S X="^"
  1. I X["^" S BPQ=1
  1. U IO
  1. Q
  1. ;
  1. PAUSE2 ;
  1. N X
  1. U IO(0)
  1. R !,"Press RETURN to continue: ",X:DTIME
  1. U IO
  1. Q
  1. ;
  1. INIT ; Create local array of segment header names
  1. S NAME(100)="Transaction Header Segment",NAME(110)="Patient Segment"
  1. S NAME(120)="Insurance Segment",NAME(130)="Claim Segment"
  1. S NAME(140)="Pharmacy Provider Segment",NAME(150)="Prescriber Segment"
  1. S NAME(160)="COB/Other Payments Segment",NAME(170)="Workers' Compensation Segment"
  1. S NAME(180)="DUR/PPS Segment",NAME(190)="Pricing Segment"
  1. S NAME(200)="Coupon Segment",NAME(210)="Compound Segment"
  1. S NAME(220)="Prior Authorization Segment",NAME(230)="Clinical Segment"
  1. S NAME(240)="Additional Documentation Segment",NAME(250)="Facility Segment"
  1. S NAME(260)="Narrative Segment"
  1. ; New segments added - BPS*1*15
  1. S NAME(270)="Purchaser Segment"
  1. S NAME(280)="Service Provider Segment"
  1. ; New segments added - BPS*1*19
  1. S NAME(290)="Intermediary Segment"
  1. S NAME(300)="Last Known 4Rx Segment"
  1. Q