PSOERRX0 ;BIRM/MFR - All Rxs eRx Queue - ListManager ;08/28/22
;;7.0;OUTPATIENT PHARMACY;**700,746,770**;DEC 1997;Build 145
;
EN ; Entry point for the RX Action in the Patient Centric View
N STSFLTR,MATFLTR,REDTFLTR,PRVFLTR,DRGFLTR,MSTPFLTR,MTARR,PSODETDP,VDRGFLTR,STSRMARY,RESARY,DNDARY,RXREQARY
N STSFLTR1,MSTPFLTR1,REACODE,REASCODE,FLTRCHNG,MSTCHNG
S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
;
;Division selection
I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT
I '$G(PSNPINST) S PSNPINST=$$GET1^DIQ(59,PSOSITE,101,"I")
;
S MTARR("RR")="RXRENEWALREQUEST",MTARR("RE")="RXRENEWALRESPONSE",MTARR("N")="NEWRX(ALL)",MTARR("CR")="RXCHANGEREQUEST"
S MTARR("RXF")="RXFILL",MTARR("IE")="INBOUND ERROR",MTARR("OE")="OUTBOUND ERROR",MTARR("CA")="CANCELRX",MTARR("CN")="CANCELRXRESPONSE"
S MTARR("CX")="RXCHANGERESPONSE",MTARR("N")="NEWRX"
; Loading User's preferences
D LOAD^PSOERPR1
W !,"Please wait..."
D EN^VALM("PSO ERX ALL RXS QUEUE")
;
G EXIT
;
LMHDR ; ListMan Header Code
D SHOW^VALM,HDR^PSOERRX0
I $G(MBMSITE) S XQORM("B")="Next Screen"
S XQORM("#")=$O(^ORD(101,"B","PSO ERX ALL RXS SELECT",""))_"^1:"_VALMCNT
S XQORM("??")="D HELP^VALM2,HDR^PSOERRX0"
Q
;
HDR ; - Builds the Header section
D HDR^PSOERRX1
Q
;
INIT ;Populates the Body section for ListMan
N LOCKPATS,PAT
K ^TMP("PSOERRX0",$J),^TMP("PSOERRXS",$J)
S PAT=0 F S PAT=$O(^XTMP("PSOERXLOCK",PAT)) Q:'PAT S LOCKPATS(PAT)=+$G(^XTMP("PSOERXLOCK",PAT))
D SETSORT^PSOERRX1(PSOSRTBY),SETLINE
S:$G(VALMSG)="" VALMSG="Select the entry # to view or ?? for more actions"
Q
;
SETLINE ;Sets the line to be displayed in ListMan
N SORT,TYPE,STS,SUB,SEQ,LINE,Z,Z1,TOTAL,I,X,X1,ORDCNT,LBL,LN,GROUP,QTYL,ORNUM1,ERXIEN1,HIGHLN,SORTORD
N X,POS
K ^TMP("PSOERRX0",$J)
I '$D(^TMP("PSOERRXS",$J)) D Q
. F I=1:1:6 S ^TMP("PSOERRX0",$J,I,0)=""
. S ^TMP("PSOERRX0",$J,7,0)=" No prescriptions found."
. S VALMCNT=1
;
;Resetting list to NORMAL video attributes
D RESET^PSOERUT0() K GRPLN
;
;Building the list (line by line)
S (GROUP,SORT)="",(SEQ,LINE)=0,SORTORD=$S(PSORDER="A":1,1:-1)
F S GROUP=$O(^TMP("PSOERRXS",$J,GROUP)) Q:GROUP="" D
. I GROUP'="ALL" D
. . N LBL,POS,X
. . S LBL=$S(GROUP="NON-CS":"NON-",1:"")_"CONTROLLED SUBSTANCE Rx's"
. . S POS=41-($L(LBL)\2) S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL
. . S LINE=LINE+1,^TMP("PSOERRX0",$J,LINE,0)=X,GRPLN(LINE)=LBL
. F S SORT=$O(^TMP("PSOERRXS",$J,GROUP,SORT),SORTORD) Q:SORT="" D
. . S Z=$G(^TMP("PSOERRXS",$J,GROUP,SORT)),SEQ=SEQ+1
. . S Z1=$G(^TMP("PSOERRXS",$J,GROUP,SORT,"ERXIEN")),ERXIEN=+Z1
. . S X1=SEQ_$S(+$G(^PS(52.49,ERXIEN,95)):"]",1:".")
. . S $E(X1,$S(SEQ>999:6,1:5))=$E($P(Z,"^",1),1,$S(SEQ>999:19,1:20)),$E(X1,26)=$P(Z,"^",2)
. . I '$G(PSODETDP) S $E(X1,35)=$E($P(Z,"^",3),1,21)
. . I $G(MBMSITE),$E($P(Z,"^",5),1,3)="REM" S $P(Z,"^",5)="R"_$E($P(Z,"^",5),4,9)
. . S $E(X1,57)=$E($P(Z,"^",4),1,11),$E(X1,69)=$E($P(Z,"^",5),1,3),$E(X1,73)=$P(Z,"^",6)
. . S LINE=LINE+1,^TMP("PSOERRX0",$J,LINE,0)=X1,^TMP("PSOERRX0",$J,SEQ,"ERXIEN")=ERXIEN
. . I $P(Z1,"^",2) S HIGHLN(LINE)=1
. . I $G(PSODETDP) D SETDET^PSOERPT0(ERXIEN,.LINE,"PSOERRX0")
;
;Saving NORMAL video attributes to be reset later
I LINE>$G(LASTLINE) D
. F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
. S LASTLINE=LINE
D VIDEO^PSOERPT1()
S VALMCNT=+$G(LINE) D RV^PSOPMP1
Q
;
FLTRMT(MSGTYPE) ; Filter By Message Type Action
S MSTPFLTR=MSGTYPE
D REF S VALMBCK="R",VALMBG=1
Q
;
CS ;Group/Un-group Controlled Substances
S PSOCSGRP=$S($G(PSOCSGRP):0,1:1) D REF
Q
;
DET ;Display/Remove DET
S PSODETDP=$S($G(PSODETDP):0,1:1),LINE=0 D REF
I 'PSODETDP S VALMBG=VALMBG\2
I PSODETDP S VALMBG=VALMBG*2-1
S:VALMBG>(VALMCNT-10) VALMBG=VALMCNT-10 S:VALMBG<1 VALMBG=1
Q
;
CV ;Change View
D EN^PSOERPR1 I $G(PSORFRSH) D REF S VALMBG=1
S VALMBCK="R"
Q
;
SORT(FIELD) ;Sort entries by FIELD
I PSOSRTBY=FIELD S PSORDER=$S(PSORDER="A":"D",1:"A")
E S PSOSRTBY=FIELD,PSORDER="A"
D REF
Q
;
LBD ;Change Look Back Days Parameter Action
D FULL^VALM1 S VALMBCK="R"
W ! K DIR,DIRUT,DIROUT,SAVEX,DA
S DIR(0)="52.353,1",DIR("B")=PSOLKBKD
D ^DIR I $D(DIRUT)!$D(DIROUT) Q
S PSOLKBKD=Y,RESETLBD=0 D REF S VALMBG=1
Q
;
PC ;Patient Centri View Switch
D EN^PSOERPC0 S VALMBCK="Q"
Q
;
SEL ;Process selection of one entry
N PSOSEL,ERXIEN,ERXPTIEN
S VALMBCK="R"
S PSOSEL=+$P(XQORNOD(0),"=",2) I 'PSOSEL S VALMSG="Invalid selection!" Q
S ERXIEN=$G(^TMP("PSOERRX0",$J,PSOSEL,"ERXIEN")) I 'ERXIEN S VALMSG="Invalid selection!" Q
S ERXPTIEN=$$GETPAT^PSOERXU5(ERXIEN)
; - Locking the eRx Patient
I ERXPTIEN,'$$LOCK^PSOERPC1(ERXPTIEN) Q
; - Entering the eRx Record
D EN^PSOERX1(ERXIEN) K ERXIEN
; - Unlocking the eRx Patient
I ERXPTIEN D UL^PSOERX1A(ERXPTIEN)
I $G(PSORFRSH) D REF
Q
;
SQ ; - Search Queue Entry Point
D FULL^VALM1 S VALMBCK="R"
N DIR,DUOUT,DIRUT,Y,X,CHANGE,ERXLOCK,ERXPTIEN,PSOFPICK
S CHANGE=0
REP ; Re-Entry Point
K DIR S DIR("?",1)="Choose one or multiple filter criteria(s) to sort the current list."
S DIR("?",2)="To remove an existing filter type ^#, where '#' is the filter number below."
S DIR("?")=" "
S DIR("A")="SEARCH BY"
S DIR(0)="SO^1:ERX PATIENT" I $D(PATFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$EPATFLST^PSOERUT(44)_")"_IOINORM
S DIR(0)=DIR(0)_";2:ERX DATE OF BIRTH" I $G(DOBFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$FMTE^XLFDT(DOBFLTR,"2Z")_")"_IOINORM
S DIR(0)=DIR(0)_";3:RECEIVED DATE RANGE" I $G(REDTFLTR) S DIR(0)=DIR(0)_IOINHI_" ("_$$FMTE^XLFDT(+REDTFLTR,"2Z")_" TO "_$$FMTE^XLFDT($P(REDTFLTR,"^",2),"2Z")_")"_IOINORM
S DIR(0)=DIR(0)_";4:ERX PROVIDER" I $D(PRVFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$EPRVFLST^PSOERUT(44)_")"_IOINORM
S DIR(0)=DIR(0)_";5:ERX STATUS" I $G(STSFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$S($G(STSFLTR1)'="":STSFLTR1,1:$$GET1^DIQ(52.45,+STSFLTR,.01))_")"_IOINORM
S DIR(0)=DIR(0)_";6:ERX DRUG NAME" I $G(DRGFLTR)'="" S DIR(0)=DIR(0)_" "_IOINHI_"('"_DRGFLTR_"')"_IOINORM
S DIR(0)=DIR(0)_";7:MESSAGE TYPE" I $G(MSTPFLTR)'="" S DIR(0)=DIR(0)_" "_IOINHI_"("_$S($G(MSTPFLTR1)'="":MSTPFLTR1,1:MTARR(MSTPFLTR))_")"_IOINORM
S DIR(0)=DIR(0)_";8:ERX REFERENCE NUMBER"
S DIR(0)=DIR(0)_";9:VISTA RX #"
S DIR(0)=DIR(0)_";10:VISTA PATIENT" I $D(VPATFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$VPATFLST^PSOERUT(44)_")"_IOINORM
S DIR(0)=DIR(0)_";11:VISTA PROVIDER" I $D(VPRVFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$VPRVFLST^PSOERUT(44)_")"_IOINORM
S DIR(0)=DIR(0)_";12:MATCH STATUS" I $G(MATFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$MATCHLBL^PSOERPC2(MATFLTR)_")"_IOINORM
S DIR(0)=DIR(0)_";13:VISTA DRUG" I $G(VDRGFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$E($$GET1^DIQ(50,VDRGFLTR,.01),1,44)_")"_IOINORM
D ^DIR
I X'="^",X?1"^".N D G REP
. K:X="^1" PATFLTR,VPATFLTR K:X="^2" DOBFLTR K:X="^3" REDTFLTR K:X="^4" PRVFLTR,VPRVFLTR K:X="^5" STSFLTR,STSFLTR1
. K:X="^6" DRGFLTR K:X="^7" MSTPFLTR,MSTPFLTR1 K:X="^10" PATFLTR,VPATFLTR K:X="^11" PRVFLTR,VPRVFLTR K:X="^12" MATFLTR K:X="^13" VDRGFLTR
. S CHANGE=1
I X=""!$D(DUOUT)!($D(DIRUT)) D:CHANGE REF S:CHANGE VALMBG=1 Q
S PSOFPICK=+$G(Y)
I PSOFPICK=1 D EPATFLTR^PSOERPC0 S PSOALLST=1,CHANGE=1 G REP
I PSOFPICK=2 D DOBFLTR^PSOERPC0 S PSOALLST=1,CHANGE=1 G REP
I PSOFPICK=3 D REDTFLTR S CHANGE=1 G REP
I PSOFPICK=4 D PRVFLTR S PSOALLST=1,CHANGE=1 G REP
I PSOFPICK=5 D STSFLTR S CHANGE=1 G REP
I PSOFPICK=6 D DRGFLTR S PSOALLST=1,CHANGE=1 G REP
I PSOFPICK=7 D MSTPFLTR S CHANGE=1 G REP
I PSOFPICK=8 D ERXFLTR^PSOERPC0 G:'$G(ERXFLTR) REP D I '$G(CHANGE) Q
. ; - Entering the eRx Record
. D EN^PSOERX1(ERXFLTR)
. ; - Unlocking the eRx Patient
. S ERXPTIEN=$$GET1^DIQ(52.49,ERXFLTR,.04,"I") Q:'ERXPTIEN
. D UL^PSOERX1A(ERXPTIEN)
. S CHANGE=1
I PSOFPICK=9 D RXFLTR^PSOERPC0 G:'$G(ERXFLTR) REP D I '$G(CHANGE) Q
. ; - Entering the eRx Record
. D EN^PSOERX1(ERXFLTR)
. ; - Unlocking the eRx Patient
. S ERXPTIEN=$$GET1^DIQ(52.49,ERXFLTR,.04,"I") Q:'ERXPTIEN
. D UL^PSOERX1A(ERXPTIEN)
. S CHANGE=1
I PSOFPICK=10 D VPATFLTR^PSOERPC0 S PSOALLST=1,CHANGE=1 G REP
I PSOFPICK=11 D VPRVFLTR^PSOERRX1 S PSOALLST=1,CHANGE=1 G REP
I PSOFPICK=12 D MATFLTR^PSOERPC0 S CHANGE=1 G REP
I PSOFPICK=13 D VDRGFLTR^PSOERRX1 S PSOALLST=1,CHANGE=1 G REP
D REF S VALMBG=1
Q
;
REDTFLTR ; - Received Date Range Filter
N %DT,PSOFROM,PSOTO,Y,DTOUT,DIROUT
S %DT(0)=-DT,%DT="AEP",%DT("A")="BEGIN DATE: "
S %DT("B")="T-45" I $P($G(REDTFLTR),"^") S %DT("B")=$$FMTE^XLFDT($P($G(REDTFLTR),"^"),"5Z")
W ! D ^%DT I Y<0!($D(DTOUT)) Q
S PSOFROM=Y\1
;
K %DT S %DT(0)=PSOFROM\1,%DT="AEP",%DT("A")="END DATE: "
S %DT("B")="TODAY" I $P($G(REDTFLTR),"^",2) S %DT("B")=$$FMTE^XLFDT($P($G(REDTFLTR),"^",2),"5Z")
W ! D ^%DT I Y<0!($D(DTOUT)) Q
S PSOTO=Y\1
;
S REDTFLTR=PSOFROM_"^"_PSOTO
Q
;
PRVFLTR ; - eRx Provider Filter
N DIR,PRV,XX,PRVLST,RANGE,COMSEG,I,J,DIRUT,DIROUT,QUIT
S DIR(0)="F^3:30",DIR("A")="ERX PROVIDER NAME"
W ! D ^DIR I $D(DIRUT)!$D(DIROUT) Q
D FIND^DIC(52.48,"","@;.01;1.5;1.6;4.3;4.4;IX","",X,,"B","","","PRVLST")
I '$D(PRVLST("DILIST",2)) W !,"No eRx Provider found" K PRVLST G PRVFLTR
;
W !!,"#",?4,"ERX PROVIDER NAME",?35,"NPI",?48,"CITY",?68,"STATE"
S (QUIT,CNT)=0,$P(XX,"-",80)="" W !,XX 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,1.5)
. W ?48,$E(PRVLST("DILIST","ID",PRV,4.3),1,20),?68,$$STATEABB^PSOERUT(52.48,PRVLST("DILIST",2,PRV))
. 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,!,"#",?4,"ERX PROVIDER NAME",?35,"NPI",?48,"CITY",?68,"STATE",!,XX
;
I CNT=1 K PRVFLTR S PRVFLTR(PRVLST("DILIST",2,1))="" Q
;
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 PRVFLTR
S RANGE=X
;
K 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
. . I '$D(PRVLST("DILIST",2,J)) Q
. . S PRVFLTR(PRVLST("DILIST",2,J))=""
Q
;
MSTPFLTR ; - Message Type Filter
N PARENT
K DIR,DIRUT,DIROUT,X,Y,RESARY,MSTCODE,II,DNDARY,RXREQARY
W ! S DIR(0)="52.49,.08" S:$G(MSTPFLTR)'="" DIR("B")=MSTPFLTR
D ^DIR I $D(DIRUT)!$D(DIROUT) Q
S MSTPFLTR=Y
I (" RE CX CR "'[(" "_MSTPFLTR_" ")) K MSTPFLTR1 Q
S PARENT=MSTPFLTR
K DIR,X,Y W !
I MSTPFLTR="CR" D REQCODE^PSOERRX2(MTARR(MSTPFLTR)) Q ;prompt user the rxchangerequest code
S DIR("A")="RESPONSE TYPE: "
I $G(MSTCHNG)'=PARENT S $P(MSTPFLTR1,"/",2)=""
S DIR("B")=$S($P($G(MSTPFLTR1),"/",2)'="":$P(MSTPFLTR1,"/",2),1:"ALL")
S MSTCODE=$$GET1^DID(52.49,52.1,,"SET OF CODES",,"PSOERR")
S $E(MSTCODE,$L(MSTCODE))=""
S DIR(0)="SAO^ALL:ALL;"
S DIR("?")="Enter a response type from the list."
S DIR("??")=DIR("?")
F II=1:1:$L(MSTCODE,";") Q:$P(MSTCODE,";",II)="" D
. I MSTPFLTR="RE",$P(MSTCODE,";",II)["VALIDATED" Q
. I MSTPFLTR="CX",($P(MSTCODE,";",II)["REPLACE")!($P(MSTCODE,";",II)["DNP") Q
. S RESARY($P($P(MSTCODE,";",II),":"))=$P(MSTCODE,";",II)
S II="" F S II=$O(RESARY(II)) Q:II="" S DIR(0)=DIR(0)_RESARY(II)_";"
D ^DIR I $D(DIRUT)!$D(DIROUT) K MSTPFLTR,MSTPFLTR1 Q
I Y'="ALL" D
. S II="" F S II=$O(RESARY(II)) Q:II="" D
. . I Y'=II K RESARY(II)
S MSTPFLTR=PARENT
S MSTPFLTR1=MTARR(MSTPFLTR)_"/"_$S($G(Y)="ALL":"ALL",1:$P($G(RESARY(Y)),":",2))
I Y="D" D ADDFLTR^PSOERRX2($G(Y),$G(MSTPFLTR1)) ;prompt the user the associated denied reason user wanted to see
S MSTCHNG=PARENT
Q
;
STSFLTR ; - eRx Status Filter
; prompt for erx status
N DIC,X,Y,DTOUT,DUOUT,PARENT,DIRUT,DIROUT,SCREEN,DIR
I $G(STSFLTR) S DIC("B")=$$GET1^DIQ(52.45,STSFLTR,.01)
S DIC("A")="ERX STATUS: ",DIC=52.45,DIC(0)="AEQ",DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y))"
; MbM Sites only - Allow selection of Removed Reasons as Status
I $G(MBMSITE) S DIC("S")=DIC("S")_"!$D(^PS(52.45,""TYPE"",""REM"",Y))"
W ! D ^DIC I Y<1 Q
S STSFLTR=+Y
S PARENT=$P(Y,"^",2)
I (" RM RJ "'[(" "_PARENT_" ")) K STSFLTR1 Q
ASKAGAIN ;
W ! K X,Y,DIC("A")
S DIR(0)="52.45,.01:AOZ"
S DIR("A")=$S(PARENT="RM":"REMOVAL",1:"REJECT")_" REASON CODE: "
S SCREEN="I $D(^PS(52.45,""TYPE"""_","""_$S(PARENT="RM":"REM",1:"REJ")_""",Y))"
S DIR("?")="^S DIC=""^PS(52.45,"",DIC(0)=""EQ"",DIC(""S"")=SCREEN D ^DIC"
S DIR("??")=DIR("?")
I $G(FLTRCHNG)'=PARENT S $P(STSFLTR1,"/",2)=""
S DIR("B")=$S($P($G(STSFLTR1),"/",2)'="":$P(STSFLTR1,"/",2),1:"ALL")
D ^DIR
I $D(DIRUT)!$D(DIROUT)!$D(DUOUT) K STSFLTR,STSFLTR1 Q
K STSRMARY
I $G(Y)="ALL" D Q
. M STSRMARY=^PS(52.45,"TYPE",$S(PARENT="RM":"REM",1:"REJ"))
. S STSFLTR1=$G(PARENT)_"/"_$S($G(Y)="ALL":"ALL",1:"")
. S FLTRCHNG=PARENT
S DIC(0)="EQ"
S DIC("S")=SCREEN
S DIC("B")=DIR("B")
D ^DIC
I +Y<1 K DIR G ASKAGAIN
S STSRMARY(+$G(Y))=^PS(52.45,"TYPE",$S(PARENT="RM":"REM",1:"REJ"),+Y)
S STSFLTR1=$G(PARENT)_"/"_$$GET1^DIQ(52.45,+Y,.01)
S FLTRCHNG=PARENT
Q
;
DRGFLTR ; - eRx Drug Name Filter
N DIR,X,Y,DIRUT,DIROUT
S DIR(0)="F^3:30",DIR("A")="ERX DRUG NAME"
W ! D ^DIR I $D(DIRUT)!$D(DIROUT) Q
S DRGFLTR=Y
Q
;
RAF ; Remove All Filters
K PATFLTR,VPATFLTR,DOBFLTR,REDTFLTR,PRVFLTR,VPRVFLTR,STSFLTR,STSFLTR1,MSTPFLTR,MSTPFLTR1,DRGFLTR,MATFLTR,VDRGFLTR,STSRMARY,RESARY,DNDARY,FLTRCHNG,REASCODE,MSTCHNG,REASCODE
D REF S VALMBG=1
Q
;
REF ;Screen Refresh
W ?52,"Please wait..." D INIT,HDR S VALMBCK="R"
Q
;
;
IAS ;Include All Status Switch
W ?52,"Please wait..." S PSOALLST=$S($G(PSOALLST):0,1:1),LINE=0 D REF
I 'PSOALLST S VALMBG=1
Q
;
;
J2EP(DFN) ; Jump to eRx Patient (From Backdoor)
;Input: DFN - Pointer to the PATIENT file (#2)
N PSOALLST,PSNPINST,MBMSITE,PSOCLNC,PSOJUMP,EPAT,VPATFLTR,PATFLTR
S DFN=+$G(DFN),VALMBCK="R",PSOJUMP=1,MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0) S:MBMSITE PSOALLST=1
I '$O(^PS(52.49,"AVPAT",DFN,0)) D Q
. S VALMSG="No corresponding eRx Patient found" W $C(7)
S PSNPINST=$$GET1^DIQ(59,+$G(PSOSITE),101,"I")
S PSOCLNC=+$$GET1^DIQ(59,PSOSITE,10,"I")
S VPATFLTR(DFN)="",PSOSTFLT="A"
S EPAT=0 F S EPAT=$O(^PS(52.49,"AVPAT",+DFN,EPAT)) Q:'EPAT D
. S PATFLTR(EPAT)=""
D EN
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ;
K ^TMP("PSOERRX0",$J),^TMP("PSOERRXS",$J)
D FULL^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERRX0 14530 printed Aug 26, 2025@22:43:57 Page 2
PSOERRX0 ;BIRM/MFR - All Rxs eRx Queue - ListManager ;08/28/22
+1 ;;7.0;OUTPATIENT PHARMACY;**700,746,770**;DEC 1997;Build 145
+2 ;
EN ; Entry point for the RX Action in the Patient Centric View
+1 NEW STSFLTR,MATFLTR,REDTFLTR,PRVFLTR,DRGFLTR,MSTPFLTR,MTARR,PSODETDP,VDRGFLTR,STSRMARY,RESARY,DNDARY,RXREQARY
+2 NEW STSFLTR1,MSTPFLTR1,REACODE,REASCODE,FLTRCHNG,MSTCHNG
+3 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
+4 ;
+5 ;Division selection
+6 IF '$GET(PSOSITE)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
GOTO EXIT
+7 IF '$GET(PSNPINST)
SET PSNPINST=$$GET1^DIQ(59,PSOSITE,101,"I")
+8 ;
+9 SET MTARR("RR")="RXRENEWALREQUEST"
SET MTARR("RE")="RXRENEWALRESPONSE"
SET MTARR("N")="NEWRX(ALL)"
SET MTARR("CR")="RXCHANGEREQUEST"
+10 SET MTARR("RXF")="RXFILL"
SET MTARR("IE")="INBOUND ERROR"
SET MTARR("OE")="OUTBOUND ERROR"
SET MTARR("CA")="CANCELRX"
SET MTARR("CN")="CANCELRXRESPONSE"
+11 SET MTARR("CX")="RXCHANGERESPONSE"
SET MTARR("N")="NEWRX"
+12 ; Loading User's preferences
+13 DO LOAD^PSOERPR1
+14 WRITE !,"Please wait..."
+15 DO EN^VALM("PSO ERX ALL RXS QUEUE")
+16 ;
+17 GOTO EXIT
+18 ;
LMHDR ; ListMan Header Code
+1 DO SHOW^VALM
DO HDR^PSOERRX0
+2 IF $GET(MBMSITE)
SET XQORM("B")="Next Screen"
+3 SET XQORM("#")=$ORDER(^ORD(101,"B","PSO ERX ALL RXS SELECT",""))_"^1:"_VALMCNT
+4 SET XQORM("??")="D HELP^VALM2,HDR^PSOERRX0"
+5 QUIT
+6 ;
HDR ; - Builds the Header section
+1 DO HDR^PSOERRX1
+2 QUIT
+3 ;
INIT ;Populates the Body section for ListMan
+1 NEW LOCKPATS,PAT
+2 KILL ^TMP("PSOERRX0",$JOB),^TMP("PSOERRXS",$JOB)
+3 SET PAT=0
FOR
SET PAT=$ORDER(^XTMP("PSOERXLOCK",PAT))
if 'PAT
QUIT
SET LOCKPATS(PAT)=+$GET(^XTMP("PSOERXLOCK",PAT))
+4 DO SETSORT^PSOERRX1(PSOSRTBY)
DO SETLINE
+5 if $GET(VALMSG)=""
SET VALMSG="Select the entry # to view or ?? for more actions"
+6 QUIT
+7 ;
SETLINE ;Sets the line to be displayed in ListMan
+1 NEW SORT,TYPE,STS,SUB,SEQ,LINE,Z,Z1,TOTAL,I,X,X1,ORDCNT,LBL,LN,GROUP,QTYL,ORNUM1,ERXIEN1,HIGHLN,SORTORD
+2 NEW X,POS
+3 KILL ^TMP("PSOERRX0",$JOB)
+4 IF '$DATA(^TMP("PSOERRXS",$JOB))
Begin DoDot:1
+5 FOR I=1:1:6
SET ^TMP("PSOERRX0",$JOB,I,0)=""
+6 SET ^TMP("PSOERRX0",$JOB,7,0)=" No prescriptions found."
+7 SET VALMCNT=1
End DoDot:1
QUIT
+8 ;
+9 ;Resetting list to NORMAL video attributes
+10 DO RESET^PSOERUT0()
KILL GRPLN
+11 ;
+12 ;Building the list (line by line)
+13 SET (GROUP,SORT)=""
SET (SEQ,LINE)=0
SET SORTORD=$SELECT(PSORDER="A":1,1:-1)
+14 FOR
SET GROUP=$ORDER(^TMP("PSOERRXS",$JOB,GROUP))
if GROUP=""
QUIT
Begin DoDot:1
+15 IF GROUP'="ALL"
Begin DoDot:2
+16 NEW LBL,POS,X
+17 SET LBL=$SELECT(GROUP="NON-CS":"NON-",1:"")_"CONTROLLED SUBSTANCE Rx's"
+18 SET POS=41-($LENGTH(LBL)\2)
SET X=""
SET $PIECE(X," ",81)=""
SET $EXTRACT(X,POS,POS-1+$LENGTH(LBL))=LBL
+19 SET LINE=LINE+1
SET ^TMP("PSOERRX0",$JOB,LINE,0)=X
SET GRPLN(LINE)=LBL
End DoDot:2
+20 FOR
SET SORT=$ORDER(^TMP("PSOERRXS",$JOB,GROUP,SORT),SORTORD)
if SORT=""
QUIT
Begin DoDot:2
+21 SET Z=$GET(^TMP("PSOERRXS",$JOB,GROUP,SORT))
SET SEQ=SEQ+1
+22 SET Z1=$GET(^TMP("PSOERRXS",$JOB,GROUP,SORT,"ERXIEN"))
SET ERXIEN=+Z1
+23 SET X1=SEQ_$SELECT(+$GET(^PS(52.49,ERXIEN,95)):"]",1:".")
+24 SET $EXTRACT(X1,$SELECT(SEQ>999:6,1:5))=$EXTRACT($PIECE(Z,"^",1),1,$SELECT(SEQ>999:19,1:20))
SET $EXTRACT(X1,26)=$PIECE(Z,"^",2)
+25 IF '$GET(PSODETDP)
SET $EXTRACT(X1,35)=$EXTRACT($PIECE(Z,"^",3),1,21)
+26 IF $GET(MBMSITE)
IF $EXTRACT($PIECE(Z,"^",5),1,3)="REM"
SET $PIECE(Z,"^",5)="R"_$EXTRACT($PIECE(Z,"^",5),4,9)
+27 SET $EXTRACT(X1,57)=$EXTRACT($PIECE(Z,"^",4),1,11)
SET $EXTRACT(X1,69)=$EXTRACT($PIECE(Z,"^",5),1,3)
SET $EXTRACT(X1,73)=$PIECE(Z,"^",6)
+28 SET LINE=LINE+1
SET ^TMP("PSOERRX0",$JOB,LINE,0)=X1
SET ^TMP("PSOERRX0",$JOB,SEQ,"ERXIEN")=ERXIEN
+29 IF $PIECE(Z1,"^",2)
SET HIGHLN(LINE)=1
+30 IF $GET(PSODETDP)
DO SETDET^PSOERPT0(ERXIEN,.LINE,"PSOERRX0")
End DoDot:2
End DoDot:1
+31 ;
+32 ;Saving NORMAL video attributes to be reset later
+33 IF LINE>$GET(LASTLINE)
Begin DoDot:1
+34 FOR I=($GET(LASTLINE)+1):1:LINE
DO SAVE^VALM10(I)
+35 SET LASTLINE=LINE
End DoDot:1
+36 DO VIDEO^PSOERPT1()
+37 SET VALMCNT=+$GET(LINE)
DO RV^PSOPMP1
+38 QUIT
+39 ;
FLTRMT(MSGTYPE) ; Filter By Message Type Action
+1 SET MSTPFLTR=MSGTYPE
+2 DO REF
SET VALMBCK="R"
SET VALMBG=1
+3 QUIT
+4 ;
CS ;Group/Un-group Controlled Substances
+1 SET PSOCSGRP=$SELECT($GET(PSOCSGRP):0,1:1)
DO REF
+2 QUIT
+3 ;
DET ;Display/Remove DET
+1 SET PSODETDP=$SELECT($GET(PSODETDP):0,1:1)
SET LINE=0
DO REF
+2 IF 'PSODETDP
SET VALMBG=VALMBG\2
+3 IF PSODETDP
SET VALMBG=VALMBG*2-1
+4 if VALMBG>(VALMCNT-10)
SET VALMBG=VALMCNT-10
if VALMBG<1
SET VALMBG=1
+5 QUIT
+6 ;
CV ;Change View
+1 DO EN^PSOERPR1
IF $GET(PSORFRSH)
DO REF
SET VALMBG=1
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
SORT(FIELD) ;Sort entries by FIELD
+1 IF PSOSRTBY=FIELD
SET PSORDER=$SELECT(PSORDER="A":"D",1:"A")
+2 IF '$TEST
SET PSOSRTBY=FIELD
SET PSORDER="A"
+3 DO REF
+4 QUIT
+5 ;
LBD ;Change Look Back Days Parameter Action
+1 DO FULL^VALM1
SET VALMBCK="R"
+2 WRITE !
KILL DIR,DIRUT,DIROUT,SAVEX,DA
+3 SET DIR(0)="52.353,1"
SET DIR("B")=PSOLKBKD
+4 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+5 SET PSOLKBKD=Y
SET RESETLBD=0
DO REF
SET VALMBG=1
+6 QUIT
+7 ;
PC ;Patient Centri View Switch
+1 DO EN^PSOERPC0
SET VALMBCK="Q"
+2 QUIT
+3 ;
SEL ;Process selection of one entry
+1 NEW PSOSEL,ERXIEN,ERXPTIEN
+2 SET VALMBCK="R"
+3 SET PSOSEL=+$PIECE(XQORNOD(0),"=",2)
IF 'PSOSEL
SET VALMSG="Invalid selection!"
QUIT
+4 SET ERXIEN=$GET(^TMP("PSOERRX0",$JOB,PSOSEL,"ERXIEN"))
IF 'ERXIEN
SET VALMSG="Invalid selection!"
QUIT
+5 SET ERXPTIEN=$$GETPAT^PSOERXU5(ERXIEN)
+6 ; - Locking the eRx Patient
+7 IF ERXPTIEN
IF '$$LOCK^PSOERPC1(ERXPTIEN)
QUIT
+8 ; - Entering the eRx Record
+9 DO EN^PSOERX1(ERXIEN)
KILL ERXIEN
+10 ; - Unlocking the eRx Patient
+11 IF ERXPTIEN
DO UL^PSOERX1A(ERXPTIEN)
+12 IF $GET(PSORFRSH)
DO REF
+13 QUIT
+14 ;
SQ ; - Search Queue Entry Point
+1 DO FULL^VALM1
SET VALMBCK="R"
+2 NEW DIR,DUOUT,DIRUT,Y,X,CHANGE,ERXLOCK,ERXPTIEN,PSOFPICK
+3 SET CHANGE=0
REP ; Re-Entry Point
+1 KILL DIR
SET DIR("?",1)="Choose one or multiple filter criteria(s) to sort the current list."
+2 SET DIR("?",2)="To remove an existing filter type ^#, where '#' is the filter number below."
+3 SET DIR("?")=" "
+4 SET DIR("A")="SEARCH BY"
+5 SET DIR(0)="SO^1:ERX PATIENT"
IF $DATA(PATFLTR)
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$$EPATFLST^PSOERUT(44)_")"_IOINORM
+6 SET DIR(0)=DIR(0)_";2:ERX DATE OF BIRTH"
IF $GET(DOBFLTR)
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$$FMTE^XLFDT(DOBFLTR,"2Z")_")"_IOINORM
+7 SET DIR(0)=DIR(0)_";3:RECEIVED DATE RANGE"
IF $GET(REDTFLTR)
SET DIR(0)=DIR(0)_IOINHI_" ("_$$FMTE^XLFDT(+REDTFLTR,"2Z")_" TO "_$$FMTE^XLFDT($PIECE(REDTFLTR,"^",2),"2Z")_")"_IOINORM
+8 SET DIR(0)=DIR(0)_";4:ERX PROVIDER"
IF $DATA(PRVFLTR)
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$$EPRVFLST^PSOERUT(44)_")"_IOINORM
+9 SET DIR(0)=DIR(0)_";5:ERX STATUS"
IF $GET(STSFLTR)
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$SELECT($GET(STSFLTR1)'="":STSFLTR1,1:$$GET1^DIQ(52.45,+STSFLTR,.01))_")"_IOINORM
+10 SET DIR(0)=DIR(0)_";6:ERX DRUG NAME"
IF $GET(DRGFLTR)'=""
SET DIR(0)=DIR(0)_" "_IOINHI_"('"_DRGFLTR_"')"_IOINORM
+11 SET DIR(0)=DIR(0)_";7:MESSAGE TYPE"
IF $GET(MSTPFLTR)'=""
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$SELECT($GET(MSTPFLTR1)'="":MSTPFLTR1,1:MTARR(MSTPFLTR))_")"_IOINORM
+12 SET DIR(0)=DIR(0)_";8:ERX REFERENCE NUMBER"
+13 SET DIR(0)=DIR(0)_";9:VISTA RX #"
+14 SET DIR(0)=DIR(0)_";10:VISTA PATIENT"
IF $DATA(VPATFLTR)
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$$VPATFLST^PSOERUT(44)_")"_IOINORM
+15 SET DIR(0)=DIR(0)_";11:VISTA PROVIDER"
IF $DATA(VPRVFLTR)
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$$VPRVFLST^PSOERUT(44)_")"_IOINORM
+16 SET DIR(0)=DIR(0)_";12:MATCH STATUS"
IF $GET(MATFLTR)
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$$MATCHLBL^PSOERPC2(MATFLTR)_")"_IOINORM
+17 SET DIR(0)=DIR(0)_";13:VISTA DRUG"
IF $GET(VDRGFLTR)
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$EXTRACT($$GET1^DIQ(50,VDRGFLTR,.01),1,44)_")"_IOINORM
+18 DO ^DIR
+19 IF X'="^"
IF X?1"^".N
Begin DoDot:1
+20 if X="^1"
KILL PATFLTR,VPATFLTR
if X="^2"
KILL DOBFLTR
if X="^3"
KILL REDTFLTR
if X="^4"
KILL PRVFLTR,VPRVFLTR
if X="^5"
KILL STSFLTR,STSFLTR1
+21 if X="^6"
KILL DRGFLTR
if X="^7"
KILL MSTPFLTR,MSTPFLTR1
if X="^10"
KILL PATFLTR,VPATFLTR
if X="^11"
KILL PRVFLTR,VPRVFLTR
if X="^12"
KILL MATFLTR
if X="^13"
KILL VDRGFLTR
+22 SET CHANGE=1
End DoDot:1
GOTO REP
+23 IF X=""!$DATA(DUOUT)!($DATA(DIRUT))
if CHANGE
DO REF
if CHANGE
SET VALMBG=1
QUIT
+24 SET PSOFPICK=+$GET(Y)
+25 IF PSOFPICK=1
DO EPATFLTR^PSOERPC0
SET PSOALLST=1
SET CHANGE=1
GOTO REP
+26 IF PSOFPICK=2
DO DOBFLTR^PSOERPC0
SET PSOALLST=1
SET CHANGE=1
GOTO REP
+27 IF PSOFPICK=3
DO REDTFLTR
SET CHANGE=1
GOTO REP
+28 IF PSOFPICK=4
DO PRVFLTR
SET PSOALLST=1
SET CHANGE=1
GOTO REP
+29 IF PSOFPICK=5
DO STSFLTR
SET CHANGE=1
GOTO REP
+30 IF PSOFPICK=6
DO DRGFLTR
SET PSOALLST=1
SET CHANGE=1
GOTO REP
+31 IF PSOFPICK=7
DO MSTPFLTR
SET CHANGE=1
GOTO REP
+32 IF PSOFPICK=8
DO ERXFLTR^PSOERPC0
if '$GET(ERXFLTR)
GOTO REP
Begin DoDot:1
+33 ; - Entering the eRx Record
+34 DO EN^PSOERX1(ERXFLTR)
+35 ; - Unlocking the eRx Patient
+36 SET ERXPTIEN=$$GET1^DIQ(52.49,ERXFLTR,.04,"I")
if 'ERXPTIEN
QUIT
+37 DO UL^PSOERX1A(ERXPTIEN)
+38 SET CHANGE=1
End DoDot:1
IF '$GET(CHANGE)
QUIT
+39 IF PSOFPICK=9
DO RXFLTR^PSOERPC0
if '$GET(ERXFLTR)
GOTO REP
Begin DoDot:1
+40 ; - Entering the eRx Record
+41 DO EN^PSOERX1(ERXFLTR)
+42 ; - Unlocking the eRx Patient
+43 SET ERXPTIEN=$$GET1^DIQ(52.49,ERXFLTR,.04,"I")
if 'ERXPTIEN
QUIT
+44 DO UL^PSOERX1A(ERXPTIEN)
+45 SET CHANGE=1
End DoDot:1
IF '$GET(CHANGE)
QUIT
+46 IF PSOFPICK=10
DO VPATFLTR^PSOERPC0
SET PSOALLST=1
SET CHANGE=1
GOTO REP
+47 IF PSOFPICK=11
DO VPRVFLTR^PSOERRX1
SET PSOALLST=1
SET CHANGE=1
GOTO REP
+48 IF PSOFPICK=12
DO MATFLTR^PSOERPC0
SET CHANGE=1
GOTO REP
+49 IF PSOFPICK=13
DO VDRGFLTR^PSOERRX1
SET PSOALLST=1
SET CHANGE=1
GOTO REP
+50 DO REF
SET VALMBG=1
+51 QUIT
+52 ;
REDTFLTR ; - Received Date Range Filter
+1 NEW %DT,PSOFROM,PSOTO,Y,DTOUT,DIROUT
+2 SET %DT(0)=-DT
SET %DT="AEP"
SET %DT("A")="BEGIN DATE: "
+3 SET %DT("B")="T-45"
IF $PIECE($GET(REDTFLTR),"^")
SET %DT("B")=$$FMTE^XLFDT($PIECE($GET(REDTFLTR),"^"),"5Z")
+4 WRITE !
DO ^%DT
IF Y<0!($DATA(DTOUT))
QUIT
+5 SET PSOFROM=Y\1
+6 ;
+7 KILL %DT
SET %DT(0)=PSOFROM\1
SET %DT="AEP"
SET %DT("A")="END DATE: "
+8 SET %DT("B")="TODAY"
IF $PIECE($GET(REDTFLTR),"^",2)
SET %DT("B")=$$FMTE^XLFDT($PIECE($GET(REDTFLTR),"^",2),"5Z")
+9 WRITE !
DO ^%DT
IF Y<0!($DATA(DTOUT))
QUIT
+10 SET PSOTO=Y\1
+11 ;
+12 SET REDTFLTR=PSOFROM_"^"_PSOTO
+13 QUIT
+14 ;
PRVFLTR ; - eRx Provider Filter
+1 NEW DIR,PRV,XX,PRVLST,RANGE,COMSEG,I,J,DIRUT,DIROUT,QUIT
+2 SET DIR(0)="F^3:30"
SET DIR("A")="ERX PROVIDER NAME"
+3 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+4 DO FIND^DIC(52.48,"","@;.01;1.5;1.6;4.3;4.4;IX","",X,,"B","","","PRVLST")
+5 IF '$DATA(PRVLST("DILIST",2))
WRITE !,"No eRx Provider found"
KILL PRVLST
GOTO PRVFLTR
+6 ;
+7 WRITE !!,"#",?4,"ERX PROVIDER NAME",?35,"NPI",?48,"CITY",?68,"STATE"
+8 SET (QUIT,CNT)=0
SET $PIECE(XX,"-",80)=""
WRITE !,XX
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,1.5)
+11 WRITE ?48,$EXTRACT(PRVLST("DILIST","ID",PRV,4.3),1,20),?68,$$STATEABB^PSOERUT(52.48,PRVLST("DILIST",2,PRV))
+12 SET CNT=CNT+1
+13 IF CNT>18
IF $ORDER(PRVLST("DILIST","ID",PRV))
IF $Y>(IOSL-4)
Begin DoDot:2
+14 KILL DIR
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
SET QUIT=1
QUIT
+15 WRITE @IOF,!,"#",?4,"ERX PROVIDER NAME",?35,"NPI",?48,"CITY",?68,"STATE",!,XX
End DoDot:2
End DoDot:1
IF QUIT
QUIT
+16 ;
+17 IF CNT=1
KILL PRVFLTR
SET PRVFLTR(PRVLST("DILIST",2,1))=""
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 PRVFLTR
+21 SET RANGE=X
+22 ;
+23 KILL 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 IF '$DATA(PRVLST("DILIST",2,J))
QUIT
+28 SET PRVFLTR(PRVLST("DILIST",2,J))=""
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
MSTPFLTR ; - Message Type Filter
+1 NEW PARENT
+2 KILL DIR,DIRUT,DIROUT,X,Y,RESARY,MSTCODE,II,DNDARY,RXREQARY
+3 WRITE !
SET DIR(0)="52.49,.08"
if $GET(MSTPFLTR)'=""
SET DIR("B")=MSTPFLTR
+4 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+5 SET MSTPFLTR=Y
+6 IF (" RE CX CR "'[(" "_MSTPFLTR_" "))
KILL MSTPFLTR1
QUIT
+7 SET PARENT=MSTPFLTR
+8 KILL DIR,X,Y
WRITE !
+9 ;prompt user the rxchangerequest code
IF MSTPFLTR="CR"
DO REQCODE^PSOERRX2(MTARR(MSTPFLTR))
QUIT
+10 SET DIR("A")="RESPONSE TYPE: "
+11 IF $GET(MSTCHNG)'=PARENT
SET $PIECE(MSTPFLTR1,"/",2)=""
+12 SET DIR("B")=$SELECT($PIECE($GET(MSTPFLTR1),"/",2)'="":$PIECE(MSTPFLTR1,"/",2),1:"ALL")
+13 SET MSTCODE=$$GET1^DID(52.49,52.1,,"SET OF CODES",,"PSOERR")
+14 SET $EXTRACT(MSTCODE,$LENGTH(MSTCODE))=""
+15 SET DIR(0)="SAO^ALL:ALL;"
+16 SET DIR("?")="Enter a response type from the list."
+17 SET DIR("??")=DIR("?")
+18 FOR II=1:1:$LENGTH(MSTCODE,";")
if $PIECE(MSTCODE,";",II)=""
QUIT
Begin DoDot:1
+19 IF MSTPFLTR="RE"
IF $PIECE(MSTCODE,";",II)["VALIDATED"
QUIT
+20 IF MSTPFLTR="CX"
IF ($PIECE(MSTCODE,";",II)["REPLACE")!($PIECE(MSTCODE,";",II)["DNP")
QUIT
+21 SET RESARY($PIECE($PIECE(MSTCODE,";",II),":"))=$PIECE(MSTCODE,";",II)
End DoDot:1
+22 SET II=""
FOR
SET II=$ORDER(RESARY(II))
if II=""
QUIT
SET DIR(0)=DIR(0)_RESARY(II)_";"
+23 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
KILL MSTPFLTR,MSTPFLTR1
QUIT
+24 IF Y'="ALL"
Begin DoDot:1
+25 SET II=""
FOR
SET II=$ORDER(RESARY(II))
if II=""
QUIT
Begin DoDot:2
+26 IF Y'=II
KILL RESARY(II)
End DoDot:2
End DoDot:1
+27 SET MSTPFLTR=PARENT
+28 SET MSTPFLTR1=MTARR(MSTPFLTR)_"/"_$SELECT($GET(Y)="ALL":"ALL",1:$PIECE($GET(RESARY(Y)),":",2))
+29 ;prompt the user the associated denied reason user wanted to see
IF Y="D"
DO ADDFLTR^PSOERRX2($GET(Y),$GET(MSTPFLTR1))
+30 SET MSTCHNG=PARENT
+31 QUIT
+32 ;
STSFLTR ; - eRx Status Filter
+1 ; prompt for erx status
+2 NEW DIC,X,Y,DTOUT,DUOUT,PARENT,DIRUT,DIROUT,SCREEN,DIR
+3 IF $GET(STSFLTR)
SET DIC("B")=$$GET1^DIQ(52.45,STSFLTR,.01)
+4 SET DIC("A")="ERX STATUS: "
SET DIC=52.45
SET DIC(0)="AEQ"
SET DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y))"
+5 ; MbM Sites only - Allow selection of Removed Reasons as Status
+6 IF $GET(MBMSITE)
SET DIC("S")=DIC("S")_"!$D(^PS(52.45,""TYPE"",""REM"",Y))"
+7 WRITE !
DO ^DIC
IF Y<1
QUIT
+8 SET STSFLTR=+Y
+9 SET PARENT=$PIECE(Y,"^",2)
+10 IF (" RM RJ "'[(" "_PARENT_" "))
KILL STSFLTR1
QUIT
ASKAGAIN ;
+1 WRITE !
KILL X,Y,DIC("A")
+2 SET DIR(0)="52.45,.01:AOZ"
+3 SET DIR("A")=$SELECT(PARENT="RM":"REMOVAL",1:"REJECT")_" REASON CODE: "
+4 SET SCREEN="I $D(^PS(52.45,""TYPE"""_","""_$SELECT(PARENT="RM":"REM",1:"REJ")_""",Y))"
+5 SET DIR("?")="^S DIC=""^PS(52.45,"",DIC(0)=""EQ"",DIC(""S"")=SCREEN D ^DIC"
+6 SET DIR("??")=DIR("?")
+7 IF $GET(FLTRCHNG)'=PARENT
SET $PIECE(STSFLTR1,"/",2)=""
+8 SET DIR("B")=$SELECT($PIECE($GET(STSFLTR1),"/",2)'="":$PIECE(STSFLTR1,"/",2),1:"ALL")
+9 DO ^DIR
+10 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DUOUT)
KILL STSFLTR,STSFLTR1
QUIT
+11 KILL STSRMARY
+12 IF $GET(Y)="ALL"
Begin DoDot:1
+13 MERGE STSRMARY=^PS(52.45,"TYPE",$SELECT(PARENT="RM":"REM",1:"REJ"))
+14 SET STSFLTR1=$GET(PARENT)_"/"_$SELECT($GET(Y)="ALL":"ALL",1:"")
+15 SET FLTRCHNG=PARENT
End DoDot:1
QUIT
+16 SET DIC(0)="EQ"
+17 SET DIC("S")=SCREEN
+18 SET DIC("B")=DIR("B")
+19 DO ^DIC
+20 IF +Y<1
KILL DIR
GOTO ASKAGAIN
+21 SET STSRMARY(+$GET(Y))=^PS(52.45,"TYPE",$SELECT(PARENT="RM":"REM",1:"REJ"),+Y)
+22 SET STSFLTR1=$GET(PARENT)_"/"_$$GET1^DIQ(52.45,+Y,.01)
+23 SET FLTRCHNG=PARENT
+24 QUIT
+25 ;
DRGFLTR ; - eRx Drug Name Filter
+1 NEW DIR,X,Y,DIRUT,DIROUT
+2 SET DIR(0)="F^3:30"
SET DIR("A")="ERX DRUG NAME"
+3 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+4 SET DRGFLTR=Y
+5 QUIT
+6 ;
RAF ; Remove All Filters
+1 KILL PATFLTR,VPATFLTR,DOBFLTR,REDTFLTR,PRVFLTR,VPRVFLTR,STSFLTR,STSFLTR1,MSTPFLTR,MSTPFLTR1,DRGFLTR,MATFLTR,VDRGFLTR,STSRMARY,RESARY,DNDARY,FLTRCHNG,REASCODE,MSTCHNG,REASCODE
+2 DO REF
SET VALMBG=1
+3 QUIT
+4 ;
REF ;Screen Refresh
+1 WRITE ?52,"Please wait..."
DO INIT
DO HDR
SET VALMBCK="R"
+2 QUIT
+3 ;
+4 ;
IAS ;Include All Status Switch
+1 WRITE ?52,"Please wait..."
SET PSOALLST=$SELECT($GET(PSOALLST):0,1:1)
SET LINE=0
DO REF
+2 IF 'PSOALLST
SET VALMBG=1
+3 QUIT
+4 ;
+5 ;
J2EP(DFN) ; Jump to eRx Patient (From Backdoor)
+1 ;Input: DFN - Pointer to the PATIENT file (#2)
+2 NEW PSOALLST,PSNPINST,MBMSITE,PSOCLNC,PSOJUMP,EPAT,VPATFLTR,PATFLTR
+3 SET DFN=+$GET(DFN)
SET VALMBCK="R"
SET PSOJUMP=1
SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
if MBMSITE
SET PSOALLST=1
+4 IF '$ORDER(^PS(52.49,"AVPAT",DFN,0))
Begin DoDot:1
+5 SET VALMSG="No corresponding eRx Patient found"
WRITE $CHAR(7)
End DoDot:1
QUIT
+6 SET PSNPINST=$$GET1^DIQ(59,+$GET(PSOSITE),101,"I")
+7 SET PSOCLNC=+$$GET1^DIQ(59,PSOSITE,10,"I")
+8 SET VPATFLTR(DFN)=""
SET PSOSTFLT="A"
+9 SET EPAT=0
FOR
SET EPAT=$ORDER(^PS(52.49,"AVPAT",+DFN,EPAT))
if 'EPAT
QUIT
Begin DoDot:1
+10 SET PATFLTR(EPAT)=""
End DoDot:1
+11 DO EN
+12 QUIT
+13 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ;
+1 KILL ^TMP("PSOERRX0",$JOB),^TMP("PSOERRXS",$JOB)
+2 DO FULL^VALM1
+3 QUIT
