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

BPSVRX1.m

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