PSOERRX1 ;BIRM/MFR - All Rxs eRx Queue - Supporting APIs ;08/28/22
;;7.0;OUTPATIENT PHARMACY;**700,769,770**;DEC 1997;Build 145
;
HDR ; - Builds the Header section
N LINE1,LINE2,LINE3,ARR
;
S LINE1="LOOK BACK DAYS: "_IOINHI_$S($G(REDTFLTR):"N/A",1:PSOLKBKD)_IOINORM
S $E(LINE1,40)="CS/NON-CS: "_IOINHI_$S(PSOCSERX="CS":"CS ONLY",PSOCSERX="Non-CS":"NON-CS ONLY",1:"BOTH")
S:PSOCSERX'="Non-CS" LINE1=LINE1_" ("_$S(PSOCSSCH=1:"II",PSOCSSCH=2:"III-V",1:"II-V")_")"
S LINE1=LINE1_IOINORM
D INSTR^VALM1("MAX. QUEUE SIZE: "_IOINHI_$J(PSOMAXQS,4)_IOINORM,60,2)
;
S LINE2="ERX STATUS: "_IOINHI
I PSOSTFLT="A" S LINE2=LINE2_"ALL"
I PSOSTFLT="N" S LINE2=LINE2_"NEW"
I PSOSTFLT="I" S LINE2=LINE2_"IN PROGRESS"
I PSOSTFLT="W" S LINE2=LINE2_"WAIT"
I PSOSTFLT="H" S LINE2=LINE2_$S(PSOHDSTS="ALL":"HOLD (ALL)",1:"HOLD ("_PSOHDSTS_")")
I PSOSTFLT="C" S LINE2=LINE2_$S(PSOCCRST="ALL":"CCR (ALL)",1:"CCR ("_PSOCCRST_")")
S LINE2=LINE2_IOINORM
S LINE3=""
I $D(PATFLTR)!$G(DOBFLTR)!$G(REDTFLTR)!$D(PRVFLTR)!$G(STSFLTR)!($G(DRGFLTR)'="")!$G(MATFLTR)!($G(MSTPFLTR)'="")!$G(VDRGFLTR) D
. N FILTER S FILTER=""
. I $G(REDTFLTR) S FILTER=FILTER_"|"_$$FMTE^XLFDT(+REDTFLTR,"2Z")_"-"_$$FMTE^XLFDT($P(REDTFLTR,"^",2),"2Z")
. I $G(MATFLTR) S FILTER=FILTER_"|MATCH("_$$MATCHLBL^PSOERPC2(MATFLTR)_")"
. I $G(DRGFLTR)'="" S FILTER=FILTER_"|ERX DRUG NAME('"_DRGFLTR_"')"
. I $G(DOBFLTR) S FILTER=FILTER_"|DOB("_$$FMTE^XLFDT(DOBFLTR,"2Z")_")"
. I $G(STSFLTR) S FILTER=FILTER_"|STATUS("_$S($G(STSFLTR1)'="":STSFLTR1,1:$$GET1^DIQ(52.45,STSFLTR,.01))_")"
. I $G(MSTPFLTR)'="" S FILTER=FILTER_"|TYPE("_$S($G(MSTPFLTR1)'="":MSTPFLTR1,1:$G(MTARR(MSTPFLTR)))_")"
. I $D(PRVFLTR) S FILTER=FILTER_"|PROVIDER("_$$EPRVFLST^PSOERUT(60)_")"
. I $D(PATFLTR) S FILTER=FILTER_"|PATIENT("_$$EPATFLST^PSOERUT(60)_")"
. I $G(VDRGFLTR) S FILTER=FILTER_"|VISTA DRUG("_$$GET1^DIQ(50,VDRGFLTR,.01)_")"
. S $E(FILTER,1)="" I $L(FILTER)>63 S FILTER=$E(FILTER,1,60)_"..."
. S LINE2="FILTERED BY: "_IOINHI_FILTER_IOINORM
K VALMHDR S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2 ;S:LINE3'="" VALMHDR(3)=LINE3 S VALMHDR(4)=IOINORM
D SETHDR()
Q
;
SETHDR() ; - Displays the Header Line
N HDR,SRTORD,SRTPOS
S HDR="#",$E(HDR,5)="PATIENT",$E(HDR,26)="DOB",$E(HDR,35)=$S($G(PSODETDP):"",1:"DRUG")
S $E(HDR,57)="PROVIDER",$E(HDR,69)="STA",$E(HDR,73)="REC.DATE"
D INSTR^VALM1(IORVON_HDR_IOINORM,1,4)
S SRTORD=$S(PSORDER="A":"^",1:"v")
S SRTPOS=$S(PSOSRTBY="PA":12,PSOSRTBY="DOB":29,PSOSRTBY="DR":39,PSOSRTBY="PR":65,PSOSRTBY="STA":72,1:80)
D INSTR^VALM1(IOINHI_IORVON_SRTORD_IOINORM,SRTPOS,4)
Q
;
SETSORT(FIELD) ; Sets the data sorted by the FIELD specified
;Input: FIELD - Sort By Field
N ERXCNT,PATNAME,DOB,MSGDT,ERXIEN,CSGROUP,ERXSTS,STS,STSIEN,EXSTSAR,MSGTYPE,PATMTCH,PROMTCH,DRUMTCH,Z,X
N ERXPAT,ERXPRV,INST,BEGDATE,ENDDATE,INST,STSLST,RELMSGID,RELMRD
K ^TMP("PSOERRXS",$J),^TMP("PSOERINC",$J)
;
S ERXCNT=0
S BEGDATE=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1,ENDDATE=DT+.99
; - Setting Begin/End Date if a Date Range is selected
I $G(REDTFLTR) D
. S BEGDATE=$P(REDTFLTR,"^",1)-.1,ENDDATE=$P(REDTFLTR,"^",2)+.99
;
; - Filter By eRx Patient is set
I $D(PATFLTR) D Q
. S ERXPAT="" F S ERXPAT=$O(PATFLTR(ERXPAT)) Q:'ERXPAT D I ERXCNT'<PSOMAXQS Q
. . I $G(DOBFLTR),'$D(^PS(52.46,"DOB",DOBFLTR,ERXPAT)) Q
. . S MSGDT=BEGDATE
. . F S MSGDT=$O(^PS(52.49,"PAT2",ERXPAT,MSGDT)) Q:'MSGDT!(MSGDT>ENDDATE) D I ERXCNT'<PSOMAXQS Q
. . . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"PAT2",ERXPAT,MSGDT,ERXIEN)) Q:'ERXIEN D I ERXCNT'<PSOMAXQS Q
. . . . D SETITEM(FIELD,ERXIEN,.ERXCNT)
. . . . D RELMSG(ERXIEN,.ERXCNT)
;
; - Filter By eRx Patient DOB is set
I $G(DOBFLTR)'="" D Q
. S ERXPAT=0 F S ERXPAT=$O(^PS(52.46,"DOB",DOBFLTR,ERXPAT)) Q:'ERXPAT D I ERXCNT'<PSOMAXQS Q
. . I $D(PATFLTR),'$D(PATFLTR(ERXPAT)) Q
. . S MSGDT=BEGDATE
. . F S MSGDT=$O(^PS(52.49,"PAT2",ERXPAT,MSGDT)) Q:'MSGDT!(MSGDT>ENDDATE) D I ERXCNT'<PSOMAXQS Q
. . . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"PAT2",ERXPAT,MSGDT,ERXIEN)) Q:'ERXIEN D I ERXCNT'<PSOMAXQS Q
. . . . D SETITEM(FIELD,ERXIEN,.ERXCNT)
. . . . D RELMSG(ERXIEN,.ERXCNT)
;
; - Filter By eRx Status is set
I $G(PSOSTFLT)'="A"!$G(STSFLTR) D Q
. I $G(STSFLTR) S STSLST(STSFLTR)=""
. E D LOADSTS^PSOERPC1(.STSLST)
. I '$G(MBMSITE) D
. . S ERXSTS=0 F S ERXSTS=$O(STSLST(ERXSTS)) Q:'ERXSTS D I ERXCNT'<PSOMAXQS Q
. . . S MSGDT=BEGDATE
. . . F S MSGDT=$O(^PS(52.49,"E",+$G(PSNPINST),ERXSTS,MSGDT)) Q:'MSGDT!(MSGDT>ENDDATE) D I ERXCNT'<PSOMAXQS Q
. . . . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"E",+$G(PSNPINST),ERXSTS,MSGDT,ERXIEN)) Q:'ERXIEN D I ERXCNT'<PSOMAXQS Q
. . . . . D SETITEM(FIELD,ERXIEN,.ERXCNT)
. . . . . D RELMSG(ERXIEN,.ERXCNT)
. E D
. . S MSGDT=BEGDATE
. . F S MSGDT=$O(^PS(52.49,"AMSGDTSTS",MSGDT)) Q:'MSGDT!(MSGDT>ENDDATE) D I ERXCNT'<PSOMAXQS Q
. . . S ERXSTS=0 F S ERXSTS=$O(STSLST(ERXSTS)) Q:'ERXSTS D I ERXCNT'<PSOMAXQS Q
. . . . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS,ERXIEN)) Q:'ERXIEN D I ERXCNT'<PSOMAXQS Q
. . . . . D SETITEM(FIELD,ERXIEN,.ERXCNT)
. . . . . D RELMSG(ERXIEN,.ERXCNT)
;
; - Filter By Message Type is set
I $G(MSTPFLTR)'="" D Q
. S INST=0 F S INST=$O(^PS(52.49,"MTYPE",INST)) Q:'INST D I ERXCNT'<PSOMAXQS Q
. . I '$G(MBMSITE),PSNPINST'=INST Q
. . S MSGDT=BEGDATE F S MSGDT=$O(^PS(52.49,"MTYPE",INST,MSGDT)) Q:'MSGDT!(MSGDT>ENDDATE) D I ERXCNT'<PSOMAXQS Q
. . . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"MTYPE",INST,MSGDT,MSTPFLTR,ERXIEN)) Q:'ERXIEN D I ERXCNT'<PSOMAXQS Q
. . . . D SETITEM(FIELD,ERXIEN,.ERXCNT)
. . . . D RELMSG(ERXIEN,.ERXCNT)
;
; - Filter By VistA Drug is set
I $G(VDRGFLTR) D Q
. S MSGDT=BEGDATE
. F S MSGDT=$O(^PS(52.49,"AVDRG",VDRGFLTR,MSGDT)) Q:'MSGDT!(MSGDT>ENDDATE) D I ERXCNT'<PSOMAXQS Q
. . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"AVDRG",VDRGFLTR,MSGDT,ERXIEN)) Q:'ERXIEN D
. . . D SETITEM(FIELD,ERXIEN,.ERXCNT)
. . . D RELMSG(ERXIEN,.ERXCNT)
;
; - No Filters (Catch All)
S MSGDT=BEGDATE
F S MSGDT=$O(^PS(52.49,"AMSGDTSTS",MSGDT)) Q:'MSGDT!(MSGDT>ENDDATE) D I ERXCNT'<PSOMAXQS Q
. S ERXSTS=0 F S ERXSTS=$O(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS)) Q:'ERXSTS D I ERXCNT'<PSOMAXQS Q
. . I '$G(PSOALLST)!(PSOSTFLT'="A"),'$$ELIGSTS^PSOERPC1("RX",$P($G(^PS(52.45,ERXSTS,0)),"^")) Q
. . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS,ERXIEN)) Q:'ERXIEN D I ERXCNT'<PSOMAXQS Q
. . . D SETITEM(FIELD,ERXIEN,.ERXCNT)
. . . D RELMSG(ERXIEN,.ERXCNT)
;
K ^TMP("PSOERINC",$J)
Q
;
RELMSG(ERXIEN,ERXCNT) ; Includes any related Message
;Input: ERXIEN - Pointer to the ERX HOLDING QUEUE (#52.49) file
; ERXCNT - eRx Counter - Number of Items on the List (Passed in by Reference)
N RELMSGID,RELMRD
S RELMSGID=0 F S RELMSGID=$O(^PS(52.49,ERXIEN,201,"B",RELMSGID)) Q:'RELMSGID D
. I $D(^TMP("PSOERINC",$J,RELMSGID)) Q
. S RELMRD=$P($G(^PS(52.49,RELMSGID,0)),"^",3) I RELMRD<BEGDATE!(RELMRD>ENDDATE) Q
. D SETITEM(FIELD,RELMSGID,.ERXCNT)
. S ^TMP("PSOERINC",$J,RELMSGID)=""
Q
;
SETITEM(FIELD,ERXIEN,COUNTER) ; Adds an eRx Record to the Sorted List
; Input: FIELD - Sort By field
; ERXIEN - eRx IEN - Pointer to #52.49
; COUNTER - eRx Counter - Number of Items on the List (Passed in by Reference)
N ERXSTAT,MTYPE,RESTYPE,PATIEN,REQIEN,PATNM,NEWRX,EDRUG,VDRGIEN,MSGDT,STATIEN,CHGMESRI
N EXDS,EXPRIEN,VPATIEN,EXPRNM,ERXDT,ERXEDT,DOB,CSPREFIX,CSERX,PROVIDER,EPATIEN,EPROVIEN
N ERXNODE0,ERXNODE1,ERXNODE2,ERXNODE3,EPTNODE0,EPTNODE1,EPTNODE2,SKIP,DRSNCODE,CHGMESRQ
; Related Institution Filter (Non-MbM sites only)
I '$G(MBMSITE),$G(PSNPINST)'=+$G(^PS(52.49,ERXIEN,24)) Q
S ERXNODE0=$G(^PS(52.49,ERXIEN,0)),ERXNODE1=$G(^PS(52.49,ERXIEN,1))
S ERXNODE2=$G(^PS(52.49,ERXIEN,2)),ERXNODE3=$G(^PS(52.49,ERXIEN,3))
S MSGDT=$P(ERXNODE0,"^",3)
S EPATIEN=$P(ERXNODE0,"^",4) I 'EPATIEN S EPATIEN=$$GETPAT^PSOERXU5(ERXIEN)
; eRx Patient Filter
I $D(PATFLTR),'$D(PATFLTR(+EPATIEN)) Q
S EPROVIEN=+ERXNODE2 I 'EPROVIEN S EPROVIEN=$$GETPROV^PSOERXU5(ERXIEN)
; eRx Provider Filter
I $D(PRVFLTR),'$D(PRVFLTR(EPROVIEN)) Q
S VPATIEN=$P(ERXNODE0,"^",5),MTYPE=$P(ERXNODE0,"^",8)
S STATIEN=+$G(^PS(52.49,ERXIEN,1)),ERXSTAT=$P(^PS(52.45,STATIEN,0),"^")
; Actionable/Non-Actionable Status
I '$G(PSOALLST),'$G(STSFLTR),$F(",RJ,RM,REM,PR,E,RXA,CXA,CAA,CAN,CXP,RXP,RXA,ICA,CNP,CRP,CRC,RRC,CXC,CNE,CRN,CRR,CRX,CXQ,RXA,RXC,RRN,RRX,RRR,RRP,IRA,",","_$E(ERXSTAT,1,3)_",") Q
S RESTYPE=$P($G(^PS(52.49,ERXIEN,52)),"^",1)
S CSERX=+$G(^PS(52.49,ERXIEN,95))
S VPRVIEN=$P($G(^PS(52.49,ERXIEN,2)),"^",3)
S VDRGIEN=$P($G(^PS(52.49,ERXIEN,3)),"^",2)
S CHGMESRQ=$$GET1^DIQ(52.49,ERXIEN,315.1,"I")
S CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
S SKIP=0
; Setting Drug Name (if Blank)
S EDRUG=$P(ERXNODE3,"^",1)
I EDRUG="" S EDRUG=$$GETDRUG^PSOERXU5(ERXIEN) I EDRUG="" S EDRUG=$S(MTYPE="IE":"<<INBOUND ERROR>>",1:"N/A")
; Applying Filters
; Message Type Filter
I $G(MSTPFLTR)'="",MTYPE'=MSTPFLTR Q
I $D(RESARY),$G(MSTPFLTR)'="",(" RE CX "[(" "_MSTPFLTR_" ")) D Q:SKIP
. I RESTYPE="" S SKIP=1 Q
. I '$D(RESARY(RESTYPE)) S SKIP=1
; Match Status Filter
I $G(MATFLTR)=1,VPATIEN Q
I $G(MATFLTR)=2,VPRVIEN!'VPATIEN Q
I $G(MATFLTR)=3,VDRGIEN!'VPATIEN!'VPRVIEN Q
I $G(MATFLTR)=4,'VPATIEN!'VPRVIEN!'VDRGIEN Q
; Main Filter Eligibility by Status
I '$G(PSOALLST)!(PSOSTFLT'="A"),'$$ELIGSTS^PSOERPC1("RX",ERXSTAT,MTYPE) Q
I '$G(STSFLTR),$G(MSTPFLTR)="",MTYPE="CR",ERXSTAT="CRE" Q
; eRx Patient DOB Filter
I $G(DOBFLTR),$$GET1^DIQ(52.46,+EPATIEN,.08,"I")'=DOBFLTR Q
; eRx Status Filter
I $G(STSFLTR),STSFLTR'=+ERXNODE1 Q
I ($G(STSFLTR1)["RM")!($G(STSFLTR1)["ALL"),'$$CHKSTSLST(ERXIEN,$G(STSFLTR)) Q
I ($G(STSFLTR1)["RJ")!($G(STSFLTR1)["ALL"),'$$CHKSTSLST(ERXIEN,$G(STSFLTR)) Q
; eRx Drug Name Filter
I $G(DRGFLTR)'="",$$UP^XLFSTR(EDRUG)'[$$UP^XLFSTR(DRGFLTR) Q
; Controlled Substance Filter
I $G(PSOCSERX)="CS",'CSERX Q
I $G(PSOCSERX)="Non-CS",CSERX Q
I '$$CSFILTER^PSOERXUT(ERXIEN) Q
I $G(VDRGFLTR),VDRGIEN'=VDRGFLTR Q
; If the eRx is a new refill request and the status is refill request new, check for a response.
; If no response was received within 14 days, change to RRE (refill request expired).
I MTYPE="RR",ERXSTAT="RRN" D CHKEXP^PSOERX(ERXIEN,MTYPE)
; ChangeRequest messages will be checked for expiration status,
; but will not be displayed in the holding queue list view.
I MTYPE="CR",ERXSTAT="CRN" D CHKEXP^PSOERX(ERXIEN,MTYPE)
I 'EPATIEN S EPATIEN=$$GETPAT^PSOERXU5(ERXIEN)
; If this is not a search, is a refill response, and is a response type of 'approved',
; do not show in the holding queue.
I '$$FILTERED^PSOERPC1("RX"),MTYPE="RE",RESTYPE="A" Q
; Do not display refill response with 'approved with changes' status in the holding queue.
I '$$FILTERED^PSOERPC1("RX"),MTYPE="RE","RXP,RXC,RXA,RRP,"[ERXSTAT Q
S SKIP=0
I $D(DNDARY),MTYPE="RE",$G(MSTPFLTR)=MTYPE,RESTYPE="D" D Q:SKIP
. I $D(DNDARY) D ;if user selected additional filter for DENIED
. . I $P(MSTPFLTR1,"/",3)="ALL" Q
. . S DRSNCODE=$$DNDRCODE^PSOERRX2(ERXIEN) I $G(DRSNCODE)="" S SKIP=1 Q ;get the denied reason code
. . I $G(DRSNCODE)'="",'$D(DNDARY(DRSNCODE)) S SKIP=1
S EPTNODE0=$G(^PS(52.46,EPATIEN,0)),EPTNODE1=$G(^PS(52.46,EPATIEN,1)),EPTNODE2=$G(^PS(52.46,EPATIEN,2))
S PATNAME=$P(EPTNODE0,"^") I PATNAME="" S PATNAME=$$PATNAME^PSOERUT(ERXIEN)
S DOB=$P(EPTNODE1,"^",4)
S PROVIDER=+$G(^PS(52.49,ERXIEN,2)),PROVIDER=$P($G(^PS(52.48,PROVIDER,0)),"^")
I PROVIDER="" S PROVIDER=$$GET1^DIQ(52.48,+$$GETPROV^PSOERXU5(ERXIEN),.01) S:PROVIDER="" PROVIDER="N/A"
S CSGROUP=$S('PSOCSGRP:"ALL",CSERX:"CS",1:"NON-CS")
I MTYPE="CR",(ERXSTAT="CRE") Q
S SKIP=0
I $D(RXREQARY),MTYPE="CR",$G(MSTPFLTR)=MTYPE D Q:SKIP
. I $G(CHGMESRI)="" S SKIP=1 Q
. I '$D(RXREQARY(CHGMESRI)) S SKIP=1
S Z="",$P(Z,"^")=PATNAME,$P(Z,"^",2)=$$FMTE^XLFDT(DOB,"2Z"),$P(Z,"^",3)=EDRUG,$P(Z,"^",4)=PROVIDER
S $P(Z,"^",5)=ERXSTAT,$P(Z,"^",6)=$$FMTE^XLFDT(MSGDT\1,"2Z")
S SORT=MSGDT_ERXIEN_" "
I FIELD="PA" S SORT=PATNAME_" "_ERXIEN
I FIELD="DOB" S SORT=DOB_" "_ERXIEN
I FIELD="DR" S SORT=$$UP^XLFSTR(EDRUG)_" "_ERXIEN
I FIELD="PR" S SORT=PROVIDER_" "_ERXIEN
I FIELD="RE" S SORT=MSGDT_" "_ERXIEN
I FIELD="STA" S SORT=ERXSTAT_" "_ERXIEN
S ^TMP("PSOERRXS",$J,CSGROUP,SORT)=Z
S ^TMP("PSOERRXS",$J,CSGROUP,SORT,"ERXIEN")=ERXIEN_"^"_$S($G(LOCKPATS(+EPATIEN)):1,1:0)
S ^TMP("PSOERINC",$J,ERXIEN)=""
S COUNTER=$G(COUNTER)+1
Q
;
VPRVFLTR ; - VistA Provider Filter
N DIR,PRV,XX,RANGE,COMSEG,I,J,VPRV,EPRV,DIRUT,DIROUT,QUIT
REP1 ; - Repeat VistA Provider Prompt
S DIR(0)="F^3:30",DIR("A")="VISTA PROVIDER NAME"
W ! D ^DIR I $D(DIRUT)!$D(DIROUT) Q
I $$CHKPRV2^PSOERX1A(Y)
D FIND^DIC(200,"","@;.01;.114;.115;53.2;IX","",X,,"B","I $$CHKPRV2^PSOERX1A(Y)","","PRVLST")
I '$D(PRVLST("DILIST",2)) W !,"No VistA Provider found",$C(7) K PRVLST G REP1
;
D PRVLHDR
S (QUIT,CNT)=0 K DIRUT,DTOUT
S PRV="" F S PRV=$O(PRVLST("DILIST","ID",PRV)) Q:'PRV D I QUIT Q
. W !,PRV,".",?4,$E(PRVLST("DILIST","ID",PRV,.01),1,30),?35,PRVLST("DILIST","ID",PRV,53.2)
. I PRVLST("DILIST","ID",PRV,.114)'="" D
. . W ?47,$E(PRVLST("DILIST","ID",PRV,.114),1,20),"-",$$STATEABB^PSOERUT(200,PRVLST("DILIST",2,PRV))
. W ?71,$$FMTE^XLFDT($$LASTREDT^PSOERUT("AVPRV",PRVLST("DILIST",2,PRV)),"2Z")
. S CNT=CNT+1
. I CNT>18,$O(PRVLST("DILIST","ID",PRV)),$Y>(IOSL-4) D
. . K DIR S DIR(0)="E" D ^DIR I $D(DIRUT)!$D(DIROUT) S QUIT=1 Q
. . W @IOF D PRVLHDR
;
K DIR S DIR("A")="SELECT (1-"_+$G(PRVLST("DILIST",0))_"): "
S DIR(0)="LA^1:"_+$G(PRVLST("DILIST",0)) W ! D ^DIR I $D(DIRUT)!$D(DIROUT) G REP1
S RANGE=X
;
K VPRVFLTR,PRVFLTR
F I=1:1:$L(RANGE,",") D
. S COMSEG=$P(RANGE,",",I)
. F J=+COMSEG:1:$S(COMSEG["-":$P(COMSEG,"-",2),1:+COMSEG) D
. . S VPRV=+$G(PRVLST("DILIST",2,J)) I 'VPRV Q
. . S VPRVFLTR(VPRV)=""
. . S EPRV=0 F S EPRV=$O(^PS(52.49,"AVPRV",VPRV,EPRV)) Q:'EPRV D
. . . S PRVFLTR(EPRV)=""
;
I '$D(PRVFLTR) W !!,"There are no eRx Providers associated with the VistA Provider(s) selected.",$C(7) K VPRVFLTR G REP1
Q
;
PRVLHDR ; - Prints the Provider List Header
N XX W !?73,"LAST",!,"#",?4,"VISTA PROVIDER NAME",?35,"DEA",?47,"CITY",?71,"REC.DATE"
S $P(XX,"-",80)="" W !,XX
Q
;
VDRGFLTR ;VistA Drug Filter
;- input vars for ^DIC call
N DIC,DTOUT,DUOUT,X,Y,DRGFLTR
REPDRG ;Repeat VistA Drug Prompt
I $G(VDRGFLTR) S DIC("B")=$$GET1^DIQ(50,VDRGFLTR,.01)
W !
S DIC=50,DIC(0)="AEMQZV",DIC("A")="VISTA DRUG: "
S DIC("?PARAM",50,"INDEX")="B"
;- lookup VISTA DRUG
D ^DIC K DIC
;- result of lookup
I +$G(Y)<1 Q ;user either press enter or ^
;- if success, check if the selected drug exist in the ^PS(52.49,"AVDRG" cross reference
I (+$G(Y)>0),$D(^PS(52.49,"AVDRG",+$G(Y))) D
. S VDRGFLTR=+$G(Y)
E W !!,IOINHI,"There are no eRx Drug(s) matched to this VistA Drug.",IOINORM,$C(7) K VDRGFLTR G REPDRG
Q
;
CHKSTSLST(ERXIEN,STSFLTR) ;Check erx order status
;Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; STSFLTR - Filter By eRx Status is set (Pointer to ERX HOLDING QUEUE file (#52.45))
;Output: Return 1 if found. otherwise, 0
Q:+$G(ERXIEN)<1
N STSDTME,STSIEN,RSNIEN,FOUND,CNTR,ERXNODE1
S (FOUND,CNTR)=0
S ERXNODE1=$G(^PS(52.49,ERXIEN,1))
S STSDTME="" F S STSDTME=$O(^PS(52.49,ERXIEN,19,"B",STSDTME),-1) Q:STSDTME=""!(CNTR=2) D Q:FOUND
. S STSIEN="" F S STSIEN=$O(^PS(52.49,ERXIEN,19,"B",STSDTME,STSIEN),-1) Q:STSIEN=""!(CNTR=2) D Q:FOUND
. . S CNTR=CNTR+1
. . S RSNIEN=$P($G(^PS(52.49,ERXIEN,19,STSIEN,0)),"^",2)
. . I $G(STSFLTR)=+ERXNODE1,$D(STSRMARY(RSNIEN)) S FOUND=1
Q FOUND
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERRX1 15736 printed Sep 23, 2025@20:04:17 Page 2
PSOERRX1 ;BIRM/MFR - All Rxs eRx Queue - Supporting APIs ;08/28/22
+1 ;;7.0;OUTPATIENT PHARMACY;**700,769,770**;DEC 1997;Build 145
+2 ;
HDR ; - Builds the Header section
+1 NEW LINE1,LINE2,LINE3,ARR
+2 ;
+3 SET LINE1="LOOK BACK DAYS: "_IOINHI_$SELECT($GET(REDTFLTR):"N/A",1:PSOLKBKD)_IOINORM
+4 SET $EXTRACT(LINE1,40)="CS/NON-CS: "_IOINHI_$SELECT(PSOCSERX="CS":"CS ONLY",PSOCSERX="Non-CS":"NON-CS ONLY",1:"BOTH")
+5 if PSOCSERX'="Non-CS"
SET LINE1=LINE1_" ("_$SELECT(PSOCSSCH=1:"II",PSOCSSCH=2:"III-V",1:"II-V")_")"
+6 SET LINE1=LINE1_IOINORM
+7 DO INSTR^VALM1("MAX. QUEUE SIZE: "_IOINHI_$JUSTIFY(PSOMAXQS,4)_IOINORM,60,2)
+8 ;
+9 SET LINE2="ERX STATUS: "_IOINHI
+10 IF PSOSTFLT="A"
SET LINE2=LINE2_"ALL"
+11 IF PSOSTFLT="N"
SET LINE2=LINE2_"NEW"
+12 IF PSOSTFLT="I"
SET LINE2=LINE2_"IN PROGRESS"
+13 IF PSOSTFLT="W"
SET LINE2=LINE2_"WAIT"
+14 IF PSOSTFLT="H"
SET LINE2=LINE2_$SELECT(PSOHDSTS="ALL":"HOLD (ALL)",1:"HOLD ("_PSOHDSTS_")")
+15 IF PSOSTFLT="C"
SET LINE2=LINE2_$SELECT(PSOCCRST="ALL":"CCR (ALL)",1:"CCR ("_PSOCCRST_")")
+16 SET LINE2=LINE2_IOINORM
+17 SET LINE3=""
+18 IF $DATA(PATFLTR)!$GET(DOBFLTR)!$GET(REDTFLTR)!$DATA(PRVFLTR)!$GET(STSFLTR)!($GET(DRGFLTR)'="")!$GET(MATFLTR)!($GET(MSTPFLTR)'="")!$GET(VDRGFLTR)
Begin DoDot:1
+19 NEW FILTER
SET FILTER=""
+20 IF $GET(REDTFLTR)
SET FILTER=FILTER_"|"_$$FMTE^XLFDT(+REDTFLTR,"2Z")_"-"_$$FMTE^XLFDT($PIECE(REDTFLTR,"^",2),"2Z")
+21 IF $GET(MATFLTR)
SET FILTER=FILTER_"|MATCH("_$$MATCHLBL^PSOERPC2(MATFLTR)_")"
+22 IF $GET(DRGFLTR)'=""
SET FILTER=FILTER_"|ERX DRUG NAME('"_DRGFLTR_"')"
+23 IF $GET(DOBFLTR)
SET FILTER=FILTER_"|DOB("_$$FMTE^XLFDT(DOBFLTR,"2Z")_")"
+24 IF $GET(STSFLTR)
SET FILTER=FILTER_"|STATUS("_$SELECT($GET(STSFLTR1)'="":STSFLTR1,1:$$GET1^DIQ(52.45,STSFLTR,.01))_")"
+25 IF $GET(MSTPFLTR)'=""
SET FILTER=FILTER_"|TYPE("_$SELECT($GET(MSTPFLTR1)'="":MSTPFLTR1,1:$GET(MTARR(MSTPFLTR)))_")"
+26 IF $DATA(PRVFLTR)
SET FILTER=FILTER_"|PROVIDER("_$$EPRVFLST^PSOERUT(60)_")"
+27 IF $DATA(PATFLTR)
SET FILTER=FILTER_"|PATIENT("_$$EPATFLST^PSOERUT(60)_")"
+28 IF $GET(VDRGFLTR)
SET FILTER=FILTER_"|VISTA DRUG("_$$GET1^DIQ(50,VDRGFLTR,.01)_")"
+29 SET $EXTRACT(FILTER,1)=""
IF $LENGTH(FILTER)>63
SET FILTER=$EXTRACT(FILTER,1,60)_"..."
+30 SET LINE2="FILTERED BY: "_IOINHI_FILTER_IOINORM
End DoDot:1
+31 ;S:LINE3'="" VALMHDR(3)=LINE3 S VALMHDR(4)=IOINORM
KILL VALMHDR
SET VALMHDR(1)=LINE1
SET VALMHDR(2)=LINE2
+32 DO SETHDR()
+33 QUIT
+34 ;
SETHDR() ; - Displays the Header Line
+1 NEW HDR,SRTORD,SRTPOS
+2 SET HDR="#"
SET $EXTRACT(HDR,5)="PATIENT"
SET $EXTRACT(HDR,26)="DOB"
SET $EXTRACT(HDR,35)=$SELECT($GET(PSODETDP):"",1:"DRUG")
+3 SET $EXTRACT(HDR,57)="PROVIDER"
SET $EXTRACT(HDR,69)="STA"
SET $EXTRACT(HDR,73)="REC.DATE"
+4 DO INSTR^VALM1(IORVON_HDR_IOINORM,1,4)
+5 SET SRTORD=$SELECT(PSORDER="A":"^",1:"v")
+6 SET SRTPOS=$SELECT(PSOSRTBY="PA":12,PSOSRTBY="DOB":29,PSOSRTBY="DR":39,PSOSRTBY="PR":65,PSOSRTBY="STA":72,1:80)
+7 DO INSTR^VALM1(IOINHI_IORVON_SRTORD_IOINORM,SRTPOS,4)
+8 QUIT
+9 ;
SETSORT(FIELD) ; Sets the data sorted by the FIELD specified
+1 ;Input: FIELD - Sort By Field
+2 NEW ERXCNT,PATNAME,DOB,MSGDT,ERXIEN,CSGROUP,ERXSTS,STS,STSIEN,EXSTSAR,MSGTYPE,PATMTCH,PROMTCH,DRUMTCH,Z,X
+3 NEW ERXPAT,ERXPRV,INST,BEGDATE,ENDDATE,INST,STSLST,RELMSGID,RELMRD
+4 KILL ^TMP("PSOERRXS",$JOB),^TMP("PSOERINC",$JOB)
+5 ;
+6 SET ERXCNT=0
+7 SET BEGDATE=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
SET ENDDATE=DT+.99
+8 ; - Setting Begin/End Date if a Date Range is selected
+9 IF $GET(REDTFLTR)
Begin DoDot:1
+10 SET BEGDATE=$PIECE(REDTFLTR,"^",1)-.1
SET ENDDATE=$PIECE(REDTFLTR,"^",2)+.99
End DoDot:1
+11 ;
+12 ; - Filter By eRx Patient is set
+13 IF $DATA(PATFLTR)
Begin DoDot:1
+14 SET ERXPAT=""
FOR
SET ERXPAT=$ORDER(PATFLTR(ERXPAT))
if 'ERXPAT
QUIT
Begin DoDot:2
+15 IF $GET(DOBFLTR)
IF '$DATA(^PS(52.46,"DOB",DOBFLTR,ERXPAT))
QUIT
+16 SET MSGDT=BEGDATE
+17 FOR
SET MSGDT=$ORDER(^PS(52.49,"PAT2",ERXPAT,MSGDT))
if 'MSGDT!(MSGDT>ENDDATE)
QUIT
Begin DoDot:3
+18 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"PAT2",ERXPAT,MSGDT,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:4
+19 DO SETITEM(FIELD,ERXIEN,.ERXCNT)
+20 DO RELMSG(ERXIEN,.ERXCNT)
End DoDot:4
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:3
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:2
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:1
QUIT
+21 ;
+22 ; - Filter By eRx Patient DOB is set
+23 IF $GET(DOBFLTR)'=""
Begin DoDot:1
+24 SET ERXPAT=0
FOR
SET ERXPAT=$ORDER(^PS(52.46,"DOB",DOBFLTR,ERXPAT))
if 'ERXPAT
QUIT
Begin DoDot:2
+25 IF $DATA(PATFLTR)
IF '$DATA(PATFLTR(ERXPAT))
QUIT
+26 SET MSGDT=BEGDATE
+27 FOR
SET MSGDT=$ORDER(^PS(52.49,"PAT2",ERXPAT,MSGDT))
if 'MSGDT!(MSGDT>ENDDATE)
QUIT
Begin DoDot:3
+28 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"PAT2",ERXPAT,MSGDT,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:4
+29 DO SETITEM(FIELD,ERXIEN,.ERXCNT)
+30 DO RELMSG(ERXIEN,.ERXCNT)
End DoDot:4
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:3
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:2
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:1
QUIT
+31 ;
+32 ; - Filter By eRx Status is set
+33 IF $GET(PSOSTFLT)'="A"!$GET(STSFLTR)
Begin DoDot:1
+34 IF $GET(STSFLTR)
SET STSLST(STSFLTR)=""
+35 IF '$TEST
DO LOADSTS^PSOERPC1(.STSLST)
+36 IF '$GET(MBMSITE)
Begin DoDot:2
+37 SET ERXSTS=0
FOR
SET ERXSTS=$ORDER(STSLST(ERXSTS))
if 'ERXSTS
QUIT
Begin DoDot:3
+38 SET MSGDT=BEGDATE
+39 FOR
SET MSGDT=$ORDER(^PS(52.49,"E",+$GET(PSNPINST),ERXSTS,MSGDT))
if 'MSGDT!(MSGDT>ENDDATE)
QUIT
Begin DoDot:4
+40 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"E",+$GET(PSNPINST),ERXSTS,MSGDT,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:5
+41 DO SETITEM(FIELD,ERXIEN,.ERXCNT)
+42 DO RELMSG(ERXIEN,.ERXCNT)
End DoDot:5
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:4
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:3
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:2
+43 IF '$TEST
Begin DoDot:2
+44 SET MSGDT=BEGDATE
+45 FOR
SET MSGDT=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT))
if 'MSGDT!(MSGDT>ENDDATE)
QUIT
Begin DoDot:3
+46 SET ERXSTS=0
FOR
SET ERXSTS=$ORDER(STSLST(ERXSTS))
if 'ERXSTS
QUIT
Begin DoDot:4
+47 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:5
+48 DO SETITEM(FIELD,ERXIEN,.ERXCNT)
+49 DO RELMSG(ERXIEN,.ERXCNT)
End DoDot:5
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:4
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:3
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:2
End DoDot:1
QUIT
+50 ;
+51 ; - Filter By Message Type is set
+52 IF $GET(MSTPFLTR)'=""
Begin DoDot:1
+53 SET INST=0
FOR
SET INST=$ORDER(^PS(52.49,"MTYPE",INST))
if 'INST
QUIT
Begin DoDot:2
+54 IF '$GET(MBMSITE)
IF PSNPINST'=INST
QUIT
+55 SET MSGDT=BEGDATE
FOR
SET MSGDT=$ORDER(^PS(52.49,"MTYPE",INST,MSGDT))
if 'MSGDT!(MSGDT>ENDDATE)
QUIT
Begin DoDot:3
+56 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"MTYPE",INST,MSGDT,MSTPFLTR,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:4
+57 DO SETITEM(FIELD,ERXIEN,.ERXCNT)
+58 DO RELMSG(ERXIEN,.ERXCNT)
End DoDot:4
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:3
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:2
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:1
QUIT
+59 ;
+60 ; - Filter By VistA Drug is set
+61 IF $GET(VDRGFLTR)
Begin DoDot:1
+62 SET MSGDT=BEGDATE
+63 FOR
SET MSGDT=$ORDER(^PS(52.49,"AVDRG",VDRGFLTR,MSGDT))
if 'MSGDT!(MSGDT>ENDDATE)
QUIT
Begin DoDot:2
+64 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"AVDRG",VDRGFLTR,MSGDT,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:3
+65 DO SETITEM(FIELD,ERXIEN,.ERXCNT)
+66 DO RELMSG(ERXIEN,.ERXCNT)
End DoDot:3
End DoDot:2
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:1
QUIT
+67 ;
+68 ; - No Filters (Catch All)
+69 SET MSGDT=BEGDATE
+70 FOR
SET MSGDT=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT))
if 'MSGDT!(MSGDT>ENDDATE)
QUIT
Begin DoDot:1
+71 SET ERXSTS=0
FOR
SET ERXSTS=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS))
if 'ERXSTS
QUIT
Begin DoDot:2
+72 IF '$GET(PSOALLST)!(PSOSTFLT'="A")
IF '$$ELIGSTS^PSOERPC1("RX",$PIECE($GET(^PS(52.45,ERXSTS,0)),"^"))
QUIT
+73 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:3
+74 DO SETITEM(FIELD,ERXIEN,.ERXCNT)
+75 DO RELMSG(ERXIEN,.ERXCNT)
End DoDot:3
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:2
IF ERXCNT'<PSOMAXQS
QUIT
End DoDot:1
IF ERXCNT'<PSOMAXQS
QUIT
+76 ;
+77 KILL ^TMP("PSOERINC",$JOB)
+78 QUIT
+79 ;
RELMSG(ERXIEN,ERXCNT) ; Includes any related Message
+1 ;Input: ERXIEN - Pointer to the ERX HOLDING QUEUE (#52.49) file
+2 ; ERXCNT - eRx Counter - Number of Items on the List (Passed in by Reference)
+3 NEW RELMSGID,RELMRD
+4 SET RELMSGID=0
FOR
SET RELMSGID=$ORDER(^PS(52.49,ERXIEN,201,"B",RELMSGID))
if 'RELMSGID
QUIT
Begin DoDot:1
+5 IF $DATA(^TMP("PSOERINC",$JOB,RELMSGID))
QUIT
+6 SET RELMRD=$PIECE($GET(^PS(52.49,RELMSGID,0)),"^",3)
IF RELMRD<BEGDATE!(RELMRD>ENDDATE)
QUIT
+7 DO SETITEM(FIELD,RELMSGID,.ERXCNT)
+8 SET ^TMP("PSOERINC",$JOB,RELMSGID)=""
End DoDot:1
+9 QUIT
+10 ;
SETITEM(FIELD,ERXIEN,COUNTER) ; Adds an eRx Record to the Sorted List
+1 ; Input: FIELD - Sort By field
+2 ; ERXIEN - eRx IEN - Pointer to #52.49
+3 ; COUNTER - eRx Counter - Number of Items on the List (Passed in by Reference)
+4 NEW ERXSTAT,MTYPE,RESTYPE,PATIEN,REQIEN,PATNM,NEWRX,EDRUG,VDRGIEN,MSGDT,STATIEN,CHGMESRI
+5 NEW EXDS,EXPRIEN,VPATIEN,EXPRNM,ERXDT,ERXEDT,DOB,CSPREFIX,CSERX,PROVIDER,EPATIEN,EPROVIEN
+6 NEW ERXNODE0,ERXNODE1,ERXNODE2,ERXNODE3,EPTNODE0,EPTNODE1,EPTNODE2,SKIP,DRSNCODE,CHGMESRQ
+7 ; Related Institution Filter (Non-MbM sites only)
+8 IF '$GET(MBMSITE)
IF $GET(PSNPINST)'=+$GET(^PS(52.49,ERXIEN,24))
QUIT
+9 SET ERXNODE0=$GET(^PS(52.49,ERXIEN,0))
SET ERXNODE1=$GET(^PS(52.49,ERXIEN,1))
+10 SET ERXNODE2=$GET(^PS(52.49,ERXIEN,2))
SET ERXNODE3=$GET(^PS(52.49,ERXIEN,3))
+11 SET MSGDT=$PIECE(ERXNODE0,"^",3)
+12 SET EPATIEN=$PIECE(ERXNODE0,"^",4)
IF 'EPATIEN
SET EPATIEN=$$GETPAT^PSOERXU5(ERXIEN)
+13 ; eRx Patient Filter
+14 IF $DATA(PATFLTR)
IF '$DATA(PATFLTR(+EPATIEN))
QUIT
+15 SET EPROVIEN=+ERXNODE2
IF 'EPROVIEN
SET EPROVIEN=$$GETPROV^PSOERXU5(ERXIEN)
+16 ; eRx Provider Filter
+17 IF $DATA(PRVFLTR)
IF '$DATA(PRVFLTR(EPROVIEN))
QUIT
+18 SET VPATIEN=$PIECE(ERXNODE0,"^",5)
SET MTYPE=$PIECE(ERXNODE0,"^",8)
+19 SET STATIEN=+$GET(^PS(52.49,ERXIEN,1))
SET ERXSTAT=$PIECE(^PS(52.45,STATIEN,0),"^")
+20 ; Actionable/Non-Actionable Status
+21 IF '$GET(PSOALLST)
IF '$GET(STSFLTR)
IF $FIND(",RJ,RM,REM,PR,E,RXA,CXA,CAA,CAN,CXP,RXP,RXA,ICA,CNP,CRP,CRC,RRC,CXC,CNE,CRN,CRR,CRX,CXQ,RXA,RXC,RRN,RRX,RRR,RRP,IRA,",","_$EXTRACT(ERXSTAT,1,3)_",")
QUIT
+22 SET RESTYPE=$PIECE($GET(^PS(52.49,ERXIEN,52)),"^",1)
+23 SET CSERX=+$GET(^PS(52.49,ERXIEN,95))
+24 SET VPRVIEN=$PIECE($GET(^PS(52.49,ERXIEN,2)),"^",3)
+25 SET VDRGIEN=$PIECE($GET(^PS(52.49,ERXIEN,3)),"^",2)
+26 SET CHGMESRQ=$$GET1^DIQ(52.49,ERXIEN,315.1,"I")
+27 SET CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
+28 SET SKIP=0
+29 ; Setting Drug Name (if Blank)
+30 SET EDRUG=$PIECE(ERXNODE3,"^",1)
+31 IF EDRUG=""
SET EDRUG=$$GETDRUG^PSOERXU5(ERXIEN)
IF EDRUG=""
SET EDRUG=$SELECT(MTYPE="IE":"<<INBOUND ERROR>>",1:"N/A")
+32 ; Applying Filters
+33 ; Message Type Filter
+34 IF $GET(MSTPFLTR)'=""
IF MTYPE'=MSTPFLTR
QUIT
+35 IF $DATA(RESARY)
IF $GET(MSTPFLTR)'=""
IF (" RE CX "[(" "_MSTPFLTR_" "))
Begin DoDot:1
+36 IF RESTYPE=""
SET SKIP=1
QUIT
+37 IF '$DATA(RESARY(RESTYPE))
SET SKIP=1
End DoDot:1
if SKIP
QUIT
+38 ; Match Status Filter
+39 IF $GET(MATFLTR)=1
IF VPATIEN
QUIT
+40 IF $GET(MATFLTR)=2
IF VPRVIEN!'VPATIEN
QUIT
+41 IF $GET(MATFLTR)=3
IF VDRGIEN!'VPATIEN!'VPRVIEN
QUIT
+42 IF $GET(MATFLTR)=4
IF 'VPATIEN!'VPRVIEN!'VDRGIEN
QUIT
+43 ; Main Filter Eligibility by Status
+44 IF '$GET(PSOALLST)!(PSOSTFLT'="A")
IF '$$ELIGSTS^PSOERPC1("RX",ERXSTAT,MTYPE)
QUIT
+45 IF '$GET(STSFLTR)
IF $GET(MSTPFLTR)=""
IF MTYPE="CR"
IF ERXSTAT="CRE"
QUIT
+46 ; eRx Patient DOB Filter
+47 IF $GET(DOBFLTR)
IF $$GET1^DIQ(52.46,+EPATIEN,.08,"I")'=DOBFLTR
QUIT
+48 ; eRx Status Filter
+49 IF $GET(STSFLTR)
IF STSFLTR'=+ERXNODE1
QUIT
+50 IF ($GET(STSFLTR1)["RM")!($GET(STSFLTR1)["ALL")
IF '$$CHKSTSLST(ERXIEN,$GET(STSFLTR))
QUIT
+51 IF ($GET(STSFLTR1)["RJ")!($GET(STSFLTR1)["ALL")
IF '$$CHKSTSLST(ERXIEN,$GET(STSFLTR))
QUIT
+52 ; eRx Drug Name Filter
+53 IF $GET(DRGFLTR)'=""
IF $$UP^XLFSTR(EDRUG)'[$$UP^XLFSTR(DRGFLTR)
QUIT
+54 ; Controlled Substance Filter
+55 IF $GET(PSOCSERX)="CS"
IF 'CSERX
QUIT
+56 IF $GET(PSOCSERX)="Non-CS"
IF CSERX
QUIT
+57 IF '$$CSFILTER^PSOERXUT(ERXIEN)
QUIT
+58 IF $GET(VDRGFLTR)
IF VDRGIEN'=VDRGFLTR
QUIT
+59 ; If the eRx is a new refill request and the status is refill request new, check for a response.
+60 ; If no response was received within 14 days, change to RRE (refill request expired).
+61 IF MTYPE="RR"
IF ERXSTAT="RRN"
DO CHKEXP^PSOERX(ERXIEN,MTYPE)
+62 ; ChangeRequest messages will be checked for expiration status,
+63 ; but will not be displayed in the holding queue list view.
+64 IF MTYPE="CR"
IF ERXSTAT="CRN"
DO CHKEXP^PSOERX(ERXIEN,MTYPE)
+65 IF 'EPATIEN
SET EPATIEN=$$GETPAT^PSOERXU5(ERXIEN)
+66 ; If this is not a search, is a refill response, and is a response type of 'approved',
+67 ; do not show in the holding queue.
+68 IF '$$FILTERED^PSOERPC1("RX")
IF MTYPE="RE"
IF RESTYPE="A"
QUIT
+69 ; Do not display refill response with 'approved with changes' status in the holding queue.
+70 IF '$$FILTERED^PSOERPC1("RX")
IF MTYPE="RE"
IF "RXP,RXC,RXA,RRP,"[ERXSTAT
QUIT
+71 SET SKIP=0
+72 IF $DATA(DNDARY)
IF MTYPE="RE"
IF $GET(MSTPFLTR)=MTYPE
IF RESTYPE="D"
Begin DoDot:1
+73 ;if user selected additional filter for DENIED
IF $DATA(DNDARY)
Begin DoDot:2
+74 IF $PIECE(MSTPFLTR1,"/",3)="ALL"
QUIT
+75 ;get the denied reason code
SET DRSNCODE=$$DNDRCODE^PSOERRX2(ERXIEN)
IF $GET(DRSNCODE)=""
SET SKIP=1
QUIT
+76 IF $GET(DRSNCODE)'=""
IF '$DATA(DNDARY(DRSNCODE))
SET SKIP=1
End DoDot:2
End DoDot:1
if SKIP
QUIT
+77 SET EPTNODE0=$GET(^PS(52.46,EPATIEN,0))
SET EPTNODE1=$GET(^PS(52.46,EPATIEN,1))
SET EPTNODE2=$GET(^PS(52.46,EPATIEN,2))
+78 SET PATNAME=$PIECE(EPTNODE0,"^")
IF PATNAME=""
SET PATNAME=$$PATNAME^PSOERUT(ERXIEN)
+79 SET DOB=$PIECE(EPTNODE1,"^",4)
+80 SET PROVIDER=+$GET(^PS(52.49,ERXIEN,2))
SET PROVIDER=$PIECE($GET(^PS(52.48,PROVIDER,0)),"^")
+81 IF PROVIDER=""
SET PROVIDER=$$GET1^DIQ(52.48,+$$GETPROV^PSOERXU5(ERXIEN),.01)
if PROVIDER=""
SET PROVIDER="N/A"
+82 SET CSGROUP=$SELECT('PSOCSGRP:"ALL",CSERX:"CS",1:"NON-CS")
+83 IF MTYPE="CR"
IF (ERXSTAT="CRE")
QUIT
+84 SET SKIP=0
+85 IF $DATA(RXREQARY)
IF MTYPE="CR"
IF $GET(MSTPFLTR)=MTYPE
Begin DoDot:1
+86 IF $GET(CHGMESRI)=""
SET SKIP=1
QUIT
+87 IF '$DATA(RXREQARY(CHGMESRI))
SET SKIP=1
End DoDot:1
if SKIP
QUIT
+88 SET Z=""
SET $PIECE(Z,"^")=PATNAME
SET $PIECE(Z,"^",2)=$$FMTE^XLFDT(DOB,"2Z")
SET $PIECE(Z,"^",3)=EDRUG
SET $PIECE(Z,"^",4)=PROVIDER
+89 SET $PIECE(Z,"^",5)=ERXSTAT
SET $PIECE(Z,"^",6)=$$FMTE^XLFDT(MSGDT\1,"2Z")
+90 SET SORT=MSGDT_ERXIEN_" "
+91 IF FIELD="PA"
SET SORT=PATNAME_" "_ERXIEN
+92 IF FIELD="DOB"
SET SORT=DOB_" "_ERXIEN
+93 IF FIELD="DR"
SET SORT=$$UP^XLFSTR(EDRUG)_" "_ERXIEN
+94 IF FIELD="PR"
SET SORT=PROVIDER_" "_ERXIEN
+95 IF FIELD="RE"
SET SORT=MSGDT_" "_ERXIEN
+96 IF FIELD="STA"
SET SORT=ERXSTAT_" "_ERXIEN
+97 SET ^TMP("PSOERRXS",$JOB,CSGROUP,SORT)=Z
+98 SET ^TMP("PSOERRXS",$JOB,CSGROUP,SORT,"ERXIEN")=ERXIEN_"^"_$SELECT($GET(LOCKPATS(+EPATIEN)):1,1:0)
+99 SET ^TMP("PSOERINC",$JOB,ERXIEN)=""
+100 SET COUNTER=$GET(COUNTER)+1
+101 QUIT
+102 ;
VPRVFLTR ; - VistA Provider Filter
+1 NEW DIR,PRV,XX,RANGE,COMSEG,I,J,VPRV,EPRV,DIRUT,DIROUT,QUIT
REP1 ; - Repeat VistA Provider Prompt
+1 SET DIR(0)="F^3:30"
SET DIR("A")="VISTA PROVIDER NAME"
+2 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+3 IF $$CHKPRV2^PSOERX1A(Y)
+4 DO FIND^DIC(200,"","@;.01;.114;.115;53.2;IX","",X,,"B","I $$CHKPRV2^PSOERX1A(Y)","","PRVLST")
+5 IF '$DATA(PRVLST("DILIST",2))
WRITE !,"No VistA Provider found",$CHAR(7)
KILL PRVLST
GOTO REP1
+6 ;
+7 DO PRVLHDR
+8 SET (QUIT,CNT)=0
KILL DIRUT,DTOUT
+9 SET PRV=""
FOR
SET PRV=$ORDER(PRVLST("DILIST","ID",PRV))
if 'PRV
QUIT
Begin DoDot:1
+10 WRITE !,PRV,".",?4,$EXTRACT(PRVLST("DILIST","ID",PRV,.01),1,30),?35,PRVLST("DILIST","ID",PRV,53.2)
+11 IF PRVLST("DILIST","ID",PRV,.114)'=""
Begin DoDot:2
+12 WRITE ?47,$EXTRACT(PRVLST("DILIST","ID",PRV,.114),1,20),"-",$$STATEABB^PSOERUT(200,PRVLST("DILIST",2,PRV))
End DoDot:2
+13 WRITE ?71,$$FMTE^XLFDT($$LASTREDT^PSOERUT("AVPRV",PRVLST("DILIST",2,PRV)),"2Z")
+14 SET CNT=CNT+1
+15 IF CNT>18
IF $ORDER(PRVLST("DILIST","ID",PRV))
IF $Y>(IOSL-4)
Begin DoDot:2
+16 KILL DIR
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
SET QUIT=1
QUIT
+17 WRITE @IOF
DO PRVLHDR
End DoDot:2
End DoDot:1
IF QUIT
QUIT
+18 ;
+19 KILL DIR
SET DIR("A")="SELECT (1-"_+$GET(PRVLST("DILIST",0))_"): "
+20 SET DIR(0)="LA^1:"_+$GET(PRVLST("DILIST",0))
WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO REP1
+21 SET RANGE=X
+22 ;
+23 KILL VPRVFLTR,PRVFLTR
+24 FOR I=1:1:$LENGTH(RANGE,",")
Begin DoDot:1
+25 SET COMSEG=$PIECE(RANGE,",",I)
+26 FOR J=+COMSEG:1:$SELECT(COMSEG["-":$PIECE(COMSEG,"-",2),1:+COMSEG)
Begin DoDot:2
+27 SET VPRV=+$GET(PRVLST("DILIST",2,J))
IF 'VPRV
QUIT
+28 SET VPRVFLTR(VPRV)=""
+29 SET EPRV=0
FOR
SET EPRV=$ORDER(^PS(52.49,"AVPRV",VPRV,EPRV))
if 'EPRV
QUIT
Begin DoDot:3
+30 SET PRVFLTR(EPRV)=""
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 IF '$DATA(PRVFLTR)
WRITE !!,"There are no eRx Providers associated with the VistA Provider(s) selected.",$CHAR(7)
KILL VPRVFLTR
GOTO REP1
+33 QUIT
+34 ;
PRVLHDR ; - Prints the Provider List Header
+1 NEW XX
WRITE !?73,"LAST",!,"#",?4,"VISTA PROVIDER NAME",?35,"DEA",?47,"CITY",?71,"REC.DATE"
+2 SET $PIECE(XX,"-",80)=""
WRITE !,XX
+3 QUIT
+4 ;
VDRGFLTR ;VistA Drug Filter
+1 ;- input vars for ^DIC call
+2 NEW DIC,DTOUT,DUOUT,X,Y,DRGFLTR
REPDRG ;Repeat VistA Drug Prompt
+1 IF $GET(VDRGFLTR)
SET DIC("B")=$$GET1^DIQ(50,VDRGFLTR,.01)
+2 WRITE !
+3 SET DIC=50
SET DIC(0)="AEMQZV"
SET DIC("A")="VISTA DRUG: "
+4 SET DIC("?PARAM",50,"INDEX")="B"
+5 ;- lookup VISTA DRUG
+6 DO ^DIC
KILL DIC
+7 ;- result of lookup
+8 ;user either press enter or ^
IF +$GET(Y)<1
QUIT
+9 ;- if success, check if the selected drug exist in the ^PS(52.49,"AVDRG" cross reference
+10 IF (+$GET(Y)>0)
IF $DATA(^PS(52.49,"AVDRG",+$GET(Y)))
Begin DoDot:1
+11 SET VDRGFLTR=+$GET(Y)
End DoDot:1
+12 IF '$TEST
WRITE !!,IOINHI,"There are no eRx Drug(s) matched to this VistA Drug.",IOINORM,$CHAR(7)
KILL VDRGFLTR
GOTO REPDRG
+13 QUIT
+14 ;
CHKSTSLST(ERXIEN,STSFLTR) ;Check erx order status
+1 ;Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ; STSFLTR - Filter By eRx Status is set (Pointer to ERX HOLDING QUEUE file (#52.45))
+3 ;Output: Return 1 if found. otherwise, 0
+4 if +$GET(ERXIEN)<1
QUIT
+5 NEW STSDTME,STSIEN,RSNIEN,FOUND,CNTR,ERXNODE1
+6 SET (FOUND,CNTR)=0
+7 SET ERXNODE1=$GET(^PS(52.49,ERXIEN,1))
+8 SET STSDTME=""
FOR
SET STSDTME=$ORDER(^PS(52.49,ERXIEN,19,"B",STSDTME),-1)
if STSDTME=""!(CNTR=2)
QUIT
Begin DoDot:1
+9 SET STSIEN=""
FOR
SET STSIEN=$ORDER(^PS(52.49,ERXIEN,19,"B",STSDTME,STSIEN),-1)
if STSIEN=""!(CNTR=2)
QUIT
Begin DoDot:2
+10 SET CNTR=CNTR+1
+11 SET RSNIEN=$PIECE($GET(^PS(52.49,ERXIEN,19,STSIEN,0)),"^",2)
+12 IF $GET(STSFLTR)=+ERXNODE1
IF $DATA(STSRMARY(RSNIEN))
SET FOUND=1
End DoDot:2
if FOUND
QUIT
End DoDot:1
if FOUND
QUIT
+13 QUIT FOUND
