PSOERRX1 ;BIRM/MFR - All Rxs eRx Queue - Supporting APIs ;08/28/22
;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
;
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)'="") 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_"|DRUG('"_DRGFLTR_"')"
. I $G(DOBFLTR) S FILTER=FILTER_"|DOB("_$$FMTE^XLFDT(DOBFLTR,"2Z")_")"
. I $G(STSFLTR) S FILTER=FILTER_"|STATUS("_$$GET1^DIQ(52.45,STSFLTR,.01)_")"
. I $G(MSTPFLTR)'="" S FILTER=FILTER_"|TYPE("_$G(MTARR(MSTPFLTR))_")"
. I $D(PRVFLTR) S FILTER=FILTER_"|PROVIDER("_$$EPRVFLST^PSOERUT(60)_")"
. I $D(PATFLTR) S FILTER=FILTER_"|PATIENT("_$$EPATFLST^PSOERUT(60)_")"
. 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)="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(MBMSITE),$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)
;
; - 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 '$$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,ERXQFLG,REQIEN,DELTA,PATNM,NEWRX,EDRUG,VDRGIEN,MSGDT,STATIEN
N EXDS,EXPRIEN,VPATIEN,EXPRNM,ERXDT,ERXEDT,DOB,CSPREFIX,CSERX,PROVIDER,EPATIEN,EPROVIEN
N ERXNODE0,ERXNODE1,ERXNODE2,ERXNODE3,EPTNODE0,EPTNODE1,EPTNODE2
; 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)
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),"^")
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)
; 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
; 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 '$$ELIGSTS^PSOERPC1("RX",ERXSTAT,MTYPE) Q
I '$G(STSFLTR),$G(MSTPFLTR)="",MTYPE="CR",ERXSTAT="CRE" Q
; eRx Patient Filter
I $D(PATFLTR),'$D(PATFLTR(+EPATIEN)) Q
; eRx Patient DOB Filter
I $G(DOBFLTR),$$GET1^DIQ(52.46,+EPATIEN,.08,"I")'=DOBFLTR Q
; eRx Provider Filter
I $D(PRVFLTR),'$D(PRVFLTR(+EPROVIEN)) Q
; eRx Status Filter
I $G(STSFLTR),STSFLTR'=+ERXNODE1 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
; 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 ERXQFLG=0
I MTYPE="RE",RESTYPE="AWC" D Q:ERXQFLG
. S REQIEN=$$GETREQ^PSOERXU2(ERXIEN) I 'REQIEN Q
. D RRDELTA^PSOERXU2(.DELTA,REQIEN,ERXIEN)
. I $D(DELTA(52.49,"EXTERNAL PROVIDER")) Q
. S ERXQFLG=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 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERRX1 12886 printed Apr 09, 2024@21:35:39 Page 2
PSOERRX1 ;BIRM/MFR - All Rxs eRx Queue - Supporting APIs ;08/28/22
+1 ;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
+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)'="")
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_"|DRUG('"_DRGFLTR_"')"
+23 IF $GET(DOBFLTR)
SET FILTER=FILTER_"|DOB("_$$FMTE^XLFDT(DOBFLTR,"2Z")_")"
+24 IF $GET(STSFLTR)
SET FILTER=FILTER_"|STATUS("_$$GET1^DIQ(52.45,STSFLTR,.01)_")"
+25 IF $GET(MSTPFLTR)'=""
SET FILTER=FILTER_"|TYPE("_$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 SET $EXTRACT(FILTER,1)=""
IF $LENGTH(FILTER)>63
SET FILTER=$EXTRACT(FILTER,1,60)_"..."
+29 SET LINE2="FILTERED BY: "_IOINHI_FILTER_IOINORM
End DoDot:1
+30 ;S:LINE3'="" VALMHDR(3)=LINE3 S VALMHDR(4)=IOINORM
KILL VALMHDR
SET VALMHDR(1)=LINE1
SET VALMHDR(2)=LINE2
+31 DO SETHDR()
+32 QUIT
+33 ;
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)="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(MBMSITE)
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 ; - No Filters (Catch All)
+61 SET MSGDT=BEGDATE
+62 FOR
SET MSGDT=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT))
if 'MSGDT!(MSGDT>ENDDATE)
QUIT
Begin DoDot:1
+63 SET ERXSTS=0
FOR
SET ERXSTS=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS))
if 'ERXSTS
QUIT
Begin DoDot:2
+64 IF '$$ELIGSTS^PSOERPC1("RX",$PIECE($GET(^PS(52.45,ERXSTS,0)),"^"))
QUIT
+65 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:3
+66 DO SETITEM(FIELD,ERXIEN,.ERXCNT)
+67 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
+68 ;
+69 KILL ^TMP("PSOERINC",$JOB)
+70 QUIT
+71 ;
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,ERXQFLG,REQIEN,DELTA,PATNM,NEWRX,EDRUG,VDRGIEN,MSGDT,STATIEN
+5 NEW EXDS,EXPRIEN,VPATIEN,EXPRNM,ERXDT,ERXEDT,DOB,CSPREFIX,CSERX,PROVIDER,EPATIEN,EPROVIEN
+6 NEW ERXNODE0,ERXNODE1,ERXNODE2,ERXNODE3,EPTNODE0,EPTNODE1,EPTNODE2
+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 SET EPROVIEN=+ERXNODE2
IF 'EPROVIEN
SET EPROVIEN=$$GETPROV^PSOERXU5(ERXIEN)
+14 ; eRx Provider Filter
+15 IF $DATA(PRVFLTR)
IF '$DATA(PRVFLTR(EPROVIEN))
QUIT
+16 SET VPATIEN=$PIECE(ERXNODE0,"^",5)
SET MTYPE=$PIECE(ERXNODE0,"^",8)
+17 SET STATIEN=+$GET(^PS(52.49,ERXIEN,1))
SET ERXSTAT=$PIECE(^PS(52.45,STATIEN,0),"^")
+18 SET RESTYPE=$PIECE($GET(^PS(52.49,ERXIEN,52)),"^",1)
+19 SET CSERX=+$GET(^PS(52.49,ERXIEN,95))
+20 SET VPRVIEN=$PIECE($GET(^PS(52.49,ERXIEN,2)),"^",3)
+21 SET VDRGIEN=$PIECE($GET(^PS(52.49,ERXIEN,3)),"^",2)
+22 ; Setting Drug Name (if Blank)
+23 SET EDRUG=$PIECE(ERXNODE3,"^",1)
+24 IF EDRUG=""
SET EDRUG=$$GETDRUG^PSOERXU5(ERXIEN)
IF EDRUG=""
SET EDRUG=$SELECT(MTYPE="IE":"<<INBOUND ERROR>>",1:"N/A")
+25 ; Applying Filters
+26 ; Message Type Filter
+27 IF $GET(MSTPFLTR)'=""
IF MTYPE'=MSTPFLTR
QUIT
+28 ; Match Status Filter
+29 IF $GET(MATFLTR)=1
IF VPATIEN
QUIT
+30 IF $GET(MATFLTR)=2
IF VPRVIEN!'VPATIEN
QUIT
+31 IF $GET(MATFLTR)=3
IF VDRGIEN!'VPATIEN!'VPRVIEN
QUIT
+32 IF $GET(MATFLTR)=4
IF 'VPATIEN!'VPRVIEN!'VDRGIEN
QUIT
+33 ; Main Filter Eligibility by Status
+34 IF '$$ELIGSTS^PSOERPC1("RX",ERXSTAT,MTYPE)
QUIT
+35 IF '$GET(STSFLTR)
IF $GET(MSTPFLTR)=""
IF MTYPE="CR"
IF ERXSTAT="CRE"
QUIT
+36 ; eRx Patient Filter
+37 IF $DATA(PATFLTR)
IF '$DATA(PATFLTR(+EPATIEN))
QUIT
+38 ; eRx Patient DOB Filter
+39 IF $GET(DOBFLTR)
IF $$GET1^DIQ(52.46,+EPATIEN,.08,"I")'=DOBFLTR
QUIT
+40 ; eRx Provider Filter
+41 IF $DATA(PRVFLTR)
IF '$DATA(PRVFLTR(+EPROVIEN))
QUIT
+42 ; eRx Status Filter
+43 IF $GET(STSFLTR)
IF STSFLTR'=+ERXNODE1
QUIT
+44 ; eRx Drug Name Filter
+45 IF $GET(DRGFLTR)'=""
IF $$UP^XLFSTR(EDRUG)'[$$UP^XLFSTR(DRGFLTR)
QUIT
+46 ; Controlled Substance Filter
+47 IF $GET(PSOCSERX)="CS"
IF 'CSERX
QUIT
+48 IF $GET(PSOCSERX)="Non-CS"
IF CSERX
QUIT
+49 IF '$$CSFILTER^PSOERXUT(ERXIEN)
QUIT
+50 ; If the eRx is a new refill request and the status is refill request new, check for a response.
+51 ; If no response was received within 14 days, change to RRE (refill request expired).
+52 IF MTYPE="RR"
IF ERXSTAT="RRN"
DO CHKEXP^PSOERX(ERXIEN,MTYPE)
+53 ; ChangeRequest messages will be checked for expiration status,
+54 ; but will not be displayed in the holding queue list view.
+55 IF MTYPE="CR"
IF ERXSTAT="CRN"
DO CHKEXP^PSOERX(ERXIEN,MTYPE)
+56 IF 'EPATIEN
SET EPATIEN=$$GETPAT^PSOERXU5(ERXIEN)
+57 ; If this is not a search, is a refill response, and is a response type of 'approved',
+58 ; do not show in the holding queue.
+59 IF '$$FILTERED^PSOERPC1("RX")
IF MTYPE="RE"
IF RESTYPE="A"
QUIT
+60 ; Do not display refill response with 'approved with changes' status in the holding queue.
+61 IF '$$FILTERED^PSOERPC1("RX")
IF MTYPE="RE"
IF "RXP,RXC,RXA,RRP,"[ERXSTAT
QUIT
+62 SET ERXQFLG=0
+63 IF MTYPE="RE"
IF RESTYPE="AWC"
Begin DoDot:1
+64 SET REQIEN=$$GETREQ^PSOERXU2(ERXIEN)
IF 'REQIEN
QUIT
+65 DO RRDELTA^PSOERXU2(.DELTA,REQIEN,ERXIEN)
+66 IF $DATA(DELTA(52.49,"EXTERNAL PROVIDER"))
QUIT
+67 SET ERXQFLG=1
End DoDot:1
if ERXQFLG
QUIT
+68 SET EPTNODE0=$GET(^PS(52.46,EPATIEN,0))
SET EPTNODE1=$GET(^PS(52.46,EPATIEN,1))
SET EPTNODE2=$GET(^PS(52.46,EPATIEN,2))
+69 SET PATNAME=$PIECE(EPTNODE0,"^")
IF PATNAME=""
SET PATNAME=$$PATNAME^PSOERUT(ERXIEN)
+70 SET DOB=$PIECE(EPTNODE1,"^",4)
+71 ;
+72 SET PROVIDER=+$GET(^PS(52.49,ERXIEN,2))
SET PROVIDER=$PIECE($GET(^PS(52.48,PROVIDER,0)),"^")
+73 IF PROVIDER=""
SET PROVIDER=$$GET1^DIQ(52.48,+$$GETPROV^PSOERXU5(ERXIEN),.01)
if PROVIDER=""
SET PROVIDER="N/A"
+74 SET CSGROUP=$SELECT('PSOCSGRP:"ALL",CSERX:"CS",1:"NON-CS")
+75 IF MTYPE="CR"
IF (ERXSTAT="CRE")
QUIT
+76 SET Z=""
SET $PIECE(Z,"^")=PATNAME
SET $PIECE(Z,"^",2)=$$FMTE^XLFDT(DOB,"2Z")
SET $PIECE(Z,"^",3)=EDRUG
SET $PIECE(Z,"^",4)=PROVIDER
+77 SET $PIECE(Z,"^",5)=ERXSTAT
SET $PIECE(Z,"^",6)=$$FMTE^XLFDT(MSGDT\1,"2Z")
+78 SET SORT=MSGDT_ERXIEN_" "
+79 IF FIELD="PA"
SET SORT=PATNAME_" "_ERXIEN
+80 IF FIELD="DOB"
SET SORT=DOB_" "_ERXIEN
+81 IF FIELD="DR"
SET SORT=$$UP^XLFSTR(EDRUG)_" "_ERXIEN
+82 IF FIELD="PR"
SET SORT=PROVIDER_" "_ERXIEN
+83 IF FIELD="RE"
SET SORT=MSGDT_" "_ERXIEN
+84 IF FIELD="STA"
SET SORT=ERXSTAT_" "_ERXIEN
+85 SET ^TMP("PSOERRXS",$JOB,CSGROUP,SORT)=Z
+86 SET ^TMP("PSOERRXS",$JOB,CSGROUP,SORT,"ERXIEN")=ERXIEN_"^"_$SELECT($GET(LOCKPATS(+EPATIEN)):1,1:0)
+87 SET ^TMP("PSOERINC",$JOB,ERXIEN)=""
+88 SET COUNTER=$GET(COUNTER)+1
+89 QUIT
+90 ;
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
