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

BPSVRX.m

Go to the documentation of this file.
  1. BPSVRX ;ALB/ESG - View ECME Prescription ;5/23/2011
  1. ;;1.0;E CLAIMS MGMT ENGINE;**11,23,37**;JUN 2004;Build 16
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to $$RXBILL^IBNCPUT3 in ICR #5355
  1. ; Reference to RX^PSO52API in ICR #4820
  1. ; Reference to $$RXNUM^PSOBPSU2 in ICR #4970
  1. ; Reference to DIC^PSODI and DIQ^PSODI in ICR #4858
  1. ; Reference to $$CTRL^XMXUTIL1 in ICR #2735
  1. ; Reference to $$CJ^XLFSTR, $$LJ^XLFSTR, $$TRIM^XLFSTR, $$UP^XLFSTR in ICR #10104
  1. ;
  1. N VALMCNT,VALMQUIT,VALMBG,BPSVRXCLM,DFN,RXIEN,FILL,VIEWTYPE
  1. D EN^VALM("BPS VIEW ECME RX")
  1. K BPSVRX
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N DFN,V1,V2,V3,VA,VADM,VAERR
  1. S RXIEN=$G(RXIEN),FILL=$G(FILL)
  1. S V1=$$LJ^XLFSTR("Rx#: "_$$RXNUM^BPSSCRU2(RXIEN)_"/"_FILL,19)
  1. S V1=V1_$$LJ^XLFSTR("ECME#: "_$P($$CLAIM^BPSBUTL(RXIEN,FILL),U,6),21)
  1. S V1=V1_"Drug: "_$E($$RXAPI1^BPSUTIL1(RXIEN,6),1,34)
  1. S VALMHDR(1)=V1
  1. ;
  1. S DFN=+$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
  1. D DEM^VADPT
  1. S V2=$$LJ^XLFSTR("Patient: "_$E($G(VADM(1)),1,30)_" ("_$G(VA("BID"))_")",48)
  1. S $E(V2,57)=$$LJ^XLFSTR("DOB: "_$$FMTE^XLFDT($P($G(VADM(3)),U,1),"2Z")_" ("_$G(VADM(4))_")",22)
  1. S VALMHDR(2)=V2
  1. ;
  1. S V3=$$LJ^XLFSTR("Birth Sex: "_$P($G(VADM(5)),U,1),8)
  1. S $E(V3,32)="Self-Identified Gender: "_$E($P($G(VADM(14,5)),U,1),1,24)
  1. S VALMHDR(3)=V3
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- ListManager exit code
  1. K ^TMP("BPSVRX",$J)
  1. Q
  1. ;
  1. INIT(BPSVRX) ; ListManager entry point
  1. N BPSVRXQ,BPSFL
  1. ;
  1. ; Array entries may or may not be set-up by external calling applications.
  1. ;
  1. ; BPSVRX("RXIEN") - Rx ien
  1. ; BPSVRX("FILL#") - fill#
  1. ;
  1. ; All array entries are optional. If not defined, then the system will prompt the user. First thing to do
  1. ; is figure out what data is defined upon entry to this routine.
  1. ;
  1. ; check Rx
  1. S RXIEN=+$G(BPSVRX("RXIEN"))
  1. I 'RXIEN K BPSVRX G INIT1 ; no Rx
  1. I $$RXAPI1^BPSUTIL1(RXIEN,.01,"E")="" K BPSVRX G INIT1 ; invalid Rx
  1. S DFN=+$$RXAPI1^BPSUTIL1(RXIEN,2,"I")
  1. I 'DFN K BPSVRX,DFN G INIT1 ; invalid patient ien
  1. ;
  1. ; RXIEN is good, check fill#
  1. S FILL=$G(BPSVRX("FILL#"))
  1. I FILL="" G INIT2 ; rx is OK, fill# is not known
  1. I FILL=0 G INIT3 ; rx is OK, original fill OK
  1. I $$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILL,.01,"I") G INIT3 ; fill OK - fill date found in 52.1
  1. D RFL(RXIEN,.BPSFL) I $D(BPSFL(FILL)) G INIT3 ; fill OK - found in BPS Transaction
  1. ;
  1. ; fill# is not valid so prompt for it
  1. G INIT2
  1. ;
  1. ;-------------------------------------------------
  1. ;
  1. INIT1 ; internal branch point to perform all prompts (Rx, fill#, view type)
  1. S RXIEN=$$RXP()
  1. I $G(BPSVRXQ) S VALMQUIT=1 G INITX
  1. S DFN=+$P(RXIEN,U,2),RXIEN=+$P(RXIEN,U,1)
  1. I 'RXIEN!'DFN S VALMQUIT=1 G INITX
  1. ;
  1. INIT2 ; internal branch point for fill# prompt and view type prompt
  1. S FILL=$$FILLP(RXIEN,DFN)
  1. I $G(BPSVRXQ) S VALMQUIT=1 G INITX
  1. I FILL="" S VALMQUIT=1 G INITX
  1. ;
  1. INIT3 ; internal branch point for view type prompt
  1. S VIEWTYPE=$$VTP(RXIEN,FILL)
  1. I $G(BPSVRXQ) S VALMQUIT=1 G INITX
  1. I VIEWTYPE'="M",VIEWTYPE'="A" S VALMQUIT=1 G INITX
  1. ;
  1. ; Build list
  1. D BUILD(RXIEN,FILL,VIEWTYPE)
  1. ;
  1. INITX ; finished with the INIT code to initially build the list
  1. Q
  1. ;
  1. RXP() ; prompt the user to enter the prescription
  1. ; output value of function is RXIEN^DFN
  1. ; return BPSVRXQ=1 to exit option
  1. ;
  1. N RXIEN,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DR,DA,D0,DIQ,BPSRXD,PSODIY,RXN,DFN,PNM,DRUG,RXST
  1. RXPR ;
  1. S RXIEN="",DFN=""
  1. S DIR(0)="FAO"
  1. S DIR("A")="Select Prescription: "
  1. S DIR("?",1)=" A prescription number or ECME number may be entered. To look-up a"
  1. S DIR("?",2)=" prescription by the ECME number, please enter ""E."" followed by the ECME"
  1. S DIR("?")=" number with or without any leading zeros."
  1. W ! D ^DIR K DIR
  1. I X=""!$D(DIRUT) S BPSVRXQ=1 G RXPX
  1. S X=$$UP^XLFSTR(X)
  1. ;
  1. ; ECME# lookup
  1. I $E(X,1,2)="E." S RXIEN=+$$RXNUM^PSOBPSU2($E(X,3,$L(X))) G RXP1 ; DBIA #4970
  1. ;
  1. ; Rx# lookup
  1. S DIC=52
  1. S DIC(0)="E"
  1. S DIC("S")="I $P($G(^(0)),U,2),$D(^(""STA"")),$P($G(^(""STA"")),U,1)'=13"
  1. W ! D DIC^PSODI(52,.DIC,X) K DIC ; DBIA# 4858
  1. S RXIEN=+Y
  1. ;
  1. RXP1 ;
  1. ;
  1. I RXIEN'>0 W " Invalid selection. Please try again.",$C(7) G RXPR ; start over
  1. ;
  1. ; Display Rx data and get confirmation to proceed
  1. S DIC=52,DR=".01;2;6;100",DA=RXIEN,DIQ="BPSRXD",DIQ(0)="IE"
  1. D DIQ^PSODI(52,DIC,DR,DA,.DIQ) ; DBIA# 4858
  1. S RXN=$G(BPSRXD(52,DA,.01,"E"))
  1. S DFN=+$G(BPSRXD(52,DA,2,"I"))
  1. S PNM=$G(BPSRXD(52,DA,2,"E"))
  1. S DRUG=$G(BPSRXD(52,DA,6,"E"))
  1. S RXST=$G(BPSRXD(52,DA,100,"E"))
  1. W !!?1,"Patient",?25,"Rx#",?37,"Drug Name",?63,"Rx Status"
  1. W !?1,$E(PNM,1,23),?25,RXN,?37,$E(DRUG,1,25),?63,$E(RXST,1,16),!
  1. ;
  1. I $$YESNO^BPSSCRRS("OK to continue","Yes")<1 G RXPR ; start over
  1. ;
  1. RXPX ;
  1. Q RXIEN_U_DFN
  1. ;
  1. FILLP(RXIEN,DFN) ; prompt for a fill# given the RXIEN and DFN
  1. ; return BPSVRXQ=1 to exit option
  1. ;
  1. N FILL,BPFLZ,RF,FLDT,RELDT,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,CNT,BSTR,BPSFL
  1. S FILL=""
  1. I '$G(RXIEN)!'$G(DFN) G FILLX
  1. ;
  1. K ^TMP($J,"BPSP"),BPFLZ
  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. . S FLDT=+$G(^TMP($J,"BPSP",DFN,RXIEN,"RF",RF,.01))\1 ; fill date
  1. . S RELDT=+$G(^TMP($J,"BPSP",DFN,RXIEN,"RF",RF,17))\1 ; release date
  1. . S BPFLZ(RF)=FLDT_U_RELDT
  1. . Q
  1. ;
  1. ; add original fill date and original release date to local array
  1. S FLDT=+$G(^TMP($J,"BPSP",DFN,RXIEN,22))\1 ; original fill date
  1. S RELDT=+$G(^TMP($J,"BPSP",DFN,RXIEN,31))\1 ; original release date
  1. S BPFLZ(0)=FLDT_U_RELDT
  1. ;
  1. ; check for any deleted fills that have ECME activity
  1. D RFL(RXIEN,.BPSFL)
  1. S RF="" F S RF=$O(BPSFL(RF)) Q:RF="" I '$D(BPFLZ(RF)) S BPFLZ(RF)=0_U_0
  1. ;
  1. S DIR(0)="S"
  1. S DIR("L",1)="Rx# "_$G(^TMP($J,"BPSP",DFN,RXIEN,.01))_" has the following fills:"
  1. S DIR("L",2)=""
  1. S DIR("L",3)=" Fill# Fill Date Release Date"
  1. S DIR("L",4)=" ----- ---------- ------------"
  1. S CNT=0,BSTR=""
  1. S RF="" F S RF=$O(BPFLZ(RF)) Q:RF="" D
  1. . S CNT=CNT+1
  1. . S FLDT=$$FMTE^XLFDT($P(BPFLZ(RF),U,1),"5Z") I 'FLDT S FLDT=" - "
  1. . S RELDT=$$FMTE^XLFDT($P(BPFLZ(RF),U,2),"5Z") I 'RELDT S RELDT=" - "
  1. . I 'FLDT,'RELDT S (FLDT,RELDT)=" Deleted "
  1. . S $P(BSTR,";",CNT)=RF_":"_FLDT_" "_RELDT
  1. . S DIR("L",CNT+4)=$J(RF,7)_" "_FLDT_" "_RELDT
  1. . Q
  1. S DIR("L")=" "
  1. S $P(DIR(0),U,2)=BSTR
  1. S DIR("A")="Select Fill Number"
  1. I CNT=1 D
  1. . S DIR("B")=$O(BPFLZ("")) ; default if there is only 1 fill
  1. . S $P(DIR("L",1)," ",$L(DIR("L",1)," "))="fill:" ; singular
  1. . Q
  1. W ! D ^DIR K DIR
  1. I Y=""!$D(DIRUT) S BPSVRXQ=1 G FILLX
  1. S FILL=Y
  1. ;
  1. FILLX ;
  1. K ^TMP($J,"BPSP")
  1. Q FILL
  1. ;
  1. VTP(RXIEN,FILL) ; prompt for the view type of this report
  1. ; Most recent ECME transaction or All ECME transactions
  1. ; Output value of function is "M" or "A".
  1. ; return BPSVRXQ=1 to exit option
  1. ;
  1. N VIEWTYPE,TOT,COB,IEN59,BP57,T1,T2,T3,MTXT,ATXT,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. N BPSVRXIB,IBIFN,IBC,IBA,IB,BPSVRXCAN
  1. S VIEWTYPE=""
  1. I '$G(RXIEN) G VTPX
  1. I $G(FILL)="" G VTPX
  1. ;
  1. ; count up the number of ECME transactions on file (total and by COB)
  1. K TOT
  1. F COB=1:1:3 S IEN59=$$IEN59^BPSOSRX(RXIEN,FILL,COB) D
  1. . I IEN59="" Q
  1. . S BP57=0 F S BP57=$O(^BPSTL("B",IEN59,BP57)) Q:'BP57 S TOT=$G(TOT)+1,TOT(COB)=$G(TOT(COB))+1
  1. . Q
  1. S TOT=+$G(TOT),T1=+$G(TOT(1)),T2=+$G(TOT(2)),T3=+$G(TOT(3))
  1. ;
  1. ; if 0 ECME transactions found, then no need to ask this next question
  1. I TOT=0 S VIEWTYPE="M" G VTPCB
  1. ;
  1. S DIR(0)="S"
  1. I TOT=1 S DIR("A",1)=" There is 1 ECME transaction for this Rx/fill."
  1. E S DIR("A",1)=" There are "_TOT_" ECME transactions for this Rx/fill."
  1. S DIR("A",2)=" "
  1. I T2!T3 S DIR("A",2)=" "_T1_" for the primary payer"_$S(T2:", "_T2_" for the secondary payer",1:"")_$S(T3:", "_T3_" for the tertiary payer",1:"")_".",DIR("A",3)=" "
  1. S MTXT="Most recent transaction"_$S(T2!T3:" for each payer",1:"")
  1. S ATXT="All transactions"
  1. S DIR("A")="Select "_MTXT_" or "_ATXT
  1. S DIR("B")="M"
  1. S $P(DIR(0),U,2)="M:"_MTXT_";A:"_ATXT
  1. W ! D ^DIR K DIR
  1. I Y=""!$D(DIRUT) S BPSVRXQ=1 G VTPX
  1. S VIEWTYPE=Y
  1. ;
  1. VTPCB ;
  1. ; check for cancelled bills and ask how they should be handled
  1. K BPSVRXCLM
  1. I $$RXBILL^IBNCPUT3(RXIEN,FILL,"","",.BPSVRXIB) ; build a list of all bills for Rx/fill# (IA #5355)
  1. S (IBIFN,IBC,IBA)=0 F S IBIFN=$O(BPSVRXIB(IBIFN)) Q:'IBIFN D
  1. . S IB=$G(BPSVRXIB(IBIFN))
  1. . I $P(IB,U,8)=7!($P(IB,U,2)="CB")!($P(IB,U,2)="CN") S IBC=IBC+1,BPSVRXCLM(IBIFN)=0 Q ; cancelled bill
  1. . S IBA=IBA+1 ; non-cancelled bill
  1. . S BPSVRXCLM(IBIFN)=1
  1. . Q
  1. S BPSVRXCLM=IBA+IBC
  1. ;
  1. I IBC=0 G VTPX ; no cancelled bills found so no further questions
  1. ;
  1. I IBC,IBA S DIR("A",1)=" "_IBA_" non-cancelled bill"_$S(IBA=1:"",1:"s")_" and "_IBC_" cancelled bill"_$S(IBC=1:"",1:"s")_" exist for this Rx/fill."
  1. I IBC,'IBA S DIR("A",1)=" "_IBC_" cancelled bill"_$S(IBC=1:"",1:"s")_", but no active bills exist for this Rx/fill."
  1. I IBA S DIR("A",2)=" The non-cancelled bill"_$S(IBA=1:"",1:"s")_" will automatically be included.",DIR("A",3)=" "
  1. I 'IBA S DIR("A",2)=" "
  1. S DIR("A")="Do you want to include the cancelled bill"_$S(IBC=1:"",1:"s")
  1. S DIR("B")="No"
  1. S DIR(0)="Y"
  1. W ! D ^DIR K DIR
  1. I Y=""!$D(DIRUT) S BPSVRXQ=1 G VTPX
  1. S BPSVRXCAN=Y
  1. ;
  1. ; If the user wants cancelled bills, then no changes to the BPSVRXCLM list are needed so get out
  1. I BPSVRXCAN G VTPX
  1. ;
  1. ; If the user does not want cancelled bills, then remove them from the BPSVRXCLM list
  1. S IBIFN=0 F S IBIFN=$O(BPSVRXCLM(IBIFN)) Q:'IBIFN I 'BPSVRXCLM(IBIFN) K BPSVRXCLM(IBIFN)
  1. S BPSVRXCLM=IBA
  1. ;
  1. VTPX ;
  1. Q VIEWTYPE
  1. ;
  1. BUILD(RXIEN,FILL,VIEWTYPE) ; build list
  1. ; This is called in the INIT section to build the ListMan scratch global
  1. ; all parameters are required and must exist when this is called
  1. ;
  1. S BPSVRX=1 ; special variable indicating this is the driver routine
  1. I '$D(ZTQUEUED) W !
  1. K ^TMP("BPSVRX",$J) ; initialize display array
  1. ;
  1. D VIEWRX^BPSVRX1(RXIEN,FILL,VIEWTYPE,1) ; View Prescriptions [PSO VIEW]
  1. D LOG^BPSVRX1(RXIEN,FILL,VIEWTYPE,2) ; ECME Print Claim Log
  1. D BILL^BPSVRX1(RXIEN,FILL,VIEWTYPE,3) ; IB ECME Billing Events Report
  1. ; Comment out SD until US1401 is coded
  1. ; D SD^BPSVRX3(RXIEN,FILL,VIEWTYPE,4) ; SD Sensitive Drug
  1. D CRI^BPSVRX1(RXIEN,FILL,VIEWTYPE,5) ; ECME Claims-Response Inquiry Report
  1. D INS^BPSVRX1(RXIEN,FILL,VIEWTYPE,6) ; View Pharmacy Insurance policies
  1. D TPJILST^BPSVRX1(RXIEN,FILL,VIEWTYPE,7) ; List of TPJI-eligible bills
  1. D MP^BPSVRX3(RXIEN,FILL,VIEWTYPE,8) ; MP Medication Profile
  1. D TPJICI^BPSVRX1(RXIEN,FILL,VIEWTYPE,9) ; TPJI - Claim Information
  1. D TPJIARP^BPSVRX1(RXIEN,FILL,VIEWTYPE,10) ; TPJI - AR Account Profile
  1. D TPJIARCH^BPSVRX1(RXIEN,FILL,VIEWTYPE,11) ; TPJI - AR Comment History
  1. D TPJIECME^BPSVRX1(RXIEN,FILL,VIEWTYPE,12) ; TPJI - ECME Rx Response Info
  1. D DGELST^BPSVRX2(RXIEN,FILL,VIEWTYPE,13) ; View Registration Elig Status
  1. D DGELV^BPSVRX2(RXIEN,FILL,VIEWTYPE,14) ; View Registration Elig Verification
  1. ;
  1. BUILDX ;
  1. Q
  1. ;
  1. S VALMBG=$G(BPSVRX("LISTNAV",SNUM),1) ; default to 1 if not defined
  1. Q
  1. ;
  1. UPDATE(DISP,HDR,TITLE,NAME,SNUM) ; update the BPSVRX ListMan display array
  1. ; DISP - display array to be merged into ^TMP("BPSVRX",$J)
  1. ; Assmues display lines are found in @DISP@(N,0)
  1. ; HDR - header data array (i.e. VALMHDR data); HDR(1)=line 1; HDR(2)=line 2; etc.
  1. ; TITLE - title of section (i.e. VALM("TITLE")
  1. ; NAME - name/description of section being added (required)
  1. ; SNUM - section number used for ListMan navigational jumps (required)
  1. ;
  1. N LN,Z,NODATA,BPSVID
  1. ;
  1. S LN=+$O(^TMP("BPSVRX",$J,""),-1) ; last line# used in display array
  1. ;
  1. ; display name of section centered and reverse video
  1. I $G(NAME)'="" D
  1. . S LN=LN+1,^TMP("BPSVRX",$J,LN,0)=$$CJ^XLFSTR(NAME,80)
  1. . D CNTRL^VALM10(LN,1,80,IORVON,IORVOFF) ; reverse video line
  1. . I '$D(BPSVRX("LISTNAV",SNUM)) S BPSVRX("LISTNAV",SNUM)=LN ; store 1st line# of each section
  1. . Q
  1. ;
  1. ; merge in the ListMan title if one exists
  1. I $G(TITLE)'="" D
  1. . S LN=LN+1,^TMP("BPSVRX",$J,LN,0)=$$FLN(LN,TITLE)
  1. . D CNTRL^VALM10(LN,1,80,IOUON,IOUOFF) ; display a line under the title
  1. . Q
  1. ;
  1. ; merge in header data if this array exists
  1. I $O(HDR(0)) D
  1. . S Z=0 F S Z=$O(HDR(Z)) Q:'Z S LN=LN+1,^TMP("BPSVRX",$J,LN,0)=$$FLN(LN,$G(HDR(Z)))
  1. . D CNTRL^VALM10(LN,1,80,IOUON,IOUOFF) ; display a line under the header data
  1. . Q
  1. ;
  1. ; merge in display array
  1. S BPSVID="VALM VIDEO"
  1. I DISP="" S DISP="NODATA"
  1. S Z=0 F S Z=$O(@DISP@(Z)) Q:'Z S LN=LN+1,^TMP("BPSVRX",$J,LN,0)=$G(@DISP@(Z,0)) D
  1. . ; check for video attributes to be duplicated
  1. . I '$D(^TMP(BPSVID,$J,999,Z)) Q ; no video attributes on this line
  1. . M ^TMP(BPSVID,$J,VALMEVL,LN)=^TMP(BPSVID,$J,999,Z) ; copy video attributes
  1. . K ^TMP(BPSVID,$J,999,Z) ; clean-up
  1. . Q
  1. ;
  1. ; display a message if no data found for this section
  1. I '$O(@DISP@(0)) D
  1. . S LN=LN+1,^TMP("BPSVRX",$J,LN,0)=" "
  1. . S LN=LN+1,^TMP("BPSVRX",$J,LN,0)=" <No data found for this section>"
  1. . S LN=LN+1,^TMP("BPSVRX",$J,LN,0)=" "
  1. . Q
  1. ;
  1. ; update the number of lines in the list
  1. S VALMCNT=LN
  1. ;
  1. UPDX ;
  1. Q
  1. ;
  1. FLN(LINE,DATA) ; format line# LINE by reproducing any video attributes found in string DATA
  1. N VARON,VAROFF,FINDON,FINDOFF,COL,WIDTH
  1. ;
  1. F VARON="IOBON","IORVON","IOUON","IOINHI" D ; on attribute
  1. . S VAROFF=$S(VARON="IOBON":"IOBOFF",VARON="IORVON":"IORVOFF",VARON="IOUON":"IOUOFF",1:"IOINORM") ; off attribute
  1. . F S FINDON=$F(DATA,@VARON) Q:'FINDON D
  1. .. S COL=FINDON-$L(@VARON) ; starting column for video attribute
  1. .. S FINDOFF=$F(DATA,@VAROFF) ; see if off attribute is also found
  1. .. I FINDOFF S WIDTH=FINDOFF-COL-$L(@VARON)-$L(@VAROFF) ; width of affected text between on and off attributes
  1. .. I 'FINDOFF S WIDTH=$L(DATA)-COL-$L(@VARON) ; width of affected text (thru the end of the string)
  1. .. D CNTRL^VALM10(LINE,COL,WIDTH,@VARON,@VAROFF) ; save the video attribute using Listman API
  1. .. S DATA=$P(DATA,@VARON,1)_$P(DATA,@VARON,2,999) ; remove 1st on attribute
  1. .. I FINDOFF S DATA=$P(DATA,@VAROFF,1)_$P(DATA,@VAROFF,2,999) ; remove 1st off attribute
  1. .. Q
  1. . Q
  1. I DATA="" S DATA=" " ; blank lines need to be non-nil so video attributes may exist for them
  1. FLNX ;
  1. Q DATA
  1. ;
  1. HFS(SECTION,RTN,VRXHDR,HDRARY,BPSVRXKQ) ; output data to scratch host file and merge into ListMan display array
  1. ; SECTION - section code (e.g. "BER" - billing events report, "CRI" - claims-response inquiry)
  1. ; RTN - tag^routine to invoke to produce the report
  1. ; VRXHDR - name of section to appear at the start of the display
  1. ; HDRARY - header array
  1. ; BPSVRXKQ - section#
  1. ;
  1. N BPSHANDLE,BPSVDIR,BPSVFILE,HDR,POP,GLO,BPSARR,BVZ,BV1
  1. ;
  1. ; create a host file to write the data
  1. S SECTION="BPSVRX_"_$G(SECTION)
  1. S BPSHANDLE=SECTION_"_"_$J
  1. S BPSVDIR=$$DEFDIR^%ZISH()
  1. S BPSVFILE=BPSHANDLE_".RPT"
  1. I BPSVDIR="" D G HFSX
  1. . S HDR(1)="Error: Default directory is blank."
  1. . S HDR(2)="Please define one in the KERNEL SYSTEM PARAMETERS."
  1. . D UPDATE("",.HDR,"",VRXHDR,BPSVRXKQ)
  1. . Q
  1. ;
  1. D OPEN^%ZISH(BPSHANDLE,BPSVDIR,BPSVFILE,"W")
  1. I POP D G HFSX
  1. . S HDR(1)="Error: Unable to open scratch data file for writing."
  1. . S HDR(2)="Directory="_BPSVDIR
  1. . S HDR(3)="Filename="_BPSVFILE
  1. . D UPDATE("",.HDR,"",VRXHDR,BPSVRXKQ)
  1. . Q
  1. ;
  1. U IO ; use the file
  1. S IOM=80,IOSL=100000 ; 80 char width and long screen
  1. D @RTN ; create the report
  1. D CLOSE^%ZISH(BPSHANDLE) ; close the data file
  1. ;
  1. ; move contents of scratch data file to scratch global
  1. S GLO=$NA(^TMP($J,SECTION,1,0))
  1. K ^TMP($J,SECTION)
  1. I '$$FTG^%ZISH(BPSVDIR,BPSVFILE,GLO,3) D G HFSX
  1. . S HDR(1)="Error: Unable to read in the contents of the scratch data file."
  1. . S HDR(2)="Directory="_BPSVDIR
  1. . S HDR(3)="Filename="_BPSVFILE
  1. . S HDR(4)="Destination="_GLO
  1. . D UPDATE("",.HDR,"",VRXHDR,BPSVRXKQ)
  1. . Q
  1. ;
  1. ; delete the scratch data file
  1. S BPSARR(BPSVFILE)=""
  1. I $$DEL^%ZISH(BPSVDIR,$NA(BPSARR))
  1. ;
  1. ; remove "PAGE 1" line from the beginning of the display data
  1. F BVZ=1:1:10 I $$TRIM^XLFSTR($G(^TMP($J,SECTION,BVZ,0)))="PAGE 1" K ^TMP($J,SECTION,BVZ,0)
  1. ;
  1. ; remove all control characters and trailing spaces from all lines
  1. S BVZ=0 F S BVZ=$O(^TMP($J,SECTION,BVZ)) Q:'BVZ S BV1=$G(^TMP($J,SECTION,BVZ,0)),BV1=$$CTRL^XMXUTIL1(BV1),BV1=$$TRIM^XLFSTR(BV1,"R"),^TMP($J,SECTION,BVZ,0)=BV1 ; DBIAs #2735, #10104
  1. ;
  1. ; update BPSVRX display array
  1. S GLO=$NA(^TMP($J,SECTION))
  1. D UPDATE(GLO,.HDRARY,"",VRXHDR,BPSVRXKQ)
  1. K ^TMP($J,SECTION) ; clean up scratch global
  1. ;
  1. HFSX ;
  1. Q
  1. ;
  1. RFL(RXIEN,FILLIST) ; Return a list of all ECME fill#s for the Rx
  1. N BP59,FL
  1. K FILLIST
  1. S RXIEN=+$G(RXIEN) I 'RXIEN G RFLX
  1. S BP59=RXIEN F S BP59=$O(^BPST(BP59)) Q:$P(BP59,".",1)'=RXIEN S FL=$P($G(^BPST(BP59,1)),U,1) I FL'="" S FILLIST(FL)=BP59
  1. RFLX ;
  1. Q
  1. ;
  1. VER ; Selection from the ECME User Screen
  1. N BPSG,RXREF,BPSVRX
  1. D FULL^VALM1
  1. W !,"Enter the claim line number for the View ePharmacy Rx report."
  1. S BPSG=$$ASKLINE^BPSSCRU4("Select item","C","Please select SINGLE Rx Line.")
  1. I BPSG<1 G VERX
  1. S RXREF=$$RXREF^BPSSCRU2(+$P(BPSG,U,4))
  1. S BPSVRX("RXIEN")=$P(RXREF,U,1)
  1. S BPSVRX("FILL#")=$P(RXREF,U,2)
  1. D ^BPSVRX
  1. VERX ;
  1. S VALMBCK="R"
  1. Q
  1. ;