- 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 Feb 18, 2025@23:20:02 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 ;