PSOERPC0 ;BIRM/MFR - All Patients (Patient Centric) eRx Queue - ListManager ;09/28/22
;;7.0;OUTPATIENT PHARMACY;**700,750,746,770**;DEC 1997;Build 145
;
;Menu option entry point
N MBMSITE,PSOSTFLT,PSOHDSTS,PSOCCRST,PSOSRTBY,PSORDER,PSOCSGRP,PSOLKBKD,PSOCSERX,PSOCSSCH,PSOCSGRP,PSOMAXQS
N GRPLN,DIC,DFN,GRPLN,HIGHLN,LASTLINE,VALMCNT,PTMTCHLN,PRMTCHLN,DRMTCHLN,PATFLTR,VPATFLTR,DOBFLTR,MATFLTR,PSONEXTP
N DIR,Y,DIRUT,DIROUT,CODE,DIRUT,DTOUT,PSOVIEW,PSOCSSCH,PSOCSERX,PSOQUIT,REDTFLTR,PRVFLTR,DRGFLTR,PSOJUMP
N RESETLBD,PSOCLNC,PSORFRSH,IDX
;Initialization
D INIT^PSOERPC2
;
;Division Selection
I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT
S PSNPINST=$$GET1^DIQ(59,PSOSITE,101,"I"),RESETLBD=1
;
;Clinic Selection (MbM Sites Only)
S PSOCLNC=+$$GET1^DIQ(59,PSOSITE,10,"I")
I $G(MBMSITE) D I $G(PSOQUIT) G EXIT
. W ! K DIC
. S DIC(0)="AEMQ",DIC=44,DIC("S")="I '$P($G(^(""I"")),U,1)!$P($G(^(""I"")),U,2)"
. S DIC("A")="eRx Clinic (Optional): "
. I $G(PSOCLNC) S DIC("B")=$$GET1^DIQ(44,PSOCLNC,.01)
. D ^DIC I Y="^"!$D(DTOUT)!$D(DUOUT) S PSOQUIT=1 Q
. I $G(Y)>0 S PSOCLNC=+Y
;
I '$$CHKKEY^PSOERX(DUZ) D G EXIT
. W !,"You do not have the appropriate key to access this option." S DIR(0)="E" D ^DIR K DIR
;
D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) D MSG^PSODPT G EXIT
D:'$D(PSOPINST) INST^PSOORFI2 I $G(PSOIQUIT) K PSOIQUIT G EXIT
S PSNPINST=$$GET1^DIQ(59,PSOSITE,101,"I")
I 'PSNPINST W !,"NPI Institution must be defined to continue." S DIR(0)="E" D ^DIR K DIR G EXIT
;
STS ; Status Selection Prompt
K DIR S DIR(0)="SO^"
I '$D(^XUSEC("PSO ERX WORKLOAD TECH",DUZ)) S DIR(0)=DIR(0)_"A:All;N:New;I:In Progress;W:Wait;"
S DIR(0)=DIR(0)_"H:Hold;C:CCR;WP:Workload Processing"
S DIR("B")=$S($D(^XUSEC("PSO ERX WORKLOAD TECH",DUZ)):"WP",1:"A")
S DIR("?")=" "
S IDX=0
I '$D(^XUSEC("PSO ERX WORKLOAD TECH",DUZ)) D
. S IDX=IDX+1,DIR("?",IDX)=" All - View all patients with actionable prescriptions"
. S IDX=IDX+1,DIR("?",IDX)=" New - View patients with prescriptions in the 'NEW' status"
. S IDX=IDX+1,DIR("?",IDX)=" In Process - View patients with prescriptions in the 'IN PROCESS' status"
. S IDX=IDX+1,DIR("?",IDX)=" Wait - View patients with prescriptions in the 'WAIT' status"
S IDX=IDX+1,DIR("?",IDX)=" Hold - View patients with prescriptions in the 'HOLD' status"
S IDX=IDX+1,DIR("?",IDX)=" CCR - View patients with prescriptions in the 'CCR' status"
S IDX=IDX+1,DIR("?",IDX)=" Workload Processing - Process New prescriptions for one patient at a"
S IDX=IDX+1,DIR("?",IDX)=" time using FIFO (First In First Out) method"
D ^DIR I $D(DIRUT)!$D(DIROUT) G EXIT
S PSOSTFLT=Y,PSOQUIT=0
I PSOSTFLT="WP" D MATFLTR I '$G(MATFLTR) G STS
I PSOSTFLT="H" D
. K DIR S DIR(0)="SO^S:SINGLE CODE;A:ALL HOLD CODES",DIR("B")="A"
. S DIR("?")=" ",DIR("?",1)=" Single code - Allows selection of a single hold code",DIR("?",2)=" All Hold Codes - Selects all available hold codes"
. D ^DIR I $D(DIRUT)!$D(DIROUT) S PSOQUIT=1 Q
. I Y="S" S PSOHDSTS=$P($$HLDSTS^PSOERPC1(),U) I PSOHDSTS="" S PSOQUIT=1 Q
. I Y="A" S PSOHDSTS="ALL"
I PSOSTFLT="C" D
. K DIR S DIR("B")="A",DIR(0)="SO^S:SINGLE CODE;A:ALL CCR CODES"
. S DIR("?")=" ",DIR("?",1)=" Single code - Allows selection of a single CCR code",DIR("?",2)=" All CCR Codes - Selects all available CCR codes"
. D ^DIR I $D(DIRUT)!$D(DIROUT) S PSOQUIT=1 Q
. I Y="S" S PSOCCRST=$P($$CCRSTS^PSOERPC1("RXN^RXD^RXR^RXE^RXF^RRE^CAO^CAH^CAP^CAR^CAX^CAF^CXD^CXN^CXV^CXY^CXE^CRE"),U) I PSOCCRST="" S PSOQUIT=1 Q
. I Y="A" S PSOCCRST="ALL"
I PSOQUIT G STS
;
EN ; - Entry point for the PC Action in the RX View
; Loading User's preferences
D LOAD^PSOERPR0
;
I PSOSTFLT="WP" D
. D NEXTPAT
E W !,"Please wait..." D EN^VALM("PSO ERX ALL PATIENTS QUEUE")
;
G EXIT
;
LMHDR ; ListMan Header Code
D SHOW^VALM,HDR^PSOERPC0
I $G(MBMSITE) S XQORM("B")="Next Screen"
S XQORM("#")=$O(^ORD(101,"B","PSO ERX ALL PATIENTS SELECT",""))_"^1:"_VALMCNT
S XQORM("??")="D HELP^VALM2,HDR^PSOERPC0"
Q
;
HDR ; - Builds the Header section
D HDR^PSOERPC1
Q
;
INIT ; - Populates the Body section for ListMan
N LOCKPATS,PAT
K ^TMP("PSOERPC0",$J),^TMP("PSOERPCS",$J),^TMP("PSOERPAT",$J)
S PAT=0 F S PAT=$O(^XTMP("PSOERXLOCK",PAT)) Q:'PAT S LOCKPATS(PAT)=+$G(^XTMP("PSOERXLOCK",PAT))
D SETSORT^PSOERPC1,SETLINE^PSOERPC2
S:$G(VALMSG)="" VALMSG="Select the entry # to view or ?? for more actions"
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
LBD ; - Change Look Back Days Parameter Action
D FULL^VALM1 S VALMBCK="R"
W ! K DIR,DA,DIRUT,DIROUT,SAVEX
S DIR(0)="52.351,1",DIR("B")=PSOLKBKD
D ^DIR I $D(DIRUT)!$D(DIROUT) Q
S PSOLKBKD=Y,RESETLBD=0 D REF S VALMBG=1
Q
;
SQ ; - Search Queue Entry Point
D FULL^VALM1 S VALMBCK="R"
N DIR,DUOUT,DIRUT,Y,X,ERXIEN,CHANGE,ERXPTIEN,PSOFPICK
S CHANGE=0,IOINHI=$G(IOINHI),IOINORM=$G(IOINORM)
REP ; - Repeat Prompt for additional filters
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 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:ERX REFERENCE NUMBER"
S DIR(0)=DIR(0)_";4:VISTA RX #"
S DIR(0)=DIR(0)_";5:VISTA PATIENT" I $D(VPATFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$VPATFLST^PSOERUT(44)_")"_IOINORM
S DIR(0)=DIR(0)_";6:MATCH STATUS" I $G(MATFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$MATCHLBL^PSOERPC2(MATFLTR)_")"_IOINORM
W !!,$G(IOINHI),"NOTE: Only patients with actionable records are captured with this search.",IOINORM
W !,IOINHI," Non-Actionable records can be searched through the SQ action under Rx",IOINORM
W !,IOINHI," List View.",IOINORM
D ^DIR
I X'="^",X?1"^".N D G REP
. K:X="^1" PATFLTR,VPATFLTR K:X="^2" DOBFLTR K:X="^5" PATFLTR,VPATFLTR K:X="^6" MATFLTR
. S CHANGE=1
I $D(DUOUT)!($D(DIRUT)) D:CHANGE REF S:CHANGE VALMBG=1 Q
S PSOFPICK=+$G(Y)
I PSOFPICK=1 D EPATFLTR S CHANGE=1 G REP
I PSOFPICK=2 D DOBFLTR S CHANGE=1 G REP
I PSOFPICK=3 D ERXFLTR 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=4 D RXFLTR 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=5 D VPATFLTR S CHANGE=1 G REP
I PSOFPICK=6 D MATFLTR S CHANGE=1 G REP
D REF S VALMBG=1
Q
;
VPATFLTR ; - VistA Patient Filter
N DIC,Y,EPAT,X K VPATFLTR
REP1 ; - Repeat VistA Patient Prompt
K DIC,DIR W ! S DIC=2,DIC(0)="QEAM",DIC("A")="VISTA PATIENT: ",DIC("S")="I '$$DEAD^PSONVARP(Y)"
I $G(MBMSITE) S DIC("W")="D PATIDS^PSOERPT1"
D ^DPTLK I $G(Y)'>0 Q
S VPATFLTR(+Y)="" K PATFLTR
S EPAT=0 F S EPAT=$O(^PS(52.49,"AVPAT",+Y,EPAT)) Q:'EPAT D
. S PATFLTR(EPAT)=""
I '$O(PATFLTR(0)) D K VPATFLTR G REP1
. W !,IOINHI,"There are no eRx Patient(s) matched to this VistA Patient",IOINORM,$C(7)
Q
;
EPATFLTR ; - eRx Patient Filter
N DIR,PAT,XX,RANGE,COMSEG,I,J,RECDAT,DIRUT,DIROUT,QUIT
REP2 ; - Repeat eRx Patient Prompt
K ^TMP($J,"PSOPTLST")
S DIR(0)="F^3:30",DIR("A")="ERX PATIENT NAME"
W ! D ^DIR I $D(DIRUT)!$D(DIROUT) Q
K PATLST D FIND^DIC(52.46,"","@;.01;.08;3.3;3.4;IX","",X,,"B","","",$NA(^TMP($J,"PSOPTLST")))
I '$D(^TMP($J,"PSOPTLST","DILIST",2)) D G REP2
. W !,IOINHI,"No eRx Patient found",IOINORM,$C(7)
I +$G(^TMP($J,"PSOPTLST","DILIST",0))>100 D K ^TMP($J,"PSOPTLST") G REP2
. W !!,IOINHI,"There are too many records to display, please narrow your search.",IOINORM,$C(7)
;
D PATLHDR("E")
S (QUIT,CNT)=0 K DIRUT,DTOUT
S PAT="" F S PAT=$O(^TMP($J,"PSOPTLST","DILIST","ID",PAT)) Q:'PAT D I QUIT Q
. W !,PAT,".",?4,$E(^TMP($J,"PSOPTLST","DILIST","ID",PAT,.01),1,30)
. I ^TMP($J,"PSOPTLST","DILIST","ID",PAT,.08)'="" D
. . S X=^TMP($J,"PSOPTLST","DILIST","ID",PAT,.08) D ^%DT W ?35,$$FMTE^XLFDT(Y,"5Z")
. I ^TMP($J,"PSOPTLST","DILIST","ID",PAT,3.3)'="" D
. . W ?47,$E(^TMP($J,"PSOPTLST","DILIST","ID",PAT,3.3),1,20)_"-"_$$STATEABB^PSOERUT(52.46,^TMP($J,"PSOPTLST","DILIST",2,PAT))
. S RECDAT=$O(^PS(52.49,"PAT2",^TMP($J,"PSOPTLST","DILIST",2,PAT),999999999),-1)
. I RECDAT W ?71,$$FMTE^XLFDT(RECDAT\1,"2Z")
. S CNT=CNT+1
. I CNT>18,$O(^TMP($J,"PSOPTLST","DILIST","ID",PAT)),$Y>(IOSL-4) D
. . K DIR S DIR(0)="E" D ^DIR I $D(DIRUT)!$D(DIROUT) S QUIT=1 Q
. . W @IOF D PATLHDR("E")
;
I CNT=1 K PATFLTR S PATFLTR(^TMP($J,"PSOPTLST","DILIST",2,1))="" K ^TMP($J,"PSOPTLST") Q
;
K DIR S DIR("A")="SELECT (1-"_+$G(^TMP($J,"PSOPTLST","DILIST",0))_"): "
S DIR(0)="LA^1:"_+$G(^TMP($J,"PSOPTLST","DILIST",0)) W ! D ^DIR I $D(DIRUT)!$D(DIROUT) G REP2
S RANGE=X
;
K PATFLTR
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(^TMP($J,"PSOPTLST","DILIST",2,J)) Q
. . S PATFLTR(^TMP($J,"PSOPTLST","DILIST",2,J))=""
K ^TMP($J,"PSOPTLST")
Q
;
PATLHDR(PATTYP) ; - Prints the Patient List Header
;Input: Patient Type - "V": VistA Patient | "E": eRx Patient
N XX W !?73,"LAST",!,"#",?4,$S(PATTYP="E":"ERX",1:"VISTA")_" PATIENT NAME",?35,"DOB",?47,"CITY",?71,"REC.DATE"
S $P(XX,"-",80)="" W !,XX
Q
;
DOBFLTR ; - DOB Filter
N DIR,Y,X
I $G(DOBFLTR) S DIR("B")=$$FMTE^XLFDT(DOBFLTR,"2Z")
S DIR(0)="DA^:"_DT_":EX",DIR("A")="Date of Birth (DOB): "
W ! D ^DIR I $D(DIRUT)!$D(DIROUT) Q
S DOBFLTR=Y
Q
;
MATFLTR ; - Match Status Filter
N DIR,Y,X
S DIR("A")="MATCH STATUS"
S DIR(0)="SO^1:"_$S($G(MBMSITE):"PATIENT FAIL - ",1:"")_"PATIENT NOT MATCHED"
S DIR(0)=DIR(0)_";2:"_$S($G(MBMSITE):"PROVIDER FAIL - ",1:"")_"PROVIDER NOT MATCHED"
S DIR(0)=DIR(0)_";3:"_$S($G(MBMSITE):"DRUG FAIL - ",1:"")_"DRUG NOT MATCHED"
S DIR(0)=DIR(0)_";4:"_$S($G(MBMSITE):"BASIC - ",1:"")_"PATIENT, PROVIDER AND DRUG MATCHED"
I $G(PSOSTFLT)="WP" S DIR(0)=DIR(0)_";5:ALL (NO FILTERS)",DIR("B")=5
W ! D ^DIR I $D(DUOUT)!($D(DIRUT)) Q
S MATFLTR=Y
Q
;
ERXFLTR() ; - eRx ID Filter
N DIC,Y,DTOUT,DUOUT,QUIT,ERXID,ERXPTIEN
K ERXFLTR
W ! S DIC="52.49",DIC(0)="QEA",DIC("A")="ERX REFERENCE NUMBER: "
S QUIT=0
F D Q:QUIT
. D ^DIC I $D(DTOUT)!$D(DUOUT)!'Y!(X="") S QUIT=1 Q
. S ERXID=+Y
. I 'ERXID W !,"This prescription is not an eRx prescription." Q
. I '$G(MBMSITE),$$GET1^DIQ(52.49,ERXID,24.1,"I")'=PSNPINST D Q
. . W !!,"eRx belongs to a different Division: "_$$GET1^DIQ(52.49,ERXID,24.1),!,$C(7)
. S ERXPTIEN=+$$GET1^DIQ(52.49,ERXID,.04,"I")
. ; - Locking the eRx Patient
. I '$$LOCK^PSOERPC1(ERXPTIEN) D Q
. . W !!,"The patient for this eRx is currently locked by "_$$GET1^DIQ(200,+$G(^XTMP("PSOERXLOCK",ERXPTIEN)),.01)_".",!,$C(7) H 1
. S ERXFLTR=ERXID,QUIT=1
Q
;
RXFLTR() ; - Rx # Filter
N DIC,Y,DTOUT,DUOUT,QUIT,ERXID,ERXPTIEN
K ERXFLTR
W ! S DIC="52",DIC(0)="QEAM",DIC("A")="VISTA Rx #: "
S QUIT=0
F D Q:QUIT
. D ^DIC I $D(DTOUT)!$D(DUOUT)!'Y!(X="") S QUIT=1 Q
. S ERXID=$$ERXIEN^PSOERXUT(+Y)
. I 'ERXID W !,"This prescription is not an eRx prescription." Q
. I '$G(MBMSITE),$$GET1^DIQ(52.49,ERXID,24.1,"I")'=PSNPINST D Q
. . W !!,"eRx belongs to a different Division: "_$$GET1^DIQ(52.49,ERXID,24.1),!,$C(7)
. S ERXPTIEN=+$$GET1^DIQ(52.49,ERXID,.04,"I")
. ; - Locking the eRx Patient
. I '$$LOCK^PSOERPC1(ERXPTIEN) D Q
. . W !!,"The patient for this eRx is currently locked by "_$$GET1^DIQ(200,+$G(^XTMP("PSOERXLOCK",ERXPTIEN)),.01)_".",!,$C(7) H 1
. S ERXFLTR=ERXID,QUIT=1
Q
;
RF ; - Remove All Filters
K PATFLTR,VPATFLTR,DOBFLTR,MATFLTR D REF S VALMBG=1
Q
;
CS ; - Group/Un-group Controlled Substances
S PSOCSGRP=$S($G(PSOCSGRP):0,1:1) D REF
Q
;
CV ; - Change View
D EN^PSOERPR0 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
;
SEL ; - Process selection of one entry
N PSOSEL,ERXPTIEN,TMPLKBKD
S VALMBCK="R" K PSONEXTP
S PSOSEL=+$P(XQORNOD(0),"=",2) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q
S ERXPTIEN=$G(^TMP("PSOERPC0",$J,PSOSEL,"PATIEN")) I 'ERXPTIEN S VALMSG="Invalid selection!",VALMBCK="R" Q
; - Locking the eRx Patient
I '$$LOCK^PSOERPC1(ERXPTIEN) Q
D ; - Entering the Single Patient View (Protecting Preference Parameters)
. N PSOSRTBY,PSORDER,PSOCSGRP,PSOALLST
. S TMPLKBKD=PSOLKBKD D LST^PSOERPT0(ERXPTIEN)
. I $G(RESETLBD) S PSOLKBKD=TMPLKBKD
; - Unlocking the eRx Patient
D UL^PSOERX1A(ERXPTIEN)
I $G(PSORFRSH) D REF
Q
;
NEXTPAT ; Automatically Selects the Next Patient
N ERXPTIEN,NEXTPAT,PTLOCKED
S VALMBCK="R",NEXTPAT=0,PTLOCKED=1
; - Locking the eRx Patient
F S ERXPTIEN=$$NEXTPAT^PSOERPC1(NEXTPAT) Q:'ERXPTIEN Q:$$LOCK^PSOERPC1(ERXPTIEN) S:$D(^XTMP("PSOERXWP",ERXPTIEN,DUZ)) PTLOCKED=0 Q:$D(^XTMP("PSOERXWP",ERXPTIEN,DUZ)) D
. S NEXTPAT=ERXPTIEN I PSOSTFLT="WP" K ^XTMP("PSOERXWP",ERXPTIEN,DUZ)
I 'ERXPTIEN Q
I PSOSTFLT="WP",$D(^XUSEC("PSO ERX WORKLOAD TECH",DUZ)) S ^XTMP("PSOERXWP",ERXPTIEN,DUZ)=""
D ; - Entering the Single Patient View (Protecting Preference Parameters)
. N PSOSRTBY,PSORDER,PSOCSGRP,PSOALLST
. D LST^PSOERPT0(ERXPTIEN)
; - Unlocking the eRx Patient
D:$G(PTLOCKED) UL^PSOERX1A(ERXPTIEN)
Q
;
RX ; - Switch to Rx View
D EN^PSOERRX0 S VALMBCK="Q"
Q
;
REF ; - Screen Refresh
W ?65,"Please wait..." D INIT,HDR,REVLOCKS^PSOERPC2 S VALMBCK="R"
S PSORFRSH=0
Q
;
EXIT ; - exit code
K ^TMP("PSOERPC0",$J),^TMP("PSOERPCS",$J),^TMP("PSOERPAT",$J)
D FULL^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERPC0 14157 printed Sep 23, 2025@20:04:05 Page 2
PSOERPC0 ;BIRM/MFR - All Patients (Patient Centric) eRx Queue - ListManager ;09/28/22
+1 ;;7.0;OUTPATIENT PHARMACY;**700,750,746,770**;DEC 1997;Build 145
+2 ;
+3 ;Menu option entry point
+4 NEW MBMSITE,PSOSTFLT,PSOHDSTS,PSOCCRST,PSOSRTBY,PSORDER,PSOCSGRP,PSOLKBKD,PSOCSERX,PSOCSSCH,PSOCSGRP,PSOMAXQS
+5 NEW GRPLN,DIC,DFN,GRPLN,HIGHLN,LASTLINE,VALMCNT,PTMTCHLN,PRMTCHLN,DRMTCHLN,PATFLTR,VPATFLTR,DOBFLTR,MATFLTR,PSONEXTP
+6 NEW DIR,Y,DIRUT,DIROUT,CODE,DIRUT,DTOUT,PSOVIEW,PSOCSSCH,PSOCSERX,PSOQUIT,REDTFLTR,PRVFLTR,DRGFLTR,PSOJUMP
+7 NEW RESETLBD,PSOCLNC,PSORFRSH,IDX
+8 ;Initialization
+9 DO INIT^PSOERPC2
+10 ;
+11 ;Division Selection
+12 IF '$GET(PSOSITE)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
GOTO EXIT
+13 SET PSNPINST=$$GET1^DIQ(59,PSOSITE,101,"I")
SET RESETLBD=1
+14 ;
+15 ;Clinic Selection (MbM Sites Only)
+16 SET PSOCLNC=+$$GET1^DIQ(59,PSOSITE,10,"I")
+17 IF $GET(MBMSITE)
Begin DoDot:1
+18 WRITE !
KILL DIC
+19 SET DIC(0)="AEMQ"
SET DIC=44
SET DIC("S")="I '$P($G(^(""I"")),U,1)!$P($G(^(""I"")),U,2)"
+20 SET DIC("A")="eRx Clinic (Optional): "
+21 IF $GET(PSOCLNC)
SET DIC("B")=$$GET1^DIQ(44,PSOCLNC,.01)
+22 DO ^DIC
IF Y="^"!$DATA(DTOUT)!$DATA(DUOUT)
SET PSOQUIT=1
QUIT
+23 IF $GET(Y)>0
SET PSOCLNC=+Y
End DoDot:1
IF $GET(PSOQUIT)
GOTO EXIT
+24 ;
+25 IF '$$CHKKEY^PSOERX(DUZ)
Begin DoDot:1
+26 WRITE !,"You do not have the appropriate key to access this option."
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
GOTO EXIT
+27 ;
+28 if '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
DO MSG^PSODPT
GOTO EXIT
+29 if '$DATA(PSOPINST)
DO INST^PSOORFI2
IF $GET(PSOIQUIT)
KILL PSOIQUIT
GOTO EXIT
+30 SET PSNPINST=$$GET1^DIQ(59,PSOSITE,101,"I")
+31 IF 'PSNPINST
WRITE !,"NPI Institution must be defined to continue."
SET DIR(0)="E"
DO ^DIR
KILL DIR
GOTO EXIT
+32 ;
STS ; Status Selection Prompt
+1 KILL DIR
SET DIR(0)="SO^"
+2 IF '$DATA(^XUSEC("PSO ERX WORKLOAD TECH",DUZ))
SET DIR(0)=DIR(0)_"A:All;N:New;I:In Progress;W:Wait;"
+3 SET DIR(0)=DIR(0)_"H:Hold;C:CCR;WP:Workload Processing"
+4 SET DIR("B")=$SELECT($DATA(^XUSEC("PSO ERX WORKLOAD TECH",DUZ)):"WP",1:"A")
+5 SET DIR("?")=" "
+6 SET IDX=0
+7 IF '$DATA(^XUSEC("PSO ERX WORKLOAD TECH",DUZ))
Begin DoDot:1
+8 SET IDX=IDX+1
SET DIR("?",IDX)=" All - View all patients with actionable prescriptions"
+9 SET IDX=IDX+1
SET DIR("?",IDX)=" New - View patients with prescriptions in the 'NEW' status"
+10 SET IDX=IDX+1
SET DIR("?",IDX)=" In Process - View patients with prescriptions in the 'IN PROCESS' status"
+11 SET IDX=IDX+1
SET DIR("?",IDX)=" Wait - View patients with prescriptions in the 'WAIT' status"
End DoDot:1
+12 SET IDX=IDX+1
SET DIR("?",IDX)=" Hold - View patients with prescriptions in the 'HOLD' status"
+13 SET IDX=IDX+1
SET DIR("?",IDX)=" CCR - View patients with prescriptions in the 'CCR' status"
+14 SET IDX=IDX+1
SET DIR("?",IDX)=" Workload Processing - Process New prescriptions for one patient at a"
+15 SET IDX=IDX+1
SET DIR("?",IDX)=" time using FIFO (First In First Out) method"
+16 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO EXIT
+17 SET PSOSTFLT=Y
SET PSOQUIT=0
+18 IF PSOSTFLT="WP"
DO MATFLTR
IF '$GET(MATFLTR)
GOTO STS
+19 IF PSOSTFLT="H"
Begin DoDot:1
+20 KILL DIR
SET DIR(0)="SO^S:SINGLE CODE;A:ALL HOLD CODES"
SET DIR("B")="A"
+21 SET DIR("?")=" "
SET DIR("?",1)=" Single code - Allows selection of a single hold code"
SET DIR("?",2)=" All Hold Codes - Selects all available hold codes"
+22 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
SET PSOQUIT=1
QUIT
+23 IF Y="S"
SET PSOHDSTS=$PIECE($$HLDSTS^PSOERPC1(),U)
IF PSOHDSTS=""
SET PSOQUIT=1
QUIT
+24 IF Y="A"
SET PSOHDSTS="ALL"
End DoDot:1
+25 IF PSOSTFLT="C"
Begin DoDot:1
+26 KILL DIR
SET DIR("B")="A"
SET DIR(0)="SO^S:SINGLE CODE;A:ALL CCR CODES"
+27 SET DIR("?")=" "
SET DIR("?",1)=" Single code - Allows selection of a single CCR code"
SET DIR("?",2)=" All CCR Codes - Selects all available CCR codes"
+28 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
SET PSOQUIT=1
QUIT
+29 IF Y="S"
SET PSOCCRST=$PIECE($$CCRSTS^PSOERPC1("RXN^RXD^RXR^RXE^RXF^RRE^CAO^CAH^CAP^CAR^CAX^CAF^CXD^CXN^CXV^CXY^CXE^CRE"),U)
IF PSOCCRST=""
SET PSOQUIT=1
QUIT
+30 IF Y="A"
SET PSOCCRST="ALL"
End DoDot:1
+31 IF PSOQUIT
GOTO STS
+32 ;
EN ; - Entry point for the PC Action in the RX View
+1 ; Loading User's preferences
+2 DO LOAD^PSOERPR0
+3 ;
+4 IF PSOSTFLT="WP"
Begin DoDot:1
+5 DO NEXTPAT
End DoDot:1
+6 IF '$TEST
WRITE !,"Please wait..."
DO EN^VALM("PSO ERX ALL PATIENTS QUEUE")
+7 ;
+8 GOTO EXIT
+9 ;
LMHDR ; ListMan Header Code
+1 DO SHOW^VALM
DO HDR^PSOERPC0
+2 IF $GET(MBMSITE)
SET XQORM("B")="Next Screen"
+3 SET XQORM("#")=$ORDER(^ORD(101,"B","PSO ERX ALL PATIENTS SELECT",""))_"^1:"_VALMCNT
+4 SET XQORM("??")="D HELP^VALM2,HDR^PSOERPC0"
+5 QUIT
+6 ;
HDR ; - Builds the Header section
+1 DO HDR^PSOERPC1
+2 QUIT
+3 ;
INIT ; - Populates the Body section for ListMan
+1 NEW LOCKPATS,PAT
+2 KILL ^TMP("PSOERPC0",$JOB),^TMP("PSOERPCS",$JOB),^TMP("PSOERPAT",$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^PSOERPC1
DO SETLINE^PSOERPC2
+5 if $GET(VALMSG)=""
SET VALMSG="Select the entry # to view or ?? for more actions"
+6 QUIT
+7 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
LBD ; - Change Look Back Days Parameter Action
+1 DO FULL^VALM1
SET VALMBCK="R"
+2 WRITE !
KILL DIR,DA,DIRUT,DIROUT,SAVEX
+3 SET DIR(0)="52.351,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 ;
SQ ; - Search Queue Entry Point
+1 DO FULL^VALM1
SET VALMBCK="R"
+2 NEW DIR,DUOUT,DIRUT,Y,X,ERXIEN,CHANGE,ERXPTIEN,PSOFPICK
+3 SET CHANGE=0
SET IOINHI=$GET(IOINHI)
SET IOINORM=$GET(IOINORM)
REP ; - Repeat Prompt for additional filters
+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 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:ERX REFERENCE NUMBER"
+8 SET DIR(0)=DIR(0)_";4:VISTA RX #"
+9 SET DIR(0)=DIR(0)_";5:VISTA PATIENT"
IF $DATA(VPATFLTR)
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$$VPATFLST^PSOERUT(44)_")"_IOINORM
+10 SET DIR(0)=DIR(0)_";6:MATCH STATUS"
IF $GET(MATFLTR)
SET DIR(0)=DIR(0)_" "_IOINHI_"("_$$MATCHLBL^PSOERPC2(MATFLTR)_")"_IOINORM
+11 WRITE !!,$GET(IOINHI),"NOTE: Only patients with actionable records are captured with this search.",IOINORM
+12 WRITE !,IOINHI," Non-Actionable records can be searched through the SQ action under Rx",IOINORM
+13 WRITE !,IOINHI," List View.",IOINORM
+14 DO ^DIR
+15 IF X'="^"
IF X?1"^".N
Begin DoDot:1
+16 if X="^1"
KILL PATFLTR,VPATFLTR
if X="^2"
KILL DOBFLTR
if X="^5"
KILL PATFLTR,VPATFLTR
if X="^6"
KILL MATFLTR
+17 SET CHANGE=1
End DoDot:1
GOTO REP
+18 IF $DATA(DUOUT)!($DATA(DIRUT))
if CHANGE
DO REF
if CHANGE
SET VALMBG=1
QUIT
+19 SET PSOFPICK=+$GET(Y)
+20 IF PSOFPICK=1
DO EPATFLTR
SET CHANGE=1
GOTO REP
+21 IF PSOFPICK=2
DO DOBFLTR
SET CHANGE=1
GOTO REP
+22 IF PSOFPICK=3
DO ERXFLTR
if '$GET(ERXFLTR)
GOTO REP
Begin DoDot:1
+23 ; - Entering the eRx Record
+24 DO EN^PSOERX1(ERXFLTR)
+25 ; - Unlocking the eRx Patient
+26 SET ERXPTIEN=$$GET1^DIQ(52.49,ERXFLTR,.04,"I")
if 'ERXPTIEN
QUIT
+27 DO UL^PSOERX1A(ERXPTIEN)
+28 SET CHANGE=1
End DoDot:1
IF '$GET(CHANGE)
QUIT
+29 IF PSOFPICK=4
DO RXFLTR
if '$GET(ERXFLTR)
GOTO REP
Begin DoDot:1
+30 ; - Entering the eRx Record
+31 DO EN^PSOERX1(ERXFLTR)
+32 ; - Unlocking the eRx Patient
+33 SET ERXPTIEN=$$GET1^DIQ(52.49,ERXFLTR,.04,"I")
if 'ERXPTIEN
QUIT
+34 DO UL^PSOERX1A(ERXPTIEN)
+35 SET CHANGE=1
End DoDot:1
IF '$GET(CHANGE)
QUIT
+36 IF PSOFPICK=5
DO VPATFLTR
SET CHANGE=1
GOTO REP
+37 IF PSOFPICK=6
DO MATFLTR
SET CHANGE=1
GOTO REP
+38 DO REF
SET VALMBG=1
+39 QUIT
+40 ;
VPATFLTR ; - VistA Patient Filter
+1 NEW DIC,Y,EPAT,X
KILL VPATFLTR
REP1 ; - Repeat VistA Patient Prompt
+1 KILL DIC,DIR
WRITE !
SET DIC=2
SET DIC(0)="QEAM"
SET DIC("A")="VISTA PATIENT: "
SET DIC("S")="I '$$DEAD^PSONVARP(Y)"
+2 IF $GET(MBMSITE)
SET DIC("W")="D PATIDS^PSOERPT1"
+3 DO ^DPTLK
IF $GET(Y)'>0
QUIT
+4 SET VPATFLTR(+Y)=""
KILL PATFLTR
+5 SET EPAT=0
FOR
SET EPAT=$ORDER(^PS(52.49,"AVPAT",+Y,EPAT))
if 'EPAT
QUIT
Begin DoDot:1
+6 SET PATFLTR(EPAT)=""
End DoDot:1
+7 IF '$ORDER(PATFLTR(0))
Begin DoDot:1
+8 WRITE !,IOINHI,"There are no eRx Patient(s) matched to this VistA Patient",IOINORM,$CHAR(7)
End DoDot:1
KILL VPATFLTR
GOTO REP1
+9 QUIT
+10 ;
EPATFLTR ; - eRx Patient Filter
+1 NEW DIR,PAT,XX,RANGE,COMSEG,I,J,RECDAT,DIRUT,DIROUT,QUIT
REP2 ; - Repeat eRx Patient Prompt
+1 KILL ^TMP($JOB,"PSOPTLST")
+2 SET DIR(0)="F^3:30"
SET DIR("A")="ERX PATIENT NAME"
+3 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+4 KILL PATLST
DO FIND^DIC(52.46,"","@;.01;.08;3.3;3.4;IX","",X,,"B","","",$NAME(^TMP($JOB,"PSOPTLST")))
+5 IF '$DATA(^TMP($JOB,"PSOPTLST","DILIST",2))
Begin DoDot:1
+6 WRITE !,IOINHI,"No eRx Patient found",IOINORM,$CHAR(7)
End DoDot:1
GOTO REP2
+7 IF +$GET(^TMP($JOB,"PSOPTLST","DILIST",0))>100
Begin DoDot:1
+8 WRITE !!,IOINHI,"There are too many records to display, please narrow your search.",IOINORM,$CHAR(7)
End DoDot:1
KILL ^TMP($JOB,"PSOPTLST")
GOTO REP2
+9 ;
+10 DO PATLHDR("E")
+11 SET (QUIT,CNT)=0
KILL DIRUT,DTOUT
+12 SET PAT=""
FOR
SET PAT=$ORDER(^TMP($JOB,"PSOPTLST","DILIST","ID",PAT))
if 'PAT
QUIT
Begin DoDot:1
+13 WRITE !,PAT,".",?4,$EXTRACT(^TMP($JOB,"PSOPTLST","DILIST","ID",PAT,.01),1,30)
+14 IF ^TMP($JOB,"PSOPTLST","DILIST","ID",PAT,.08)'=""
Begin DoDot:2
+15 SET X=^TMP($JOB,"PSOPTLST","DILIST","ID",PAT,.08)
DO ^%DT
WRITE ?35,$$FMTE^XLFDT(Y,"5Z")
End DoDot:2
+16 IF ^TMP($JOB,"PSOPTLST","DILIST","ID",PAT,3.3)'=""
Begin DoDot:2
+17 WRITE ?47,$EXTRACT(^TMP($JOB,"PSOPTLST","DILIST","ID",PAT,3.3),1,20)_"-"_$$STATEABB^PSOERUT(52.46,^TMP($JOB,"PSOPTLST","DILIST",2,PAT))
End DoDot:2
+18 SET RECDAT=$ORDER(^PS(52.49,"PAT2",^TMP($JOB,"PSOPTLST","DILIST",2,PAT),999999999),-1)
+19 IF RECDAT
WRITE ?71,$$FMTE^XLFDT(RECDAT\1,"2Z")
+20 SET CNT=CNT+1
+21 IF CNT>18
IF $ORDER(^TMP($JOB,"PSOPTLST","DILIST","ID",PAT))
IF $Y>(IOSL-4)
Begin DoDot:2
+22 KILL DIR
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
SET QUIT=1
QUIT
+23 WRITE @IOF
DO PATLHDR("E")
End DoDot:2
End DoDot:1
IF QUIT
QUIT
+24 ;
+25 IF CNT=1
KILL PATFLTR
SET PATFLTR(^TMP($JOB,"PSOPTLST","DILIST",2,1))=""
KILL ^TMP($JOB,"PSOPTLST")
QUIT
+26 ;
+27 KILL DIR
SET DIR("A")="SELECT (1-"_+$GET(^TMP($JOB,"PSOPTLST","DILIST",0))_"): "
+28 SET DIR(0)="LA^1:"_+$GET(^TMP($JOB,"PSOPTLST","DILIST",0))
WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO REP2
+29 SET RANGE=X
+30 ;
+31 KILL PATFLTR
+32 FOR I=1:1:$LENGTH(RANGE,",")
Begin DoDot:1
+33 SET COMSEG=$PIECE(RANGE,",",I)
+34 FOR J=+COMSEG:1:$SELECT(COMSEG["-":$PIECE(COMSEG,"-",2),1:+COMSEG)
Begin DoDot:2
+35 IF '$DATA(^TMP($JOB,"PSOPTLST","DILIST",2,J))
QUIT
+36 SET PATFLTR(^TMP($JOB,"PSOPTLST","DILIST",2,J))=""
End DoDot:2
End DoDot:1
+37 KILL ^TMP($JOB,"PSOPTLST")
+38 QUIT
+39 ;
PATLHDR(PATTYP) ; - Prints the Patient List Header
+1 ;Input: Patient Type - "V": VistA Patient | "E": eRx Patient
+2 NEW XX
WRITE !?73,"LAST",!,"#",?4,$SELECT(PATTYP="E":"ERX",1:"VISTA")_" PATIENT NAME",?35,"DOB",?47,"CITY",?71,"REC.DATE"
+3 SET $PIECE(XX,"-",80)=""
WRITE !,XX
+4 QUIT
+5 ;
DOBFLTR ; - DOB Filter
+1 NEW DIR,Y,X
+2 IF $GET(DOBFLTR)
SET DIR("B")=$$FMTE^XLFDT(DOBFLTR,"2Z")
+3 SET DIR(0)="DA^:"_DT_":EX"
SET DIR("A")="Date of Birth (DOB): "
+4 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+5 SET DOBFLTR=Y
+6 QUIT
+7 ;
MATFLTR ; - Match Status Filter
+1 NEW DIR,Y,X
+2 SET DIR("A")="MATCH STATUS"
+3 SET DIR(0)="SO^1:"_$SELECT($GET(MBMSITE):"PATIENT FAIL - ",1:"")_"PATIENT NOT MATCHED"
+4 SET DIR(0)=DIR(0)_";2:"_$SELECT($GET(MBMSITE):"PROVIDER FAIL - ",1:"")_"PROVIDER NOT MATCHED"
+5 SET DIR(0)=DIR(0)_";3:"_$SELECT($GET(MBMSITE):"DRUG FAIL - ",1:"")_"DRUG NOT MATCHED"
+6 SET DIR(0)=DIR(0)_";4:"_$SELECT($GET(MBMSITE):"BASIC - ",1:"")_"PATIENT, PROVIDER AND DRUG MATCHED"
+7 IF $GET(PSOSTFLT)="WP"
SET DIR(0)=DIR(0)_";5:ALL (NO FILTERS)"
SET DIR("B")=5
+8 WRITE !
DO ^DIR
IF $DATA(DUOUT)!($DATA(DIRUT))
QUIT
+9 SET MATFLTR=Y
+10 QUIT
+11 ;
ERXFLTR() ; - eRx ID Filter
+1 NEW DIC,Y,DTOUT,DUOUT,QUIT,ERXID,ERXPTIEN
+2 KILL ERXFLTR
+3 WRITE !
SET DIC="52.49"
SET DIC(0)="QEA"
SET DIC("A")="ERX REFERENCE NUMBER: "
+4 SET QUIT=0
+5 FOR
Begin DoDot:1
+6 DO ^DIC
IF $DATA(DTOUT)!$DATA(DUOUT)!'Y!(X="")
SET QUIT=1
QUIT
+7 SET ERXID=+Y
+8 IF 'ERXID
WRITE !,"This prescription is not an eRx prescription."
QUIT
+9 IF '$GET(MBMSITE)
IF $$GET1^DIQ(52.49,ERXID,24.1,"I")'=PSNPINST
Begin DoDot:2
+10 WRITE !!,"eRx belongs to a different Division: "_$$GET1^DIQ(52.49,ERXID,24.1),!,$CHAR(7)
End DoDot:2
QUIT
+11 SET ERXPTIEN=+$$GET1^DIQ(52.49,ERXID,.04,"I")
+12 ; - Locking the eRx Patient
+13 IF '$$LOCK^PSOERPC1(ERXPTIEN)
Begin DoDot:2
+14 WRITE !!,"The patient for this eRx is currently locked by "_$$GET1^DIQ(200,+$GET(^XTMP("PSOERXLOCK",ERXPTIEN)),.01)_".",!,$CHAR(7)
HANG 1
End DoDot:2
QUIT
+15 SET ERXFLTR=ERXID
SET QUIT=1
End DoDot:1
if QUIT
QUIT
+16 QUIT
+17 ;
RXFLTR() ; - Rx # Filter
+1 NEW DIC,Y,DTOUT,DUOUT,QUIT,ERXID,ERXPTIEN
+2 KILL ERXFLTR
+3 WRITE !
SET DIC="52"
SET DIC(0)="QEAM"
SET DIC("A")="VISTA Rx #: "
+4 SET QUIT=0
+5 FOR
Begin DoDot:1
+6 DO ^DIC
IF $DATA(DTOUT)!$DATA(DUOUT)!'Y!(X="")
SET QUIT=1
QUIT
+7 SET ERXID=$$ERXIEN^PSOERXUT(+Y)
+8 IF 'ERXID
WRITE !,"This prescription is not an eRx prescription."
QUIT
+9 IF '$GET(MBMSITE)
IF $$GET1^DIQ(52.49,ERXID,24.1,"I")'=PSNPINST
Begin DoDot:2
+10 WRITE !!,"eRx belongs to a different Division: "_$$GET1^DIQ(52.49,ERXID,24.1),!,$CHAR(7)
End DoDot:2
QUIT
+11 SET ERXPTIEN=+$$GET1^DIQ(52.49,ERXID,.04,"I")
+12 ; - Locking the eRx Patient
+13 IF '$$LOCK^PSOERPC1(ERXPTIEN)
Begin DoDot:2
+14 WRITE !!,"The patient for this eRx is currently locked by "_$$GET1^DIQ(200,+$GET(^XTMP("PSOERXLOCK",ERXPTIEN)),.01)_".",!,$CHAR(7)
HANG 1
End DoDot:2
QUIT
+15 SET ERXFLTR=ERXID
SET QUIT=1
End DoDot:1
if QUIT
QUIT
+16 QUIT
+17 ;
RF ; - Remove All Filters
+1 KILL PATFLTR,VPATFLTR,DOBFLTR,MATFLTR
DO REF
SET VALMBG=1
+2 QUIT
+3 ;
CS ; - Group/Un-group Controlled Substances
+1 SET PSOCSGRP=$SELECT($GET(PSOCSGRP):0,1:1)
DO REF
+2 QUIT
+3 ;
CV ; - Change View
+1 DO EN^PSOERPR0
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 ;
SEL ; - Process selection of one entry
+1 NEW PSOSEL,ERXPTIEN,TMPLKBKD
+2 SET VALMBCK="R"
KILL PSONEXTP
+3 SET PSOSEL=+$PIECE(XQORNOD(0),"=",2)
IF 'PSOSEL
SET VALMSG="Invalid selection!"
SET VALMBCK="R"
QUIT
+4 SET ERXPTIEN=$GET(^TMP("PSOERPC0",$JOB,PSOSEL,"PATIEN"))
IF 'ERXPTIEN
SET VALMSG="Invalid selection!"
SET VALMBCK="R"
QUIT
+5 ; - Locking the eRx Patient
+6 IF '$$LOCK^PSOERPC1(ERXPTIEN)
QUIT
+7 ; - Entering the Single Patient View (Protecting Preference Parameters)
Begin DoDot:1
+8 NEW PSOSRTBY,PSORDER,PSOCSGRP,PSOALLST
+9 SET TMPLKBKD=PSOLKBKD
DO LST^PSOERPT0(ERXPTIEN)
+10 IF $GET(RESETLBD)
SET PSOLKBKD=TMPLKBKD
End DoDot:1
+11 ; - Unlocking the eRx Patient
+12 DO UL^PSOERX1A(ERXPTIEN)
+13 IF $GET(PSORFRSH)
DO REF
+14 QUIT
+15 ;
NEXTPAT ; Automatically Selects the Next Patient
+1 NEW ERXPTIEN,NEXTPAT,PTLOCKED
+2 SET VALMBCK="R"
SET NEXTPAT=0
SET PTLOCKED=1
+3 ; - Locking the eRx Patient
+4 FOR
SET ERXPTIEN=$$NEXTPAT^PSOERPC1(NEXTPAT)
if 'ERXPTIEN
QUIT
if $$LOCK^PSOERPC1(ERXPTIEN)
QUIT
if $DATA(^XTMP("PSOERXWP",ERXPTIEN,DUZ))
SET PTLOCKED=0
if $DATA(^XTMP("PSOERXWP",ERXPTIEN,DUZ))
QUIT
Begin DoDot:1
+5 SET NEXTPAT=ERXPTIEN
IF PSOSTFLT="WP"
KILL ^XTMP("PSOERXWP",ERXPTIEN,DUZ)
End DoDot:1
+6 IF 'ERXPTIEN
QUIT
+7 IF PSOSTFLT="WP"
IF $DATA(^XUSEC("PSO ERX WORKLOAD TECH",DUZ))
SET ^XTMP("PSOERXWP",ERXPTIEN,DUZ)=""
+8 ; - Entering the Single Patient View (Protecting Preference Parameters)
Begin DoDot:1
+9 NEW PSOSRTBY,PSORDER,PSOCSGRP,PSOALLST
+10 DO LST^PSOERPT0(ERXPTIEN)
End DoDot:1
+11 ; - Unlocking the eRx Patient
+12 if $GET(PTLOCKED)
DO UL^PSOERX1A(ERXPTIEN)
+13 QUIT
+14 ;
RX ; - Switch to Rx View
+1 DO EN^PSOERRX0
SET VALMBCK="Q"
+2 QUIT
+3 ;
REF ; - Screen Refresh
+1 WRITE ?65,"Please wait..."
DO INIT
DO HDR
DO REVLOCKS^PSOERPC2
SET VALMBCK="R"
+2 SET PSORFRSH=0
+3 QUIT
+4 ;
EXIT ; - exit code
+1 KILL ^TMP("PSOERPC0",$JOB),^TMP("PSOERPCS",$JOB),^TMP("PSOERPAT",$JOB)
+2 DO FULL^VALM1
+3 QUIT
