BPSVRX1 ;ALB/ESG - View ECME Prescription continued ;5/23/2011
;;1.0;E CLAIMS MGMT ENGINE;**11,15**;JUN 2004;Build 13
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Reference to ^IBCNR(366.14, supported by DBIA #5711
; Reference to PRINT^IBNCPEV supported by DBIA #5712
; Reference to IBDSP^IBJTU6 supported by DBIA #5713
; Reference to RXINS^IBNCPDPU supported by DBIA #5714
; Reference to $$RXBILL^IBNCPUT3 supported by DBIA #5355
; Reference to RX^PSO52API supported by DBIA #4820
; Reference to DP^PSORXVW supported by DBIA #4711
;
Q
;
VIEWRX(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; View Prescriptions [PSO VIEW]
I '$D(ZTQUEUED) W !,"Compiling data for View Prescriptions ... "
N DA,PSOVDA,PS,VALMHDR,VALM
N %,%H,%I,DAT,DFN,DIC,DIR,DIRUT,DUOUT,DTOUT,DN,DTT,EXDT,FFX,GMRA,GMRAL,HDR
N I,II,IFN,J,L1,LBL,LENGTH,MED,M1,N,OUT,P0,P1,PHYS,PL,POERR,PSDIV,PSEXDT
N PSOAL,PSOBCK,PSODFN,PSOHD,PSOELSE,PSONOAL,PTST,R3,REA,REFL,RF,RFDATE,RFL
N RFL1,RFLL,RFT,RLD,RN,RTN,RX0,RX2,RX3,RXN,RXOR,SG,SIG,SIGOK,ST,STA,VA,VACNTRY
N VADM,VAERR,VAPA,X,Y,Z,Z0,Z1,ZD
;
S (DA,PSOVDA)=RXIEN,PS="VIEW"
K ^TMP("PSOHDR",$J),^TMP("PSOAL",$J)
D
. N BPSSNUM,VALMEVL S VALMEVL=999
. D DP^PSORXVW ; DBIA #4711
. Q
D UPDATE^BPSVRX($NA(^TMP("PSOAL",$J)),.VALMHDR,$G(VALM("TITLE")),"View Prescription Data",BPSSNUM)
K ^TMP("PSOHDR",$J),^TMP("PSOAL",$J)
;
VIEWX ;
Q
;
LOG(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; ECME Print Claim Log
I '$D(ZTQUEUED) W !,"Compiling data for the ECME Claim Log ... "
N BPSVRXCOB,BPSINSCT
;
; initially count up how many insurances we're dealing with
S BPSINSCT=0
F BPSVRXCOB=1:1:3 D
. N IEN59
. S IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,BPSVRXCOB) Q:'$D(^BPST(IEN59,0))
. S BPSINSCT=BPSINSCT+1
. Q
;
I 'BPSINSCT D UPDATE^BPSVRX("","","","ECME Claim Log Data",BPSSNUM) G LOGX ; no data found
;
F BPSVRXCOB=1:1:3 D
. N IEN59,DFN,INS,VRXHDR,LINE,VALMHDR,VALMAR,INSSEQ
. S IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,BPSVRXCOB) Q:'$D(^BPST(IEN59,0))
. S DFN=+$P($G(^BPST(IEN59,0)),U,6) Q:'DFN
. S INS=+$P($G(^BPST(IEN59,10,+$G(^BPST(IEN59,9)),3)),U,5) ; ins co ien
. I 'INS S INS=+$$INSNAM^BPSRPT6(IEN59) ; ins co ien alternative
. Q:'INS
. S INSSEQ=$S(BPSVRXCOB=1:"Primary",BPSVRXCOB=2:"Secondary",1:"Tertiary")
. S VRXHDR="ECME Claim Log Data"
. I BPSINSCT>1 S VRXHDR=VRXHDR_" - "_INSSEQ_" Insurance" ; only if multiple payers
. S VALMAR=$NA(^TMP("BPSLOG",$J,"VALM"))
. K @VALMAR
. S LINE=1
. D
.. N BPLNCNT,BPSVRXCOB,BPADDMSG,RXIEN,FILL,BPSSNUM,VRXHDR,BPL,D0,VA,VAERR,X,Y ; protect variables
.. N VALMEVL S VALMEVL=999
.. S BPLNCNT=$$PREPINFO^BPSSCRLG(.LINE,DFN,INS,IEN59) ; build ECME claim log listman array
.. Q
. D HDR^BPSSCRLG ; listman header array for this list
. D UPDATE^BPSVRX(VALMAR,.VALMHDR,"",VRXHDR,BPSSNUM)
. K @VALMAR
. Q
;
LOGX ;
Q
;
BILL(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; IB ECME Billing Events Report (DBIA# 5711 for global reference to file 366.14)
I '$D(ZTQUEUED) W !,"Compiling data for the ECME Billing Events Report ... "
;
N REF,IBDTIEN,IBEVNT,VRXHDR,IB1ST,IBFN,IBI,IBN,IBNUM,IBRX1,SCR,D0,PSSDIY,X,Y
N IBSCR,IBQ,IBPAGE,IBBDT,IBEDT,IBDTL,IBDIVS,IBM1,IBM2,IBM3,IBRX,IBSC,IBNB
S REF=$NA(^TMP($J,"IBNCPDPE"))
K @REF ; init scratch global for compiling
S VRXHDR="ECME Billing Events Report Data"
;
S IBDTIEN=0 F S IBDTIEN=$O(^IBCNR(366.14,"I",RXIEN,IBDTIEN)) Q:'IBDTIEN D
. S IBEVNT=0 F S IBEVNT=$O(^IBCNR(366.14,"I",RXIEN,IBDTIEN,IBEVNT)) Q:'IBEVNT D
.. I FILL'=$P($G(^IBCNR(366.14,IBDTIEN,1,IBEVNT,2)),U,3) Q ; fill# check
.. S @REF@(RXIEN,FILL,IBDTIEN,IBEVNT)="" ; save into scratch global
.. Q
. Q
;
I '$D(@REF) D UPDATE^BPSVRX("","","",VRXHDR,BPSSNUM) G BILLX
;
; init variables necessary for printing the report
S (IBSCR,IBQ,IBPAGE)=0
S IBBDT=+$O(^IBCNR(366.14,"B",0)) ; begin date
S IBEDT=+$O(^IBCNR(366.14,"B",""),-1) ; end date
S IBDTL=1
S IBDIVS=0
S IBDIVS(0)="0^ALL"
S IBM1="R"
S IBM2="B"
S IBM3="A"
S IBRX=RXIEN
S IBSC="STATUS CHECK"
S IBNB="Not ECME billable: "
;
D HFS^BPSVRX("BER","PRINT^IBNCPEV",VRXHDR,"",BPSSNUM) ; save report output DBIA #5712
K ^TMP($J,"IBNCPDPE") ; clean-up scratch global
;
BILLX ;
Q
;
CRI(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; ECME Claims-Response Inquiry [BPS RPT Claims Response]
I '$D(ZTQUEUED) W !,"Compiling data for the ECME Claims-Response Inquiry (CRI) Report ... "
;
N LIST,LISTX,BPSVRXCOB,BPSVRXG,BPSVRXGT,BPSINSCT
N A,BP03,D0,ERROR,I,S,X,Y,%
;
; initially count up how many insurances we're dealing with
S BPSINSCT=0
F BPSVRXCOB=1:1:3 D
. N IEN59
. S IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,BPSVRXCOB) Q:'$D(^BPST(IEN59,0))
. S BPSINSCT=BPSINSCT+1
. Q
;
K LIST,LISTX S LIST=0
F BPSVRXCOB=1:1:3 D
. N IEN59
. S IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,BPSVRXCOB) Q:'$D(^BPST(IEN59,0))
. ;
. ; if VIEWTYPE=ALL then look at all transactions in file 9002313.57
. I VIEWTYPE="A" D
.. N IEN57,BP02
.. S IEN57=0 F S IEN57=$O(^BPSTL("B",IEN59,IEN57)) Q:'IEN57 D
... S BP02=+$P($G(^BPSTL(IEN57,0)),U,4) ; claim
... I BP02,'$D(LISTX(BP02)) S LIST=$G(LIST)+1,LIST(LIST)=BP02_U_0_U_BPSVRXCOB,LISTX(BP02)=""
... ;
... S BP02=+$P($G(^BPSTL(IEN57,4)),U,1) ; reversal claim
... I BP02,'$D(LISTX(BP02)) S LIST=$G(LIST)+1,LIST(LIST)=BP02_U_1_U_BPSVRXCOB,LISTX(BP02)=""
... Q
.. Q
. ;
. ; otherwise just look at the most recent transactions in file 9002313.59
. I VIEWTYPE'="A" D
.. N BP02
.. S BP02=+$P($G(^BPST(IEN59,0)),U,4) ; claim
.. I BP02,'$D(LISTX(BP02)) S LIST=$G(LIST)+1,LIST(LIST)=BP02_U_0_U_BPSVRXCOB,LISTX(BP02)=""
.. ;
.. S BP02=+$P($G(^BPST(IEN59,4)),U,1) ; reversal claim
.. I BP02,'$D(LISTX(BP02)) S LIST=$G(LIST)+1,LIST(LIST)=BP02_U_1_U_BPSVRXCOB,LISTX(BP02)=""
.. Q
. Q
;
; now go through the list in reverse order and generate and save the CRI reports
S BPSVRXGT=LIST ; total number of CRI reports
;
I 'BPSVRXGT D UPDATE^BPSVRX("","","","ECME Claims-Response Inquiry Report Data",BPSSNUM) ; no data found
;
S BPSVRXG=99999 F S BPSVRXG=$O(LIST(BPSVRXG),-1) Q:'BPSVRXG D
. N BPX,BP02,BPREV,COB,BPVAX,BPSCR,BPCFILE,VRXHDR,CRIHDR,HC
. S BPX=LIST(BPSVRXG)
. S BP02=$P(BPX,U,1)
. S BPREV=$P(BPX,U,2)
. S COB=$P(BPX,U,3)
. S BPVAX=$P($G(^BPSC(BP02,0)),U,1)
. S BPSCR=0,BPCFILE=9002313.02
. S VRXHDR="ECME Claims-Response Inquiry Report Data ("_(BPSVRXGT-BPSVRXG+1)_" of "_BPSVRXGT_")"
. S HC=0
. I BPSINSCT>1 S HC=HC+1,CRIHDR(HC)="Payer Sequence: "_$S(COB=1:"Primary",COB=2:"Secondary",1:"Tertiary")
. I BPREV S HC=HC+1,CRIHDR(HC)="This is the Reversal Claim"
. D
.. N BPSVRXG,LIST,LISTX,BPSVRXGT,BPSINSCT ; protect variables
.. D HFS^BPSVRX("CRI","RUNRPT^BPSRCRI",VRXHDR,.CRIHDR,BPSSNUM)
.. Q
. Q
CRIX ;
Q
;
INS(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; View Pharmacy Insurance policies
I '$D(ZTQUEUED) W !,"Compiling data for View Insurance Policies ... "
N BPSDOS,DFN,BPSPINS,BPSINSCT,VRXHDR,BPINSCG,BPVXCOB,BPVXIEN,VALMHDR,BPSSCRG,BPSCDFN,BPSGDAN
;
S BPSDOS=$$DOSDATE^BPSSCRRS(RXIEN,FILL) ; date of service
S DFN=+$$RXAPI1^BPSUTIL1(RXIEN,2,"I") ; patient ien
;
D RXINS^IBNCPDPU(DFN,BPSDOS,.BPSPINS) ; DBIA #5714
S BPSINSCT=+$G(BPSPINS) ; ins count of Rx policies
;
S VRXHDR="Prescription Insurance Policy Data"
I 'BPSINSCT D UPDATE^BPSVRX("","","",VRXHDR,BPSSNUM) G INSX ; get out of here if no data found
;
; loop through Rx policies found and display policy data
S BPINSCG=0
S BPVXCOB="" F S BPVXCOB=$O(BPSPINS("S",BPVXCOB)) Q:BPVXCOB="" D
. S BPVXIEN=0 F S BPVXIEN=$O(BPSPINS("S",BPVXCOB,BPVXIEN)) Q:'BPVXIEN D
.. S BPINSCG=BPINSCG+1
.. S BPSSCRG=$NA(^TMP("BPSVRX-INS",$J)) ; scratch global array name
.. S BPSCDFN=BPVXIEN ; need to protect BPVXIEN below (2.312 subfile ien)
.. S BPSGDAN=BPSSCRG ; need to protect BPSSCRG below (scratch global array name)
.. ;
.. D
... ; protect/clean up variables
... N BPINSCG,BPVXCOB,BPSINSCT,BPSSNUM,BPSPINS,BPVXIEN,BPSSCRG
... N VALMEVL S VALMEVL=999
... D IBDSP^IBJTU6(5,"",DFN,BPSCDFN,BPSGDAN,.VALMHDR) ; DBIA #5713
... Q
.. ;
.. S VRXHDR="Prescription Insurance Policy Data"
.. ;
.. ; add the payer sequence indicator to the header if more than 1 ins policy is being displayed
.. I BPSINSCT>1 D
... S VALMHDR($O(VALMHDR(""),-1)+1)="Payer Sequence: "_$S(BPVXCOB=1:"Primary",BPVXCOB=2:"Secondary",1:"Tertiary")
... S VRXHDR=VRXHDR_" ("_BPINSCG_" of "_BPSINSCT_")"
... Q
.. ;
.. D UPDATE^BPSVRX(BPSSCRG,.VALMHDR,"",VRXHDR,BPSSNUM)
.. K @BPSSCRG,VALMHDR
.. Q
. Q
;
INSX ;
Q
;
TPJILST(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; List of TPJI bills - all fills
I '$D(ZTQUEUED) W !,"Compiling the list of TPJI bills ... "
N DFN,TPJI,RF,BPG,BPSVRXIB,IBIFN,IB,VRXHDR,LN,TPJDISP,NUM,L,FNG,FDG
;
S DFN=+$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
K TPJI
K ^TMP($J,"BPSP")
D RX^PSO52API(DFN,"BPSP",RXIEN,,"2,R") ; DBIA# 4820
S RF=0 F S RF=$O(^TMP($J,"BPSP",DFN,RXIEN,"RF",RF)) Q:'RF D
. ; check all refills
. K BPG,BPSVRXIB
. S BPG=$$RXBILL^IBNCPUT3(RXIEN,RF,"","",.BPSVRXIB) ; DBIA #5355
. S IBIFN=0 F S IBIFN=$O(BPSVRXIB(IBIFN)) Q:'IBIFN D
.. S IB=$G(BPSVRXIB(IBIFN))
.. I $P(IB,U,8)=7 Q ; cancelled bill in IB
.. I $P(IB,U,2)="CB"!($P(IB,U,2)="CN") Q ; cancelled bill in AR
.. S TPJI(+$P(IB,U,7),+$P(IB,U,3),IBIFN)=IB ; save it: fill#, date of svc, ibifn
.. Q
. Q
K ^TMP($J,"BPSP")
;
; add any bills from original fill
K BPG,BPSVRXIB
S BPG=$$RXBILL^IBNCPUT3(RXIEN,0,"","",.BPSVRXIB) ; DBIA #5355
S IBIFN=0 F S IBIFN=$O(BPSVRXIB(IBIFN)) Q:'IBIFN D
. S IB=$G(BPSVRXIB(IBIFN))
. I $P(IB,U,8)=7 Q ; cancelled bill in IB
. I $P(IB,U,2)="CB"!($P(IB,U,2)="CN") Q ; cancelled bill in AR
. S TPJI(+$P(IB,U,7),+$P(IB,U,3),IBIFN)=IB ; save it: fill#, date of svc, ibifn
. Q
;
S VRXHDR="Non-Cancelled Bills for this Rx (all fills)"
I '$D(TPJI) D UPDATE^BPSVRX("","","",VRXHDR,BPSSNUM) G TPJILSTX ; no data found
;
; display array
S LN=0 K TPJDISP
S LN=LN+1,TPJDISP(LN,0)=" "
S LN=LN+1,TPJDISP(LN,0)=" BILL RX DATE INSURANCE COB PATIENT"
S LN=LN+1,TPJDISP(LN,0)=" -------------------------------------------------------------------------------"
S NUM=0
S FNG="" F S FNG=$O(TPJI(FNG)) Q:FNG="" S FDG="" F S FDG=$O(TPJI(FNG,FDG)) Q:FDG="" S IBIFN=0 F S IBIFN=$O(TPJI(FNG,FDG,IBIFN)) Q:'IBIFN D
. S NUM=NUM+1
. S IB=$G(TPJI(FNG,FDG,IBIFN))
. S L=$J(NUM,3)_" "_$$LJ^XLFSTR($P(IB,U,1),9)_$$LJ^XLFSTR($$RXAPI1^BPSUTIL1(RXIEN,.01)_"-"_+$P(IB,U,7),14)
. S L=L_$$LJ^XLFSTR($$FMTE^XLFDT($P(IB,U,3),"2DZ"),11)_$$LJ^XLFSTR($P(IB,U,4),"18T")_" "_$P(IB,U,5)_" "
. S L=L_$$LJ^XLFSTR($$RXAPI1^BPSUTIL1(RXIEN,2,"E"),"18T")
. S LN=LN+1,TPJDISP(LN,0)=L
. Q
S LN=LN+1,TPJDISP(LN,0)=" "
D UPDATE^BPSVRX("TPJDISP","","",VRXHDR,BPSSNUM)
;
TPJILSTX ;
Q
;
TPJICI(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; TPJI - Claim Information
I '$D(ZTQUEUED) W !,"Compiling data for TPJI Claim Information ... "
N IBIFN,VALMHDR,BPSIBG,VRXHDR,BPSSCRG,BPSGDAN
;
; If no claims found
I '$G(BPSVRXCLM) D UPDATE^BPSVRX("","","","TPJI - Claim Information",BPSSNUM) G TPJICIX
;
S BPSIBG=0
S IBIFN=0 F S IBIFN=$O(BPSVRXCLM(IBIFN)) Q:'IBIFN D
. S BPSIBG=BPSIBG+1
. S (BPSSCRG,BPSGDAN)=$NA(^TMP("BPSVRX-CI",$J))
. ;
. D
.. ; protect/clean up variables
.. N BPSIBG,BPSVRXCLM,BPSSNUM,BPSSCRG
.. N VALMEVL S VALMEVL=999
.. D IBDSP^IBJTU6(1,IBIFN,,,BPSGDAN,.VALMHDR) ; DBIA #5713
.. Q
. ;
. S VRXHDR="TPJI - Claim Information"
. I BPSVRXCLM>1 S VRXHDR=VRXHDR_" ("_BPSIBG_" of "_BPSVRXCLM_")"
. ;
. D UPDATE^BPSVRX(BPSSCRG,.VALMHDR,"",VRXHDR,BPSSNUM)
. K @BPSSCRG,VALMHDR
. Q
;
TPJICIX ;
Q
;
TPJIARP(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; TPJI - AR Account Profile
I '$D(ZTQUEUED) W !,"Compiling data for TPJI AR Account Profile ... "
N IBIFN,VALMHDR,BPSIBG,VRXHDR,BPSSCRG,BPSGDAN
;
; If no claims found
I '$G(BPSVRXCLM) D UPDATE^BPSVRX("","","","TPJI - AR Account Profile",BPSSNUM) G TPJIARPX
;
S BPSIBG=0
S IBIFN=0 F S IBIFN=$O(BPSVRXCLM(IBIFN)) Q:'IBIFN D
. S BPSIBG=BPSIBG+1
. S (BPSSCRG,BPSGDAN)=$NA(^TMP("BPSVRX-AR ACCT PRO",$J))
. ;
. D
.. ; protect/clean up variables
.. N BPSIBG,BPSVRXCLM,BPSSNUM,BPSSCRG
.. N VALMEVL S VALMEVL=999
.. D IBDSP^IBJTU6(2,IBIFN,,,BPSGDAN,.VALMHDR) ; DBIA #5713
.. Q
. ;
. S VRXHDR="TPJI - AR Account Profile"
. I BPSVRXCLM>1 S VRXHDR=VRXHDR_" ("_BPSIBG_" of "_BPSVRXCLM_")"
. ;
. D UPDATE^BPSVRX(BPSSCRG,.VALMHDR,"",VRXHDR,BPSSNUM)
. K @BPSSCRG,VALMHDR
. Q
;
TPJIARPX ;
Q
;
TPJIARCH(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; TPJI - AR Comment History
I '$D(ZTQUEUED) W !,"Compiling data for TPJI AR Comment History ... "
N IBIFN,VALMHDR,BPSIBG,VRXHDR,BPSSCRG,BPSGDAN
;
; If no claims found
I '$G(BPSVRXCLM) D UPDATE^BPSVRX("","","","TPJI - AR Comment History",BPSSNUM) G TPJIARCX
;
S BPSIBG=0
S IBIFN=0 F S IBIFN=$O(BPSVRXCLM(IBIFN)) Q:'IBIFN D
. S BPSIBG=BPSIBG+1
. S (BPSSCRG,BPSGDAN)=$NA(^TMP("BPSVRX-AR COMM",$J))
. ;
. D
.. ; protect/clean up variables
.. N BPSIBG,BPSVRXCLM,BPSSNUM,BPSSCRG
.. N VALMEVL S VALMEVL=999
.. D IBDSP^IBJTU6(3,IBIFN,,,BPSGDAN,.VALMHDR) ; DBIA #5713
.. Q
. ;
. S VRXHDR="TPJI - AR Comment History"
. I BPSVRXCLM>1 S VRXHDR=VRXHDR_" ("_BPSIBG_" of "_BPSVRXCLM_")"
. ;
. D UPDATE^BPSVRX(BPSSCRG,.VALMHDR,"",VRXHDR,BPSSNUM)
. K @BPSSCRG,VALMHDR
. Q
;
TPJIARCX ;
Q
;
TPJIECME(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; TPJI - ECME Rx Response Information
I '$D(ZTQUEUED) W !,"Compiling data for TPJI ECME Rx Response ... "
N IBIFN,VALMHDR,BPSIBG,VRXHDR,BPSSCRG,BPSGDAN
;
; If no claims found
I '$G(BPSVRXCLM) D UPDATE^BPSVRX("","","","TPJI - ECME Rx Response Information",BPSSNUM) G TPJIECMX
;
S BPSIBG=0
S IBIFN=0 F S IBIFN=$O(BPSVRXCLM(IBIFN)) Q:'IBIFN D
. S BPSIBG=BPSIBG+1
. S (BPSSCRG,BPSGDAN)=$NA(^TMP("BPSVRX-ECME RX",$J))
. ;
. D
.. ; protect/clean up variables
.. N BPSIBG,BPSVRXCLM,BPSSNUM,BPSSCRG
.. N VALMEVL S VALMEVL=999
.. D IBDSP^IBJTU6(4,IBIFN,,,BPSGDAN,.VALMHDR) ; DBIA #5713
.. Q
. ;
. S VRXHDR="TPJI - ECME Rx Response Information"
. I BPSVRXCLM>1 S VRXHDR=VRXHDR_" ("_BPSIBG_" of "_BPSVRXCLM_")"
. ;
. D UPDATE^BPSVRX(BPSSCRG,.VALMHDR,"",VRXHDR,BPSSNUM)
. K @BPSSCRG,VALMHDR
. Q
;
TPJIECMX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSVRX1 14535 printed Sep 23, 2025@19:29:52 Page 2
BPSVRX1 ;ALB/ESG - View ECME Prescription continued ;5/23/2011
+1 ;;1.0;E CLAIMS MGMT ENGINE;**11,15**;JUN 2004;Build 13
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Reference to ^IBCNR(366.14, supported by DBIA #5711
+5 ; Reference to PRINT^IBNCPEV supported by DBIA #5712
+6 ; Reference to IBDSP^IBJTU6 supported by DBIA #5713
+7 ; Reference to RXINS^IBNCPDPU supported by DBIA #5714
+8 ; Reference to $$RXBILL^IBNCPUT3 supported by DBIA #5355
+9 ; Reference to RX^PSO52API supported by DBIA #4820
+10 ; Reference to DP^PSORXVW supported by DBIA #4711
+11 ;
+12 QUIT
+13 ;
VIEWRX(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; View Prescriptions [PSO VIEW]
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for View Prescriptions ... "
+2 NEW DA,PSOVDA,PS,VALMHDR,VALM
+3 NEW %,%H,%I,DAT,DFN,DIC,DIR,DIRUT,DUOUT,DTOUT,DN,DTT,EXDT,FFX,GMRA,GMRAL,HDR
+4 NEW I,II,IFN,J,L1,LBL,LENGTH,MED,M1,N,OUT,P0,P1,PHYS,PL,POERR,PSDIV,PSEXDT
+5 NEW PSOAL,PSOBCK,PSODFN,PSOHD,PSOELSE,PSONOAL,PTST,R3,REA,REFL,RF,RFDATE,RFL
+6 NEW RFL1,RFLL,RFT,RLD,RN,RTN,RX0,RX2,RX3,RXN,RXOR,SG,SIG,SIGOK,ST,STA,VA,VACNTRY
+7 NEW VADM,VAERR,VAPA,X,Y,Z,Z0,Z1,ZD
+8 ;
+9 SET (DA,PSOVDA)=RXIEN
SET PS="VIEW"
+10 KILL ^TMP("PSOHDR",$JOB),^TMP("PSOAL",$JOB)
+11 Begin DoDot:1
+12 NEW BPSSNUM,VALMEVL
SET VALMEVL=999
+13 ; DBIA #4711
DO DP^PSORXVW
+14 QUIT
End DoDot:1
+15 DO UPDATE^BPSVRX($NAME(^TMP("PSOAL",$JOB)),.VALMHDR,$GET(VALM("TITLE")),"View Prescription Data",BPSSNUM)
+16 KILL ^TMP("PSOHDR",$JOB),^TMP("PSOAL",$JOB)
+17 ;
VIEWX ;
+1 QUIT
+2 ;
LOG(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; ECME Print Claim Log
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for the ECME Claim Log ... "
+2 NEW BPSVRXCOB,BPSINSCT
+3 ;
+4 ; initially count up how many insurances we're dealing with
+5 SET BPSINSCT=0
+6 FOR BPSVRXCOB=1:1:3
Begin DoDot:1
+7 NEW IEN59
+8 SET IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,BPSVRXCOB)
if '$DATA(^BPST(IEN59,0))
QUIT
+9 SET BPSINSCT=BPSINSCT+1
+10 QUIT
End DoDot:1
+11 ;
+12 ; no data found
IF 'BPSINSCT
DO UPDATE^BPSVRX("","","","ECME Claim Log Data",BPSSNUM)
GOTO LOGX
+13 ;
+14 FOR BPSVRXCOB=1:1:3
Begin DoDot:1
+15 NEW IEN59,DFN,INS,VRXHDR,LINE,VALMHDR,VALMAR,INSSEQ
+16 SET IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,BPSVRXCOB)
if '$DATA(^BPST(IEN59,0))
QUIT
+17 SET DFN=+$PIECE($GET(^BPST(IEN59,0)),U,6)
if 'DFN
QUIT
+18 ; ins co ien
SET INS=+$PIECE($GET(^BPST(IEN59,10,+$GET(^BPST(IEN59,9)),3)),U,5)
+19 ; ins co ien alternative
IF 'INS
SET INS=+$$INSNAM^BPSRPT6(IEN59)
+20 if 'INS
QUIT
+21 SET INSSEQ=$SELECT(BPSVRXCOB=1:"Primary",BPSVRXCOB=2:"Secondary",1:"Tertiary")
+22 SET VRXHDR="ECME Claim Log Data"
+23 ; only if multiple payers
IF BPSINSCT>1
SET VRXHDR=VRXHDR_" - "_INSSEQ_" Insurance"
+24 SET VALMAR=$NAME(^TMP("BPSLOG",$JOB,"VALM"))
+25 KILL @VALMAR
+26 SET LINE=1
+27 Begin DoDot:2
+28 ; protect variables
NEW BPLNCNT,BPSVRXCOB,BPADDMSG,RXIEN,FILL,BPSSNUM,VRXHDR,BPL,D0,VA,VAERR,X,Y
+29 NEW VALMEVL
SET VALMEVL=999
+30 ; build ECME claim log listman array
SET BPLNCNT=$$PREPINFO^BPSSCRLG(.LINE,DFN,INS,IEN59)
+31 QUIT
End DoDot:2
+32 ; listman header array for this list
DO HDR^BPSSCRLG
+33 DO UPDATE^BPSVRX(VALMAR,.VALMHDR,"",VRXHDR,BPSSNUM)
+34 KILL @VALMAR
+35 QUIT
End DoDot:1
+36 ;
LOGX ;
+1 QUIT
+2 ;
BILL(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; IB ECME Billing Events Report (DBIA# 5711 for global reference to file 366.14)
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for the ECME Billing Events Report ... "
+2 ;
+3 NEW REF,IBDTIEN,IBEVNT,VRXHDR,IB1ST,IBFN,IBI,IBN,IBNUM,IBRX1,SCR,D0,PSSDIY,X,Y
+4 NEW IBSCR,IBQ,IBPAGE,IBBDT,IBEDT,IBDTL,IBDIVS,IBM1,IBM2,IBM3,IBRX,IBSC,IBNB
+5 SET REF=$NAME(^TMP($JOB,"IBNCPDPE"))
+6 ; init scratch global for compiling
KILL @REF
+7 SET VRXHDR="ECME Billing Events Report Data"
+8 ;
+9 SET IBDTIEN=0
FOR
SET IBDTIEN=$ORDER(^IBCNR(366.14,"I",RXIEN,IBDTIEN))
if 'IBDTIEN
QUIT
Begin DoDot:1
+10 SET IBEVNT=0
FOR
SET IBEVNT=$ORDER(^IBCNR(366.14,"I",RXIEN,IBDTIEN,IBEVNT))
if 'IBEVNT
QUIT
Begin DoDot:2
+11 ; fill# check
IF FILL'=$PIECE($GET(^IBCNR(366.14,IBDTIEN,1,IBEVNT,2)),U,3)
QUIT
+12 ; save into scratch global
SET @REF@(RXIEN,FILL,IBDTIEN,IBEVNT)=""
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 ;
+16 IF '$DATA(@REF)
DO UPDATE^BPSVRX("","","",VRXHDR,BPSSNUM)
GOTO BILLX
+17 ;
+18 ; init variables necessary for printing the report
+19 SET (IBSCR,IBQ,IBPAGE)=0
+20 ; begin date
SET IBBDT=+$ORDER(^IBCNR(366.14,"B",0))
+21 ; end date
SET IBEDT=+$ORDER(^IBCNR(366.14,"B",""),-1)
+22 SET IBDTL=1
+23 SET IBDIVS=0
+24 SET IBDIVS(0)="0^ALL"
+25 SET IBM1="R"
+26 SET IBM2="B"
+27 SET IBM3="A"
+28 SET IBRX=RXIEN
+29 SET IBSC="STATUS CHECK"
+30 SET IBNB="Not ECME billable: "
+31 ;
+32 ; save report output DBIA #5712
DO HFS^BPSVRX("BER","PRINT^IBNCPEV",VRXHDR,"",BPSSNUM)
+33 ; clean-up scratch global
KILL ^TMP($JOB,"IBNCPDPE")
+34 ;
BILLX ;
+1 QUIT
+2 ;
CRI(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; ECME Claims-Response Inquiry [BPS RPT Claims Response]
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for the ECME Claims-Response Inquiry (CRI) Report ... "
+2 ;
+3 NEW LIST,LISTX,BPSVRXCOB,BPSVRXG,BPSVRXGT,BPSINSCT
+4 NEW A,BP03,D0,ERROR,I,S,X,Y,%
+5 ;
+6 ; initially count up how many insurances we're dealing with
+7 SET BPSINSCT=0
+8 FOR BPSVRXCOB=1:1:3
Begin DoDot:1
+9 NEW IEN59
+10 SET IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,BPSVRXCOB)
if '$DATA(^BPST(IEN59,0))
QUIT
+11 SET BPSINSCT=BPSINSCT+1
+12 QUIT
End DoDot:1
+13 ;
+14 KILL LIST,LISTX
SET LIST=0
+15 FOR BPSVRXCOB=1:1:3
Begin DoDot:1
+16 NEW IEN59
+17 SET IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,BPSVRXCOB)
if '$DATA(^BPST(IEN59,0))
QUIT
+18 ;
+19 ; if VIEWTYPE=ALL then look at all transactions in file 9002313.57
+20 IF VIEWTYPE="A"
Begin DoDot:2
+21 NEW IEN57,BP02
+22 SET IEN57=0
FOR
SET IEN57=$ORDER(^BPSTL("B",IEN59,IEN57))
if 'IEN57
QUIT
Begin DoDot:3
+23 ; claim
SET BP02=+$PIECE($GET(^BPSTL(IEN57,0)),U,4)
+24 IF BP02
IF '$DATA(LISTX(BP02))
SET LIST=$GET(LIST)+1
SET LIST(LIST)=BP02_U_0_U_BPSVRXCOB
SET LISTX(BP02)=""
+25 ;
+26 ; reversal claim
SET BP02=+$PIECE($GET(^BPSTL(IEN57,4)),U,1)
+27 IF BP02
IF '$DATA(LISTX(BP02))
SET LIST=$GET(LIST)+1
SET LIST(LIST)=BP02_U_1_U_BPSVRXCOB
SET LISTX(BP02)=""
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 ;
+31 ; otherwise just look at the most recent transactions in file 9002313.59
+32 IF VIEWTYPE'="A"
Begin DoDot:2
+33 NEW BP02
+34 ; claim
SET BP02=+$PIECE($GET(^BPST(IEN59,0)),U,4)
+35 IF BP02
IF '$DATA(LISTX(BP02))
SET LIST=$GET(LIST)+1
SET LIST(LIST)=BP02_U_0_U_BPSVRXCOB
SET LISTX(BP02)=""
+36 ;
+37 ; reversal claim
SET BP02=+$PIECE($GET(^BPST(IEN59,4)),U,1)
+38 IF BP02
IF '$DATA(LISTX(BP02))
SET LIST=$GET(LIST)+1
SET LIST(LIST)=BP02_U_1_U_BPSVRXCOB
SET LISTX(BP02)=""
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 ;
+42 ; now go through the list in reverse order and generate and save the CRI reports
+43 ; total number of CRI reports
SET BPSVRXGT=LIST
+44 ;
+45 ; no data found
IF 'BPSVRXGT
DO UPDATE^BPSVRX("","","","ECME Claims-Response Inquiry Report Data",BPSSNUM)
+46 ;
+47 SET BPSVRXG=99999
FOR
SET BPSVRXG=$ORDER(LIST(BPSVRXG),-1)
if 'BPSVRXG
QUIT
Begin DoDot:1
+48 NEW BPX,BP02,BPREV,COB,BPVAX,BPSCR,BPCFILE,VRXHDR,CRIHDR,HC
+49 SET BPX=LIST(BPSVRXG)
+50 SET BP02=$PIECE(BPX,U,1)
+51 SET BPREV=$PIECE(BPX,U,2)
+52 SET COB=$PIECE(BPX,U,3)
+53 SET BPVAX=$PIECE($GET(^BPSC(BP02,0)),U,1)
+54 SET BPSCR=0
SET BPCFILE=9002313.02
+55 SET VRXHDR="ECME Claims-Response Inquiry Report Data ("_(BPSVRXGT-BPSVRXG+1)_" of "_BPSVRXGT_")"
+56 SET HC=0
+57 IF BPSINSCT>1
SET HC=HC+1
SET CRIHDR(HC)="Payer Sequence: "_$SELECT(COB=1:"Primary",COB=2:"Secondary",1:"Tertiary")
+58 IF BPREV
SET HC=HC+1
SET CRIHDR(HC)="This is the Reversal Claim"
+59 Begin DoDot:2
+60 ; protect variables
NEW BPSVRXG,LIST,LISTX,BPSVRXGT,BPSINSCT
+61 DO HFS^BPSVRX("CRI","RUNRPT^BPSRCRI",VRXHDR,.CRIHDR,BPSSNUM)
+62 QUIT
End DoDot:2
+63 QUIT
End DoDot:1
CRIX ;
+1 QUIT
+2 ;
INS(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; View Pharmacy Insurance policies
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for View Insurance Policies ... "
+2 NEW BPSDOS,DFN,BPSPINS,BPSINSCT,VRXHDR,BPINSCG,BPVXCOB,BPVXIEN,VALMHDR,BPSSCRG,BPSCDFN,BPSGDAN
+3 ;
+4 ; date of service
SET BPSDOS=$$DOSDATE^BPSSCRRS(RXIEN,FILL)
+5 ; patient ien
SET DFN=+$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
+6 ;
+7 ; DBIA #5714
DO RXINS^IBNCPDPU(DFN,BPSDOS,.BPSPINS)
+8 ; ins count of Rx policies
SET BPSINSCT=+$GET(BPSPINS)
+9 ;
+10 SET VRXHDR="Prescription Insurance Policy Data"
+11 ; get out of here if no data found
IF 'BPSINSCT
DO UPDATE^BPSVRX("","","",VRXHDR,BPSSNUM)
GOTO INSX
+12 ;
+13 ; loop through Rx policies found and display policy data
+14 SET BPINSCG=0
+15 SET BPVXCOB=""
FOR
SET BPVXCOB=$ORDER(BPSPINS("S",BPVXCOB))
if BPVXCOB=""
QUIT
Begin DoDot:1
+16 SET BPVXIEN=0
FOR
SET BPVXIEN=$ORDER(BPSPINS("S",BPVXCOB,BPVXIEN))
if 'BPVXIEN
QUIT
Begin DoDot:2
+17 SET BPINSCG=BPINSCG+1
+18 ; scratch global array name
SET BPSSCRG=$NAME(^TMP("BPSVRX-INS",$JOB))
+19 ; need to protect BPVXIEN below (2.312 subfile ien)
SET BPSCDFN=BPVXIEN
+20 ; need to protect BPSSCRG below (scratch global array name)
SET BPSGDAN=BPSSCRG
+21 ;
+22 Begin DoDot:3
+23 ; protect/clean up variables
+24 NEW BPINSCG,BPVXCOB,BPSINSCT,BPSSNUM,BPSPINS,BPVXIEN,BPSSCRG
+25 NEW VALMEVL
SET VALMEVL=999
+26 ; DBIA #5713
DO IBDSP^IBJTU6(5,"",DFN,BPSCDFN,BPSGDAN,.VALMHDR)
+27 QUIT
End DoDot:3
+28 ;
+29 SET VRXHDR="Prescription Insurance Policy Data"
+30 ;
+31 ; add the payer sequence indicator to the header if more than 1 ins policy is being displayed
+32 IF BPSINSCT>1
Begin DoDot:3
+33 SET VALMHDR($ORDER(VALMHDR(""),-1)+1)="Payer Sequence: "_$SELECT(BPVXCOB=1:"Primary",BPVXCOB=2:"Secondary",1:"Tertiary")
+34 SET VRXHDR=VRXHDR_" ("_BPINSCG_" of "_BPSINSCT_")"
+35 QUIT
End DoDot:3
+36 ;
+37 DO UPDATE^BPSVRX(BPSSCRG,.VALMHDR,"",VRXHDR,BPSSNUM)
+38 KILL @BPSSCRG,VALMHDR
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 ;
INSX ;
+1 QUIT
+2 ;
TPJILST(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; List of TPJI bills - all fills
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling the list of TPJI bills ... "
+2 NEW DFN,TPJI,RF,BPG,BPSVRXIB,IBIFN,IB,VRXHDR,LN,TPJDISP,NUM,L,FNG,FDG
+3 ;
+4 SET DFN=+$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
+5 KILL TPJI
+6 KILL ^TMP($JOB,"BPSP")
+7 ; DBIA# 4820
DO RX^PSO52API(DFN,"BPSP",RXIEN,,"2,R")
+8 SET RF=0
FOR
SET RF=$ORDER(^TMP($JOB,"BPSP",DFN,RXIEN,"RF",RF))
if 'RF
QUIT
Begin DoDot:1
+9 ; check all refills
+10 KILL BPG,BPSVRXIB
+11 ; DBIA #5355
SET BPG=$$RXBILL^IBNCPUT3(RXIEN,RF,"","",.BPSVRXIB)
+12 SET IBIFN=0
FOR
SET IBIFN=$ORDER(BPSVRXIB(IBIFN))
if 'IBIFN
QUIT
Begin DoDot:2
+13 SET IB=$GET(BPSVRXIB(IBIFN))
+14 ; cancelled bill in IB
IF $PIECE(IB,U,8)=7
QUIT
+15 ; cancelled bill in AR
IF $PIECE(IB,U,2)="CB"!($PIECE(IB,U,2)="CN")
QUIT
+16 ; save it: fill#, date of svc, ibifn
SET TPJI(+$PIECE(IB,U,7),+$PIECE(IB,U,3),IBIFN)=IB
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 KILL ^TMP($JOB,"BPSP")
+20 ;
+21 ; add any bills from original fill
+22 KILL BPG,BPSVRXIB
+23 ; DBIA #5355
SET BPG=$$RXBILL^IBNCPUT3(RXIEN,0,"","",.BPSVRXIB)
+24 SET IBIFN=0
FOR
SET IBIFN=$ORDER(BPSVRXIB(IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+25 SET IB=$GET(BPSVRXIB(IBIFN))
+26 ; cancelled bill in IB
IF $PIECE(IB,U,8)=7
QUIT
+27 ; cancelled bill in AR
IF $PIECE(IB,U,2)="CB"!($PIECE(IB,U,2)="CN")
QUIT
+28 ; save it: fill#, date of svc, ibifn
SET TPJI(+$PIECE(IB,U,7),+$PIECE(IB,U,3),IBIFN)=IB
+29 QUIT
End DoDot:1
+30 ;
+31 SET VRXHDR="Non-Cancelled Bills for this Rx (all fills)"
+32 ; no data found
IF '$DATA(TPJI)
DO UPDATE^BPSVRX("","","",VRXHDR,BPSSNUM)
GOTO TPJILSTX
+33 ;
+34 ; display array
+35 SET LN=0
KILL TPJDISP
+36 SET LN=LN+1
SET TPJDISP(LN,0)=" "
+37 SET LN=LN+1
SET TPJDISP(LN,0)=" BILL RX DATE INSURANCE COB PATIENT"
+38 SET LN=LN+1
SET TPJDISP(LN,0)=" -------------------------------------------------------------------------------"
+39 SET NUM=0
+40 SET FNG=""
FOR
SET FNG=$ORDER(TPJI(FNG))
if FNG=""
QUIT
SET FDG=""
FOR
SET FDG=$ORDER(TPJI(FNG,FDG))
if FDG=""
QUIT
SET IBIFN=0
FOR
SET IBIFN=$ORDER(TPJI(FNG,FDG,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+41 SET NUM=NUM+1
+42 SET IB=$GET(TPJI(FNG,FDG,IBIFN))
+43 SET L=$JUSTIFY(NUM,3)_" "_$$LJ^XLFSTR($PIECE(IB,U,1),9)_$$LJ^XLFSTR($$RXAPI1^BPSUTIL1(RXIEN,.01)_"-"_+$PIECE(IB,U,7),14)
+44 SET L=L_$$LJ^XLFSTR($$FMTE^XLFDT($PIECE(IB,U,3),"2DZ"),11)_$$LJ^XLFSTR($PIECE(IB,U,4),"18T")_" "_$PIECE(IB,U,5)_" "
+45 SET L=L_$$LJ^XLFSTR($$RXAPI1^BPSUTIL1(RXIEN,2,"E"),"18T")
+46 SET LN=LN+1
SET TPJDISP(LN,0)=L
+47 QUIT
End DoDot:1
+48 SET LN=LN+1
SET TPJDISP(LN,0)=" "
+49 DO UPDATE^BPSVRX("TPJDISP","","",VRXHDR,BPSSNUM)
+50 ;
TPJILSTX ;
+1 QUIT
+2 ;
TPJICI(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; TPJI - Claim Information
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for TPJI Claim Information ... "
+2 NEW IBIFN,VALMHDR,BPSIBG,VRXHDR,BPSSCRG,BPSGDAN
+3 ;
+4 ; If no claims found
+5 IF '$GET(BPSVRXCLM)
DO UPDATE^BPSVRX("","","","TPJI - Claim Information",BPSSNUM)
GOTO TPJICIX
+6 ;
+7 SET BPSIBG=0
+8 SET IBIFN=0
FOR
SET IBIFN=$ORDER(BPSVRXCLM(IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+9 SET BPSIBG=BPSIBG+1
+10 SET (BPSSCRG,BPSGDAN)=$NAME(^TMP("BPSVRX-CI",$JOB))
+11 ;
+12 Begin DoDot:2
+13 ; protect/clean up variables
+14 NEW BPSIBG,BPSVRXCLM,BPSSNUM,BPSSCRG
+15 NEW VALMEVL
SET VALMEVL=999
+16 ; DBIA #5713
DO IBDSP^IBJTU6(1,IBIFN,,,BPSGDAN,.VALMHDR)
+17 QUIT
End DoDot:2
+18 ;
+19 SET VRXHDR="TPJI - Claim Information"
+20 IF BPSVRXCLM>1
SET VRXHDR=VRXHDR_" ("_BPSIBG_" of "_BPSVRXCLM_")"
+21 ;
+22 DO UPDATE^BPSVRX(BPSSCRG,.VALMHDR,"",VRXHDR,BPSSNUM)
+23 KILL @BPSSCRG,VALMHDR
+24 QUIT
End DoDot:1
+25 ;
TPJICIX ;
+1 QUIT
+2 ;
TPJIARP(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; TPJI - AR Account Profile
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for TPJI AR Account Profile ... "
+2 NEW IBIFN,VALMHDR,BPSIBG,VRXHDR,BPSSCRG,BPSGDAN
+3 ;
+4 ; If no claims found
+5 IF '$GET(BPSVRXCLM)
DO UPDATE^BPSVRX("","","","TPJI - AR Account Profile",BPSSNUM)
GOTO TPJIARPX
+6 ;
+7 SET BPSIBG=0
+8 SET IBIFN=0
FOR
SET IBIFN=$ORDER(BPSVRXCLM(IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+9 SET BPSIBG=BPSIBG+1
+10 SET (BPSSCRG,BPSGDAN)=$NAME(^TMP("BPSVRX-AR ACCT PRO",$JOB))
+11 ;
+12 Begin DoDot:2
+13 ; protect/clean up variables
+14 NEW BPSIBG,BPSVRXCLM,BPSSNUM,BPSSCRG
+15 NEW VALMEVL
SET VALMEVL=999
+16 ; DBIA #5713
DO IBDSP^IBJTU6(2,IBIFN,,,BPSGDAN,.VALMHDR)
+17 QUIT
End DoDot:2
+18 ;
+19 SET VRXHDR="TPJI - AR Account Profile"
+20 IF BPSVRXCLM>1
SET VRXHDR=VRXHDR_" ("_BPSIBG_" of "_BPSVRXCLM_")"
+21 ;
+22 DO UPDATE^BPSVRX(BPSSCRG,.VALMHDR,"",VRXHDR,BPSSNUM)
+23 KILL @BPSSCRG,VALMHDR
+24 QUIT
End DoDot:1
+25 ;
TPJIARPX ;
+1 QUIT
+2 ;
TPJIARCH(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; TPJI - AR Comment History
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for TPJI AR Comment History ... "
+2 NEW IBIFN,VALMHDR,BPSIBG,VRXHDR,BPSSCRG,BPSGDAN
+3 ;
+4 ; If no claims found
+5 IF '$GET(BPSVRXCLM)
DO UPDATE^BPSVRX("","","","TPJI - AR Comment History",BPSSNUM)
GOTO TPJIARCX
+6 ;
+7 SET BPSIBG=0
+8 SET IBIFN=0
FOR
SET IBIFN=$ORDER(BPSVRXCLM(IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+9 SET BPSIBG=BPSIBG+1
+10 SET (BPSSCRG,BPSGDAN)=$NAME(^TMP("BPSVRX-AR COMM",$JOB))
+11 ;
+12 Begin DoDot:2
+13 ; protect/clean up variables
+14 NEW BPSIBG,BPSVRXCLM,BPSSNUM,BPSSCRG
+15 NEW VALMEVL
SET VALMEVL=999
+16 ; DBIA #5713
DO IBDSP^IBJTU6(3,IBIFN,,,BPSGDAN,.VALMHDR)
+17 QUIT
End DoDot:2
+18 ;
+19 SET VRXHDR="TPJI - AR Comment History"
+20 IF BPSVRXCLM>1
SET VRXHDR=VRXHDR_" ("_BPSIBG_" of "_BPSVRXCLM_")"
+21 ;
+22 DO UPDATE^BPSVRX(BPSSCRG,.VALMHDR,"",VRXHDR,BPSSNUM)
+23 KILL @BPSSCRG,VALMHDR
+24 QUIT
End DoDot:1
+25 ;
TPJIARCX ;
+1 QUIT
+2 ;
TPJIECME(RXIEN,FILL,VIEWTYPE,BPSSNUM) ; TPJI - ECME Rx Response Information
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Compiling data for TPJI ECME Rx Response ... "
+2 NEW IBIFN,VALMHDR,BPSIBG,VRXHDR,BPSSCRG,BPSGDAN
+3 ;
+4 ; If no claims found
+5 IF '$GET(BPSVRXCLM)
DO UPDATE^BPSVRX("","","","TPJI - ECME Rx Response Information",BPSSNUM)
GOTO TPJIECMX
+6 ;
+7 SET BPSIBG=0
+8 SET IBIFN=0
FOR
SET IBIFN=$ORDER(BPSVRXCLM(IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+9 SET BPSIBG=BPSIBG+1
+10 SET (BPSSCRG,BPSGDAN)=$NAME(^TMP("BPSVRX-ECME RX",$JOB))
+11 ;
+12 Begin DoDot:2
+13 ; protect/clean up variables
+14 NEW BPSIBG,BPSVRXCLM,BPSSNUM,BPSSCRG
+15 NEW VALMEVL
SET VALMEVL=999
+16 ; DBIA #5713
DO IBDSP^IBJTU6(4,IBIFN,,,BPSGDAN,.VALMHDR)
+17 QUIT
End DoDot:2
+18 ;
+19 SET VRXHDR="TPJI - ECME Rx Response Information"
+20 IF BPSVRXCLM>1
SET VRXHDR=VRXHDR_" ("_BPSIBG_" of "_BPSVRXCLM_")"
+21 ;
+22 DO UPDATE^BPSVRX(BPSSCRG,.VALMHDR,"",VRXHDR,BPSSNUM)
+23 KILL @BPSSCRG,VALMHDR
+24 QUIT
End DoDot:1
+25 ;
TPJIECMX ;
+1 QUIT
+2 ;
