PSOERPC1 ;BIRM/MFR - All Patients (Patient Centric) eRx Queue - Supporting APIs 1 ; 12/10/22 10:07am
;;7.0;OUTPATIENT PHARMACY;**700,750,746**;DEC 1997;Build 106
;
HDR ; - Displays the Header Line
N LINE1,LINE2,HDR,SRTORD,SRTPOS
S LINE1="LOOK BACK DAYS: "_IOINHI_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(MATFLTR) D
. N FILTER S FILTER=""
. I $G(MATFLTR) S FILTER=FILTER_"|MATCH("_$$MATCHLBL^PSOERPC2(MATFLTR)_")"
. I $G(DOBFLTR) S FILTER=FILTER_"|DOB("_$$FMTE^XLFDT(DOBFLTR,"2Z")_")"
. I $D(PATFLTR) S FILTER=FILTER_"|PATIENT("_$$EPATFLST^PSOERUT(53)_")"
. S $E(FILTER,1)="" I $L(FILTER)>63 S FILTER=$E(FILTER,1,60)_"..."
. S FILTER=FILTER
. S LINE2="FILTERED BY: "_IOINHI_FILTER_IOINORM
K VALMHDR S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2
;
S HDR="#",$E(HDR,5)="PATIENT",$E(HDR,30)="DOB",$E(HDR,41)="SSN",$E(HDR,54)="ED"
S $E(HDR,58)="NW",$E(HDR,61)="WT",$E(HDR,64)="IP",$E(HDR,67)="HD",$E(HDR,70)="CCR"
S $E(HDR,74)="OTH",$E(HDR,78)="TOT"
D INSTR^VALM1(IORVON_HDR_IOINORM,1,4)
S SRTORD=$S(PSORDER="A":"^",1:"v")
S SRTPOS=$S(PSOSRTBY="PA":12,PSOSRTBY="DOB":33,PSOSRTBY="ED":56)
D INSTR^VALM1(IOINHI_IORVON_SRTORD_IOINORM,SRTPOS,4)
Q
;
SETSORT ; - Set Patient List
N EXPAT,MSGDT,ERXIEN,STSIEN,STSLST,ERXSTS,INST
S PATCNT=0
; - Filter By eRx Patient is set
I $D(PATFLTR) D Q
. S ERXPAT="" F S ERXPAT=$O(PATFLTR(ERXPAT)) Q:'ERXPAT D I PATCNT'<PSOMAXQS Q
. . I $G(DOBFLTR),'$D(^PS(52.46,"DOB",DOBFLTR,ERXPAT)) Q
. . S MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
. . F S MSGDT=$O(^PS(52.49,"PAT2",ERXPAT,MSGDT)) Q:'MSGDT D I PATCNT'<PSOMAXQS Q
. . . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"PAT2",ERXPAT,MSGDT,ERXIEN)) Q:'ERXIEN D I PATCNT'<PSOMAXQS Q
. . . . D SETPAT(ERXIEN,.PATCNT)
;
; - 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 PATCNT'<PSOMAXQS Q
. . I $D(PATFLTR),'$D(PATFLTR(ERXPAT)) Q
. . S MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
. . F S MSGDT=$O(^PS(52.49,"PAT2",ERXPAT,MSGDT)) Q:'MSGDT D I PATCNT'<PSOMAXQS Q
. . . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"PAT2",ERXPAT,MSGDT,ERXIEN)) Q:'ERXIEN D I PATCNT'<PSOMAXQS Q
. . . . D SETPAT(ERXIEN,.PATCNT)
;
; - Specific Status(es) Selected
I $G(PSOSTFLT)'="A" D Q
. D LOADSTS(.STSLST)
. I '$G(MBMSITE) D
. . S ERXSTS=0 F S ERXSTS=$O(STSLST(ERXSTS)) Q:'ERXSTS D I PATCNT'<PSOMAXQS Q
. . . S MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
. . . F S MSGDT=$O(^PS(52.49,"E",+$G(PSNPINST),ERXSTS,MSGDT)) Q:'MSGDT D I PATCNT'<PSOMAXQS Q
. . . . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"E",+$G(PSNPINST),ERXSTS,MSGDT,ERXIEN)) Q:'ERXIEN D I PATCNT'<PSOMAXQS Q
. . . . . D SETPAT(ERXIEN,.PATCNT)
. E D
. . S MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
. . F S MSGDT=$O(^PS(52.49,"AMSGDTSTS",MSGDT)) Q:'MSGDT D I PATCNT'<PSOMAXQS Q
. . . S ERXSTS=0 F S ERXSTS=$O(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS)) Q:'ERXSTS D I PATCNT'<PSOMAXQS Q
. . . . I '$D(STSLST(ERXSTS)) Q
. . . . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS,ERXIEN)) Q:'ERXIEN D I PATCNT'<PSOMAXQS Q
. . . . . D SETPAT(ERXIEN,.PATCNT)
;
; - No Filters (Catch All)
S MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
F S MSGDT=$O(^PS(52.49,"AMSGDTSTS",MSGDT)) Q:'MSGDT D I PATCNT'<PSOMAXQS Q
. S ERXSTS=0 F S ERXSTS=$O(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS)) Q:'ERXSTS D I PATCNT'<PSOMAXQS Q
. . I '$$ELIGSTS("PC",$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 PATCNT'<PSOMAXQS Q
. . . ; Related Institution Check (VAMCs only)
. . . I '$G(MBMSITE),+$G(^PS(52.49,ERXIEN,24))'=PSNPINST Q
. . . D SETPAT(ERXIEN,.PATCNT)
Q
;
SETPAT(ERXIEN,PATCNT) ; - Builds a sorted list of Patients
;Input: (r)ERXIEN - eRx IEN (Pointer to #52.49)
; (r)PATCNT - (by Ref) Counter for Patient (used to control the max number of patients in the list)
N EPATIEN,PATNAME,ERXNODE0,ERXINST,DOB,ESCODE,MTYPE,DRGCSCH,PATSTATS,RCVDATE,Z,SORT,ED
N VPATIEN,VPRVIEN,VDRGIEN,CSERX,ERXINST,EPTNODE0,EPTNODE1,EPTNODE2,GRP,SRT,SSN,STSIEN,ERXSTS
;
S ERXNODE0=$G(^PS(52.49,ERXIEN,0))
S STSIEN=+$G(^PS(52.49,ERXIEN,1)) I 'STSIEN Q
S ERXSTS=$P($G(^PS(52.45,STSIEN,0)),"^")
S EPATIEN=+$P(ERXNODE0,"^",4) I 'EPATIEN Q
; - Patient already on the list (or excluded by Basic Match filter)
I $D(^TMP("PSOERPAT",$J,EPATIEN)) Q
;
S MTYPE=$P(ERXNODE0,"^",8)
S ERXINST=+$G(^PS(52.49,ERXIEN,24)),CSERX=+$G(^PS(52.49,ERXIEN,95))
; If the eRx is a new refill request and the status is refill request new, check for a response.
; If no response within 14 days, change to RRE (refill request expired)
I MTYPE="RR",ERXSTS="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",ERXSTS="CRN" D CHKEXP^PSOERX(ERXIEN,MTYPE)
;
; - Related Institution Filter (Non-MbM sites only)
I '$G(MBMSITE),PSNPINST'=ERXINST Q
;
; - Controlled Substance Prompts Filter
I $G(PSOCSERX)="CS",'CSERX Q
I $G(PSOCSERX)="Non-CS",CSERX Q
I '$$CSFILTER^PSOERXUT(ERXIEN) Q
;
; - Match Status Filter
I $G(MATFLTR),'$$MATCHFLT^PSOERPC2(MATFLTR,EPATIEN) S ^TMP("PSOERPAT",$J,EPATIEN)="" Q
;
; - Checking/Filtering Statuses
I '$$ELIGSTS("PC",ERXSTS,MTYPE) Q
;
S Z=$$PATSTATS(EPATIEN),SORT=EPATIEN
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,"^") S:PSOSRTBY="PA" SORT=PATNAME_" "_EPATIEN
S DOB=$P(EPTNODE1,"^",4) S:PSOSRTBY="DOB" SORT=DOB_" "_EPATIEN
S SSN=$P(EPTNODE2,"^",4)
S:PSOSRTBY="ED" ED=+Z,SORT=$E(ED+10000,2,5)_" "_(1000000000-ERXIEN)
S CSERX=+$P(Z,"^",8),CSGROUP=$S('PSOCSGRP:"ALL",CSERX:"CS",1:"NON-CS")
S ^TMP("PSOERPCS",$J,CSGROUP,SORT)=PATNAME_"^"_$$FMTE^XLFDT(DOB,"5DZ")_"^"_SSN_"^"_Z
S ^TMP("PSOERPCS",$J,CSGROUP,SORT,"PATIEN")=EPATIEN
S ^TMP("PSOERPAT",$J,EPATIEN)=""
S PATCNT=$G(PATCNT)+1
Q
;
PATSTATS(PATIEN) ; Set the Numbers (Stat Columns data) of eRx by Patient
; Input: PATIEN - eRx Patient IEN (Pointer to #52.46)
;Output: Patient Stats: P1: Highest Elapsed Days
; P2: Number of New eRx's
; P3: Number of eRx's on 'Wait' Status
; P4: Number of eRx's on 'In Progress' Statuses
; P5: Number of eRx's on 'On Hold' Statuses
; P6: Number of eRx's on 'CCR' Statuses
; P7: Number of eRx's on 'Other' Statuses
; P8: Number of CS eRx's
N PATSTATS,MSGDT,ERXIEN,CSERX,STSIEN,EXTSTS
I '$G(PSOLKBKD) S PSOLKBKD=$$GET1^DIQ(59,PSOSITE,10.2) S:'PSOLKBKD PSOLKBKD=365
S MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD),PATSTATS=""
F S MSGDT=$O(^PS(52.49,"PAT2",PATIEN,MSGDT)) Q:'MSGDT D
. S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"PAT2",PATIEN,MSGDT,ERXIEN)) Q:'ERXIEN D
. . S CSERX=+$G(^PS(52.49,ERXIEN,95))
. . S MTYPE=$P($G(^PS(52.49,ERXIEN,0)),"^",8)
. . ; eRx Status Check
. . S STSIEN=+$G(^PS(52.49,ERXIEN,1)) I 'STSIEN Q
. . S EXTSTS=$P($G(^PS(52.45,STSIEN,0)),"^")
. . I '$$ELIGSTS("PC",EXTSTS,MTYPE) Q
. . ; - CS/Non-CS Filter
. . I $G(PSOCSERX)="Non-CS",CSERX Q
. . I $G(PSOCSERX)="CS",'CSERX Q
. . ; - Setting Largest Elapsed Days (1st piece)
. . I $$FMDIFF^XLFDT(DT,MSGDT)>+PATSTATS D
. . . S $P(PATSTATS,"^",1)=$$FMDIFF^XLFDT(DT,MSGDT)
. . ; - Data for the eRx Count columns (New, In Progress, Wait, on Hold, CCR, Other)
. . I EXTSTS="N" S $P(PATSTATS,U,2)=$P(PATSTATS,U,2)+1
. . I ",W,RXW,CXW,"[(","_EXTSTS_",") S $P(PATSTATS,U,3)=$P(PATSTATS,U,3)+1
. . I ",I,RXI,CXI,"[(","_EXTSTS_",") S $P(PATSTATS,U,4)=$P(PATSTATS,U,4)+1
. . I $E(EXTSTS)="H" S $P(PATSTATS,U,5)=$P(PATSTATS,U,5)+1
. . I ",RXN,RXE,RXR,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,"[(","_EXTSTS_",") D
. . . S $P(PATSTATS,U,6)=$P(PATSTATS,U,6)+1
. . I MTYPE="IE",",RRE,CRE,"[(","_EXTSTS_",") S $P(PATSTATS,U,7)=$P(PATSTATS,U,7)+1
. . I $G(PSOCSERX)'="Non-CS",CSERX S $P(PATSTATS,U,8)=$P(PATSTATS,U,8)+1
Q PATSTATS
;
ELIGSTS(VIEW,ERXSTS,MSGTYPE) ; Checks whether the eRx's status is eligible to be on the list (counted)
; Input: VIEW - View: "PC" - Patient Centric View | "RX" - Rx Medication View
; ERXSTS - eRx Status (External format: e.g.,"N","HDI", "I", etc...)
; [o]MSGTYPE - Message Type ("N","RE","RR","CR", etc...)
;Output: 1 - eRx is eligible to be on the list | 0 - eRx is not Eligible to be on the list
N STS,CCRSTS,SKIP
S MSGTYPE=$G(MSGTYPE)
;
; If Any filter is selected, ignore the initial filter (upon entering the option)
S STS=","_$S($E(ERXSTS)="H":$E(ERXSTS,1),$G(MBMSITE)&($E(ERXSTS,1,3)="REM"):"REM",1:ERXSTS)_","
; List is not Filtered
I '$$FILTERED(VIEW),",RJ,RM,REM,PR,E,RXA,CXA,CAA,CXP,RXP,RXC,RRC,RXA,CAN,ICA,CNP,CRP,CRC,CXC,CNE,CRN,CRE,CRR,CRX,RRX,CXQ,RXA,"[STS Q 0
I VIEW="PC",",RRE,RXI,RXW,RXR,RXE,RXN,RXD,RXF,CAH,CAO,CAP,CAR,CAX,CAF,CXD,CXN,CXV,CXY,CXE,CXI,CXW,CRE,N,I,W,H,"'[STS Q 0
; Match Status Filter (Only New, In Progress, Wait or Hold statuses are included)
I $G(MATFLTR) I ",N,RXN,CXN,RXI,I,CXI,RXW,W,CXW,"'[STS Q 0
;
; Filter Inbound Error RRE and RenewalRequests For Patient Centric View
I '$$FILTERED(VIEW) Q:((MSGTYPE="IE")&(ERXSTS'="RRE")&(ERXSTS'="CRE")) 0 Q:(MSGTYPE="RR") 0
I VIEW="PC",'$$FILTERED(VIEW),MSGTYPE="RE","RXP,RXC,RXA,RRP,"[STS Q 0
;
I '$G(STSFLTR),$G(MSTPFLTR)="",MSGTYPE="CR",ERXSTS="CRE" Q 0
;
S SKIP=0
I '$$FILTERED(VIEW) D I SKIP Q 0
. I $G(PSOSTFLT)="N",",RXN,N,CXN,"'[STS S SKIP=1
. I $G(PSOSTFLT)="I",",RXI,I,CXI,"'[STS S SKIP=1
. I $G(PSOSTFLT)="W",",RXW,W,CXW,"'[STS S SKIP=1
. I $G(PSOSTFLT)="C" D S SKIP=$S(PSOCCRST="ALL"&(CCRSTS[STS):0,PSOCCRST'="ALL"&(PSOCCRST=ERXSTS):0,1:1)
. . S CCRSTS=",RXN,RXR,RXE,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,"
. I $G(PSOSTFLT)="H" S SKIP=$S(PSOHDSTS="ALL"&(STS=",H,"):0,PSOHDSTS'="ALL"&(PSOHDSTS=ERXSTS):0,1:1)
; Default: Eligible
Q 1
;
FILTERED(VIEW) ; Return whether the list is being filtered or not
; Input: VIEW - View: "PC" - Patient Centric View | "RX" - Rx Medication View
;Output: 0 - No filters | 1 - Filters are in place
I $G(VIEW)="PC",$D(PATFLTR)!$G(DOBFLTR)!$G(MATFLTR) Q 1
I $G(VIEW)="RX",$D(PATFLTR)!$G(DOBFLTR)!$G(REDTFLTR)!$D(PRVFLTR)!$G(STSFLTR)!($G(DRGFLTR)'="")!($G(MSTPFLTR)'="")!$G(MATFLTR)!$G(PSOALLST) Q 1
Q 0
;
HLDSTS() ; - Prompt User for Hold eRx Status
N Y,DIC,X,HLDSTS
S DIC("A")="Select eRx Status: "
S DIC=52.45,DIC(0)="AEQ",DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y)),($E($P(^PS(52.45,Y,0),U))=""H"")"
S DIC("W")="W "" - "",$P($G(^(0)),""^"",2)"
W ! D ^DIC K DIC I X=U!($D(DUOUT))!(Y<1) Q ""
S HLDSTS=$$UP^XLFSTR(X) I +HLDSTS S HLDSTS=$$GET1^DIQ(52.45,+HLDSTS,.01)
Q HLDSTS
;
CCRSTS(LST) ; - Prompt User for CCR eRx Status
N I,DONE,DIC,Y,X,CODE,CARY,CIEN
S DONE=0
F I=1:1 D Q:DONE
.S CODE=$P(LST,U,I) I CODE="" S DONE=1 Q
.S CIEN=$$PRESOLV^PSOERXA1(CODE,"ERX")
.S CARY(CIEN)=""
S DIC("A")="Select eRx Status: "
S DIC=52.45,DIC(0)="AEQ",DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y)),$D(CARY(Y))"
S DIC("W")="W "" - "",$P($G(^(0)),""^"",2)"
W ! D ^DIC K DIC I X=U!($D(DUOUT))!(Y<1) Q ""
Q X
;
NEXTPAT(CURPTIEN) ; Returns the next Patient on the Queue to be worked on
; Input: (o)CURPTIEN - Current eRx Patient IEN (Pointer to #52.46) (If not passed, start with first patient)
;Output: NEXTPAT - Next eRx Patient on the Queue
N NEXTPAT,STSLST,ERXSTS,STS,MSGDT,ERXIEN,EPATIEN,VPATIEN,VPRVIEN,VDRGIEN,ERXNODE0,ERXSTS,CSERX,LKBKDAYS,REACH
K ^TMP("PSOERSKP",$J)
D LOADSTS(.STSLST)
S (NEXTPAT,INST)=0
S LKBKDAYS=PSOLKBKD I PSOSTFLT="WP",$$GET1^DIQ(59,PSOSITE,10.2)>PSOLKBKD S LKBKDAYS=$$GET1^DIQ(59,PSOSITE,10.2)
S MSGDT=$$FMADD^XLFDT(DT,-LKBKDAYS)-.1,REACH=$S($G(CURPTIEN):0,1:1)
F S MSGDT=$O(^PS(52.49,"AMSGDTSTS",MSGDT)) Q:'MSGDT D I NEXTPAT Q
. S ERXSTS=999999 F S ERXSTS=$O(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS),-1) Q:'ERXSTS D I NEXTPAT Q
. . ; eRx Status Check
. . I '$D(STSLST(ERXSTS)) Q
. . S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS,ERXIEN)) Q:'ERXIEN D I NEXTPAT Q
. . . ; Related Institution Check
. . . I '$G(MBMSITE),+$G(^PS(52.49,ERXIEN,24))'=$G(PSNPINST) Q
. . . S ERXNODE0=$G(^PS(52.49,ERXIEN,0))
. . . S EPATIEN=+$P(ERXNODE0,"^",4),VPATIEN=+$P(ERXNODE0,"^",5),CSERX=+$G(^PS(52.49,ERXIEN,95))
. . . S VPRVIEN=+$P($G(^PS(52.49,ERXIEN,2)),"^",3),VDRGIEN=+$P($G(^PS(52.49,ERXIEN,3)),"^",2)
. . . I $D(^TMP("PSOERSKP",$J,EPATIEN)) Q
. . . I $G(CURPTIEN),EPATIEN=CURPTIEN S REACH=1 Q
. . . I 'REACH S ^TMP("PSOERSKP",$J,EPATIEN)="" Q
. . . ; - Match Status Filter
. . . I $G(MATFLTR),'$$MATCHFLT^PSOERPC2(MATFLTR,EPATIEN) S ^TMP("PSOERSKP",$J,EPATIEN)="" Q
. . . ; - CS/Non-CS Parameter Status Filter
. . . I $G(PSOCSERX)="CS",'CSERX Q
. . . I $G(PSOCSERX)="Non-CS",CSERX Q
. . . I PSOSTFLT="WP",$D(^XUSEC("PSO ERX WORKLOAD TECH",DUZ)),$D(^XTMP("PSOERXWP",EPATIEN)),'$D(^XTMP("PSOERXWP",EPATIEN,DUZ)) Q
. . . S NEXTPAT=EPATIEN
K ^TMP("PSOERSKP",$J)
I $G(CURPTIEN),'NEXTPAT,$$NEXTPAT(0)'=CURPTIEN S NEXTPAT=$$NEXTPAT(0)
I PSOSTFLT="WP",NEXTPAT,$D(^XUSEC("PSO ERX WORKLOAD TECH",DUZ)) S ^XTMP("PSOERXWP",NEXTPAT,DUZ)=""
Q NEXTPAT
;
LOADSTS(STSLST) ; Load Status Filter Array based on the Filter selected
;Output: STSLST - Return Array passed in by Reference with status IEN as Index (e.g., ARRAY(124))
N STS
K STSLST
S PSOSTFLT=$G(PSOSTFLT),PSOCCRST=$G(PSOCCRST),PSOHDSTS=$G(PSOHDSTS)
I PSOSTFLT="A"!(PSOSTFLT="N") S STSLST($$STSIEN("N"))=""
I PSOSTFLT="WP" F STS="N","I","W" S STSLST($$STSIEN(STS))=""
I PSOSTFLT="A"!(PSOSTFLT="I") F STS="I","RXI","CXI" S STSLST($$STSIEN(STS))=""
I PSOSTFLT="A"!(PSOSTFLT="W") F STS="W","RXW","CXW" S STSLST($$STSIEN(STS))=""
I PSOSTFLT="A"!(PSOSTFLT="C") D
. I PSOSTFLT="A"!(PSOCCRST="ALL") D
. . F STS="RXN","RXR","RXE","RXD","RXF","CAO","CAR","CAH","CAP","CAX","CAF","CXD","CXN","CXV","CXY","CXE","RRE" D
. . . S STSLST($$STSIEN(STS))=""
. E I PSOCCRST'="" S STSLST($$STSIEN(PSOCCRST))=""
I PSOSTFLT="A"!(PSOSTFLT="H") D
. I PSOSTFLT="A"!(PSOHDSTS="ALL") D
. . S STS="GZ" F S STS=$O(^PS(52.45,"B",STS)) Q:$E(STS)'="H"!(STS="") D
. . . S STSLST($$STSIEN(STS))=""
. E I PSOHDSTS'="" S STSLST($$STSIEN(PSOHDSTS))=""
Q
;
STSIEN(STS) ; Returns the eRx Status IEN
; Input: STS - eRx Status (external format, e.g., 'N', 'I', 'RXN', etc.)
;Output: ### - eRx Status IEN (internal format - pointer to #52.45)
I $G(STS)="" Q 0
Q +$O(^PS(52.45,"B",$G(STS),0))
;
LOCK(PATIEN) ; Locks eRx Patient
; Input: PATIEN - eRx Patient IEN (Pointer to #52.46)
;Output: 1 - Patient Locked Successfully | Patient Not Locked (Already Locked)
; - Locking the eRx Patient
N ERXLOCK
S ERXLOCK=$$L^PSOERX1A(PATIEN,1,1)
I 'ERXLOCK D Q 0
. S VALMSG="Patient Locked"
. I $G(^XTMP("PSOERXLOCK",PATIEN)) D
. . S VALMSG=VALMSG_":"_$E($$GET1^DIQ(200,+$G(^XTMP("PSOERXLOCK",PATIEN)),.01),1,20)
. . S VALMSG=VALMSG_"|"_$$FMTE^XLFDT($P($G(^XTMP("PSOERXLOCK",PATIEN)),"^",2),"2Z")
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERPC1 15883 printed Oct 16, 2024@18:28:24 Page 2
PSOERPC1 ;BIRM/MFR - All Patients (Patient Centric) eRx Queue - Supporting APIs 1 ; 12/10/22 10:07am
+1 ;;7.0;OUTPATIENT PHARMACY;**700,750,746**;DEC 1997;Build 106
+2 ;
HDR ; - Displays the Header Line
+1 NEW LINE1,LINE2,HDR,SRTORD,SRTPOS
+2 SET LINE1="LOOK BACK DAYS: "_IOINHI_PSOLKBKD_IOINORM
+3 SET $EXTRACT(LINE1,40)="CS/NON-CS: "_IOINHI_$SELECT(PSOCSERX="CS":"CS ONLY",PSOCSERX="Non-CS":"NON-CS ONLY",1:"BOTH")
+4 if PSOCSERX'="Non-CS"
SET LINE1=LINE1_" ("_$SELECT(PSOCSSCH=1:"II",PSOCSSCH=2:"III-V",1:"II-V")_")"
+5 SET LINE1=LINE1_IOINORM
+6 DO INSTR^VALM1("MAX. QUEUE SIZE: "_IOINHI_$JUSTIFY(PSOMAXQS,4)_IOINORM,60,2)
+7 ;
+8 SET LINE2="ERX STATUS: "_IOINHI
+9 IF PSOSTFLT="A"
SET LINE2=LINE2_"ALL"
+10 IF PSOSTFLT="N"
SET LINE2=LINE2_"NEW"
+11 IF PSOSTFLT="I"
SET LINE2=LINE2_"IN PROGRESS"
+12 IF PSOSTFLT="W"
SET LINE2=LINE2_"WAIT"
+13 IF PSOSTFLT="H"
SET LINE2=LINE2_$SELECT(PSOHDSTS="ALL":"HOLD (ALL)",1:"HOLD ("_PSOHDSTS_")")
+14 IF PSOSTFLT="C"
SET LINE2=LINE2_$SELECT(PSOCCRST="ALL":"CCR (ALL)",1:"CCR ("_PSOCCRST_")")
+15 SET LINE2=LINE2_IOINORM
+16 SET LINE3=""
+17 IF $DATA(PATFLTR)!$GET(DOBFLTR)!$GET(MATFLTR)
Begin DoDot:1
+18 NEW FILTER
SET FILTER=""
+19 IF $GET(MATFLTR)
SET FILTER=FILTER_"|MATCH("_$$MATCHLBL^PSOERPC2(MATFLTR)_")"
+20 IF $GET(DOBFLTR)
SET FILTER=FILTER_"|DOB("_$$FMTE^XLFDT(DOBFLTR,"2Z")_")"
+21 IF $DATA(PATFLTR)
SET FILTER=FILTER_"|PATIENT("_$$EPATFLST^PSOERUT(53)_")"
+22 SET $EXTRACT(FILTER,1)=""
IF $LENGTH(FILTER)>63
SET FILTER=$EXTRACT(FILTER,1,60)_"..."
+23 SET FILTER=FILTER
+24 SET LINE2="FILTERED BY: "_IOINHI_FILTER_IOINORM
End DoDot:1
+25 KILL VALMHDR
SET VALMHDR(1)=LINE1
SET VALMHDR(2)=LINE2
+26 ;
+27 SET HDR="#"
SET $EXTRACT(HDR,5)="PATIENT"
SET $EXTRACT(HDR,30)="DOB"
SET $EXTRACT(HDR,41)="SSN"
SET $EXTRACT(HDR,54)="ED"
+28 SET $EXTRACT(HDR,58)="NW"
SET $EXTRACT(HDR,61)="WT"
SET $EXTRACT(HDR,64)="IP"
SET $EXTRACT(HDR,67)="HD"
SET $EXTRACT(HDR,70)="CCR"
+29 SET $EXTRACT(HDR,74)="OTH"
SET $EXTRACT(HDR,78)="TOT"
+30 DO INSTR^VALM1(IORVON_HDR_IOINORM,1,4)
+31 SET SRTORD=$SELECT(PSORDER="A":"^",1:"v")
+32 SET SRTPOS=$SELECT(PSOSRTBY="PA":12,PSOSRTBY="DOB":33,PSOSRTBY="ED":56)
+33 DO INSTR^VALM1(IOINHI_IORVON_SRTORD_IOINORM,SRTPOS,4)
+34 QUIT
+35 ;
SETSORT ; - Set Patient List
+1 NEW EXPAT,MSGDT,ERXIEN,STSIEN,STSLST,ERXSTS,INST
+2 SET PATCNT=0
+3 ; - Filter By eRx Patient is set
+4 IF $DATA(PATFLTR)
Begin DoDot:1
+5 SET ERXPAT=""
FOR
SET ERXPAT=$ORDER(PATFLTR(ERXPAT))
if 'ERXPAT
QUIT
Begin DoDot:2
+6 IF $GET(DOBFLTR)
IF '$DATA(^PS(52.46,"DOB",DOBFLTR,ERXPAT))
QUIT
+7 SET MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
+8 FOR
SET MSGDT=$ORDER(^PS(52.49,"PAT2",ERXPAT,MSGDT))
if 'MSGDT
QUIT
Begin DoDot:3
+9 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"PAT2",ERXPAT,MSGDT,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:4
+10 DO SETPAT(ERXIEN,.PATCNT)
End DoDot:4
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:3
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:2
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:1
QUIT
+11 ;
+12 ; - Filter By eRx Patient DOB is set
+13 IF $GET(DOBFLTR)'=""
Begin DoDot:1
+14 SET ERXPAT=0
FOR
SET ERXPAT=$ORDER(^PS(52.46,"DOB",DOBFLTR,ERXPAT))
if 'ERXPAT
QUIT
Begin DoDot:2
+15 IF $DATA(PATFLTR)
IF '$DATA(PATFLTR(ERXPAT))
QUIT
+16 SET MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
+17 FOR
SET MSGDT=$ORDER(^PS(52.49,"PAT2",ERXPAT,MSGDT))
if 'MSGDT
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 SETPAT(ERXIEN,.PATCNT)
End DoDot:4
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:3
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:2
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:1
QUIT
+20 ;
+21 ; - Specific Status(es) Selected
+22 IF $GET(PSOSTFLT)'="A"
Begin DoDot:1
+23 DO LOADSTS(.STSLST)
+24 IF '$GET(MBMSITE)
Begin DoDot:2
+25 SET ERXSTS=0
FOR
SET ERXSTS=$ORDER(STSLST(ERXSTS))
if 'ERXSTS
QUIT
Begin DoDot:3
+26 SET MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
+27 FOR
SET MSGDT=$ORDER(^PS(52.49,"E",+$GET(PSNPINST),ERXSTS,MSGDT))
if 'MSGDT
QUIT
Begin DoDot:4
+28 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"E",+$GET(PSNPINST),ERXSTS,MSGDT,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:5
+29 DO SETPAT(ERXIEN,.PATCNT)
End DoDot:5
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:4
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:3
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:2
+30 IF '$TEST
Begin DoDot:2
+31 SET MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
+32 FOR
SET MSGDT=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT))
if 'MSGDT
QUIT
Begin DoDot:3
+33 SET ERXSTS=0
FOR
SET ERXSTS=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS))
if 'ERXSTS
QUIT
Begin DoDot:4
+34 IF '$DATA(STSLST(ERXSTS))
QUIT
+35 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:5
+36 DO SETPAT(ERXIEN,.PATCNT)
End DoDot:5
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:4
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:3
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:2
End DoDot:1
QUIT
+37 ;
+38 ; - No Filters (Catch All)
+39 SET MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
+40 FOR
SET MSGDT=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT))
if 'MSGDT
QUIT
Begin DoDot:1
+41 SET ERXSTS=0
FOR
SET ERXSTS=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS))
if 'ERXSTS
QUIT
Begin DoDot:2
+42 IF '$$ELIGSTS("PC",$PIECE($GET(^PS(52.45,ERXSTS,0)),"^"))
QUIT
+43 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:3
+44 ; Related Institution Check (VAMCs only)
+45 IF '$GET(MBMSITE)
IF +$GET(^PS(52.49,ERXIEN,24))'=PSNPINST
QUIT
+46 DO SETPAT(ERXIEN,.PATCNT)
End DoDot:3
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:2
IF PATCNT'<PSOMAXQS
QUIT
End DoDot:1
IF PATCNT'<PSOMAXQS
QUIT
+47 QUIT
+48 ;
SETPAT(ERXIEN,PATCNT) ; - Builds a sorted list of Patients
+1 ;Input: (r)ERXIEN - eRx IEN (Pointer to #52.49)
+2 ; (r)PATCNT - (by Ref) Counter for Patient (used to control the max number of patients in the list)
+3 NEW EPATIEN,PATNAME,ERXNODE0,ERXINST,DOB,ESCODE,MTYPE,DRGCSCH,PATSTATS,RCVDATE,Z,SORT,ED
+4 NEW VPATIEN,VPRVIEN,VDRGIEN,CSERX,ERXINST,EPTNODE0,EPTNODE1,EPTNODE2,GRP,SRT,SSN,STSIEN,ERXSTS
+5 ;
+6 SET ERXNODE0=$GET(^PS(52.49,ERXIEN,0))
+7 SET STSIEN=+$GET(^PS(52.49,ERXIEN,1))
IF 'STSIEN
QUIT
+8 SET ERXSTS=$PIECE($GET(^PS(52.45,STSIEN,0)),"^")
+9 SET EPATIEN=+$PIECE(ERXNODE0,"^",4)
IF 'EPATIEN
QUIT
+10 ; - Patient already on the list (or excluded by Basic Match filter)
+11 IF $DATA(^TMP("PSOERPAT",$JOB,EPATIEN))
QUIT
+12 ;
+13 SET MTYPE=$PIECE(ERXNODE0,"^",8)
+14 SET ERXINST=+$GET(^PS(52.49,ERXIEN,24))
SET CSERX=+$GET(^PS(52.49,ERXIEN,95))
+15 ; If the eRx is a new refill request and the status is refill request new, check for a response.
+16 ; If no response within 14 days, change to RRE (refill request expired)
+17 IF MTYPE="RR"
IF ERXSTS="RRN"
DO CHKEXP^PSOERX(ERXIEN,MTYPE)
+18 ; ChangeRequest messages will be checked for expiration status, but will not be displayed in the holding queue list view.
+19 IF MTYPE="CR"
IF ERXSTS="CRN"
DO CHKEXP^PSOERX(ERXIEN,MTYPE)
+20 ;
+21 ; - Related Institution Filter (Non-MbM sites only)
+22 IF '$GET(MBMSITE)
IF PSNPINST'=ERXINST
QUIT
+23 ;
+24 ; - Controlled Substance Prompts Filter
+25 IF $GET(PSOCSERX)="CS"
IF 'CSERX
QUIT
+26 IF $GET(PSOCSERX)="Non-CS"
IF CSERX
QUIT
+27 IF '$$CSFILTER^PSOERXUT(ERXIEN)
QUIT
+28 ;
+29 ; - Match Status Filter
+30 IF $GET(MATFLTR)
IF '$$MATCHFLT^PSOERPC2(MATFLTR,EPATIEN)
SET ^TMP("PSOERPAT",$JOB,EPATIEN)=""
QUIT
+31 ;
+32 ; - Checking/Filtering Statuses
+33 IF '$$ELIGSTS("PC",ERXSTS,MTYPE)
QUIT
+34 ;
+35 SET Z=$$PATSTATS(EPATIEN)
SET SORT=EPATIEN
+36 SET EPTNODE0=$GET(^PS(52.46,EPATIEN,0))
SET EPTNODE1=$GET(^PS(52.46,EPATIEN,1))
SET EPTNODE2=$GET(^PS(52.46,EPATIEN,2))
+37 SET PATNAME=$PIECE(EPTNODE0,"^")
if PSOSRTBY="PA"
SET SORT=PATNAME_" "_EPATIEN
+38 SET DOB=$PIECE(EPTNODE1,"^",4)
if PSOSRTBY="DOB"
SET SORT=DOB_" "_EPATIEN
+39 SET SSN=$PIECE(EPTNODE2,"^",4)
+40 if PSOSRTBY="ED"
SET ED=+Z
SET SORT=$EXTRACT(ED+10000,2,5)_" "_(1000000000-ERXIEN)
+41 SET CSERX=+$PIECE(Z,"^",8)
SET CSGROUP=$SELECT('PSOCSGRP:"ALL",CSERX:"CS",1:"NON-CS")
+42 SET ^TMP("PSOERPCS",$JOB,CSGROUP,SORT)=PATNAME_"^"_$$FMTE^XLFDT(DOB,"5DZ")_"^"_SSN_"^"_Z
+43 SET ^TMP("PSOERPCS",$JOB,CSGROUP,SORT,"PATIEN")=EPATIEN
+44 SET ^TMP("PSOERPAT",$JOB,EPATIEN)=""
+45 SET PATCNT=$GET(PATCNT)+1
+46 QUIT
+47 ;
PATSTATS(PATIEN) ; Set the Numbers (Stat Columns data) of eRx by Patient
+1 ; Input: PATIEN - eRx Patient IEN (Pointer to #52.46)
+2 ;Output: Patient Stats: P1: Highest Elapsed Days
+3 ; P2: Number of New eRx's
+4 ; P3: Number of eRx's on 'Wait' Status
+5 ; P4: Number of eRx's on 'In Progress' Statuses
+6 ; P5: Number of eRx's on 'On Hold' Statuses
+7 ; P6: Number of eRx's on 'CCR' Statuses
+8 ; P7: Number of eRx's on 'Other' Statuses
+9 ; P8: Number of CS eRx's
+10 NEW PATSTATS,MSGDT,ERXIEN,CSERX,STSIEN,EXTSTS
+11 IF '$GET(PSOLKBKD)
SET PSOLKBKD=$$GET1^DIQ(59,PSOSITE,10.2)
if 'PSOLKBKD
SET PSOLKBKD=365
+12 SET MSGDT=$$FMADD^XLFDT(DT,-PSOLKBKD)
SET PATSTATS=""
+13 FOR
SET MSGDT=$ORDER(^PS(52.49,"PAT2",PATIEN,MSGDT))
if 'MSGDT
QUIT
Begin DoDot:1
+14 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"PAT2",PATIEN,MSGDT,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:2
+15 SET CSERX=+$GET(^PS(52.49,ERXIEN,95))
+16 SET MTYPE=$PIECE($GET(^PS(52.49,ERXIEN,0)),"^",8)
+17 ; eRx Status Check
+18 SET STSIEN=+$GET(^PS(52.49,ERXIEN,1))
IF 'STSIEN
QUIT
+19 SET EXTSTS=$PIECE($GET(^PS(52.45,STSIEN,0)),"^")
+20 IF '$$ELIGSTS("PC",EXTSTS,MTYPE)
QUIT
+21 ; - CS/Non-CS Filter
+22 IF $GET(PSOCSERX)="Non-CS"
IF CSERX
QUIT
+23 IF $GET(PSOCSERX)="CS"
IF 'CSERX
QUIT
+24 ; - Setting Largest Elapsed Days (1st piece)
+25 IF $$FMDIFF^XLFDT(DT,MSGDT)>+PATSTATS
Begin DoDot:3
+26 SET $PIECE(PATSTATS,"^",1)=$$FMDIFF^XLFDT(DT,MSGDT)
End DoDot:3
+27 ; - Data for the eRx Count columns (New, In Progress, Wait, on Hold, CCR, Other)
+28 IF EXTSTS="N"
SET $PIECE(PATSTATS,U,2)=$PIECE(PATSTATS,U,2)+1
+29 IF ",W,RXW,CXW,"[(","_EXTSTS_",")
SET $PIECE(PATSTATS,U,3)=$PIECE(PATSTATS,U,3)+1
+30 IF ",I,RXI,CXI,"[(","_EXTSTS_",")
SET $PIECE(PATSTATS,U,4)=$PIECE(PATSTATS,U,4)+1
+31 IF $EXTRACT(EXTSTS)="H"
SET $PIECE(PATSTATS,U,5)=$PIECE(PATSTATS,U,5)+1
+32 IF ",RXN,RXE,RXR,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,"[(","_EXTSTS_",")
Begin DoDot:3
+33 SET $PIECE(PATSTATS,U,6)=$PIECE(PATSTATS,U,6)+1
End DoDot:3
+34 IF MTYPE="IE"
IF ",RRE,CRE,"[(","_EXTSTS_",")
SET $PIECE(PATSTATS,U,7)=$PIECE(PATSTATS,U,7)+1
+35 IF $GET(PSOCSERX)'="Non-CS"
IF CSERX
SET $PIECE(PATSTATS,U,8)=$PIECE(PATSTATS,U,8)+1
End DoDot:2
End DoDot:1
+36 QUIT PATSTATS
+37 ;
ELIGSTS(VIEW,ERXSTS,MSGTYPE) ; Checks whether the eRx's status is eligible to be on the list (counted)
+1 ; Input: VIEW - View: "PC" - Patient Centric View | "RX" - Rx Medication View
+2 ; ERXSTS - eRx Status (External format: e.g.,"N","HDI", "I", etc...)
+3 ; [o]MSGTYPE - Message Type ("N","RE","RR","CR", etc...)
+4 ;Output: 1 - eRx is eligible to be on the list | 0 - eRx is not Eligible to be on the list
+5 NEW STS,CCRSTS,SKIP
+6 SET MSGTYPE=$GET(MSGTYPE)
+7 ;
+8 ; If Any filter is selected, ignore the initial filter (upon entering the option)
+9 SET STS=","_$SELECT($EXTRACT(ERXSTS)="H":$EXTRACT(ERXSTS,1),$GET(MBMSITE)&($EXTRACT(ERXSTS,1,3)="REM"):"REM",1:ERXSTS)_","
+10 ; List is not Filtered
+11 IF '$$FILTERED(VIEW)
IF ",RJ,RM,REM,PR,E,RXA,CXA,CAA,CXP,RXP,RXC,RRC,RXA,CAN,ICA,CNP,CRP,CRC,CXC,CNE,CRN,CRE,CRR,CRX,RRX,CXQ,RXA,"[STS
QUIT 0
+12 IF VIEW="PC"
IF ",RRE,RXI,RXW,RXR,RXE,RXN,RXD,RXF,CAH,CAO,CAP,CAR,CAX,CAF,CXD,CXN,CXV,CXY,CXE,CXI,CXW,CRE,N,I,W,H,"'[STS
QUIT 0
+13 ; Match Status Filter (Only New, In Progress, Wait or Hold statuses are included)
+14 IF $GET(MATFLTR)
IF ",N,RXN,CXN,RXI,I,CXI,RXW,W,CXW,"'[STS
QUIT 0
+15 ;
+16 ; Filter Inbound Error RRE and RenewalRequests For Patient Centric View
+17 IF '$$FILTERED(VIEW)
if ((MSGTYPE="IE")&(ERXSTS'="RRE")&(ERXSTS'="CRE"))
QUIT 0
if (MSGTYPE="RR")
QUIT 0
+18 IF VIEW="PC"
IF '$$FILTERED(VIEW)
IF MSGTYPE="RE"
IF "RXP,RXC,RXA,RRP,"[STS
QUIT 0
+19 ;
+20 IF '$GET(STSFLTR)
IF $GET(MSTPFLTR)=""
IF MSGTYPE="CR"
IF ERXSTS="CRE"
QUIT 0
+21 ;
+22 SET SKIP=0
+23 IF '$$FILTERED(VIEW)
Begin DoDot:1
+24 IF $GET(PSOSTFLT)="N"
IF ",RXN,N,CXN,"'[STS
SET SKIP=1
+25 IF $GET(PSOSTFLT)="I"
IF ",RXI,I,CXI,"'[STS
SET SKIP=1
+26 IF $GET(PSOSTFLT)="W"
IF ",RXW,W,CXW,"'[STS
SET SKIP=1
+27 IF $GET(PSOSTFLT)="C"
Begin DoDot:2
+28 SET CCRSTS=",RXN,RXR,RXE,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,"
End DoDot:2
SET SKIP=$SELECT(PSOCCRST="ALL"&(CCRSTS[STS):0,PSOCCRST'="ALL"&(PSOCCRST=ERXSTS):0,1:1)
+29 IF $GET(PSOSTFLT)="H"
SET SKIP=$SELECT(PSOHDSTS="ALL"&(STS=",H,"):0,PSOHDSTS'="ALL"&(PSOHDSTS=ERXSTS):0,1:1)
End DoDot:1
IF SKIP
QUIT 0
+30 ; Default: Eligible
+31 QUIT 1
+32 ;
FILTERED(VIEW) ; Return whether the list is being filtered or not
+1 ; Input: VIEW - View: "PC" - Patient Centric View | "RX" - Rx Medication View
+2 ;Output: 0 - No filters | 1 - Filters are in place
+3 IF $GET(VIEW)="PC"
IF $DATA(PATFLTR)!$GET(DOBFLTR)!$GET(MATFLTR)
QUIT 1
+4 IF $GET(VIEW)="RX"
IF $DATA(PATFLTR)!$GET(DOBFLTR)!$GET(REDTFLTR)!$DATA(PRVFLTR)!$GET(STSFLTR)!($GET(DRGFLTR)'="")!($GET(MSTPFLTR)'="")!$GET(MATFLTR)!$GET(PSOALLST)
QUIT 1
+5 QUIT 0
+6 ;
HLDSTS() ; - Prompt User for Hold eRx Status
+1 NEW Y,DIC,X,HLDSTS
+2 SET DIC("A")="Select eRx Status: "
+3 SET DIC=52.45
SET DIC(0)="AEQ"
SET DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y)),($E($P(^PS(52.45,Y,0),U))=""H"")"
+4 SET DIC("W")="W "" - "",$P($G(^(0)),""^"",2)"
+5 WRITE !
DO ^DIC
KILL DIC
IF X=U!($DATA(DUOUT))!(Y<1)
QUIT ""
+6 SET HLDSTS=$$UP^XLFSTR(X)
IF +HLDSTS
SET HLDSTS=$$GET1^DIQ(52.45,+HLDSTS,.01)
+7 QUIT HLDSTS
+8 ;
CCRSTS(LST) ; - Prompt User for CCR eRx Status
+1 NEW I,DONE,DIC,Y,X,CODE,CARY,CIEN
+2 SET DONE=0
+3 FOR I=1:1
Begin DoDot:1
+4 SET CODE=$PIECE(LST,U,I)
IF CODE=""
SET DONE=1
QUIT
+5 SET CIEN=$$PRESOLV^PSOERXA1(CODE,"ERX")
+6 SET CARY(CIEN)=""
End DoDot:1
if DONE
QUIT
+7 SET DIC("A")="Select eRx Status: "
+8 SET DIC=52.45
SET DIC(0)="AEQ"
SET DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y)),$D(CARY(Y))"
+9 SET DIC("W")="W "" - "",$P($G(^(0)),""^"",2)"
+10 WRITE !
DO ^DIC
KILL DIC
IF X=U!($DATA(DUOUT))!(Y<1)
QUIT ""
+11 QUIT X
+12 ;
NEXTPAT(CURPTIEN) ; Returns the next Patient on the Queue to be worked on
+1 ; Input: (o)CURPTIEN - Current eRx Patient IEN (Pointer to #52.46) (If not passed, start with first patient)
+2 ;Output: NEXTPAT - Next eRx Patient on the Queue
+3 NEW NEXTPAT,STSLST,ERXSTS,STS,MSGDT,ERXIEN,EPATIEN,VPATIEN,VPRVIEN,VDRGIEN,ERXNODE0,ERXSTS,CSERX,LKBKDAYS,REACH
+4 KILL ^TMP("PSOERSKP",$JOB)
+5 DO LOADSTS(.STSLST)
+6 SET (NEXTPAT,INST)=0
+7 SET LKBKDAYS=PSOLKBKD
IF PSOSTFLT="WP"
IF $$GET1^DIQ(59,PSOSITE,10.2)>PSOLKBKD
SET LKBKDAYS=$$GET1^DIQ(59,PSOSITE,10.2)
+8 SET MSGDT=$$FMADD^XLFDT(DT,-LKBKDAYS)-.1
SET REACH=$SELECT($GET(CURPTIEN):0,1:1)
+9 FOR
SET MSGDT=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT))
if 'MSGDT
QUIT
Begin DoDot:1
+10 SET ERXSTS=999999
FOR
SET ERXSTS=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS),-1)
if 'ERXSTS
QUIT
Begin DoDot:2
+11 ; eRx Status Check
+12 IF '$DATA(STSLST(ERXSTS))
QUIT
+13 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"AMSGDTSTS",MSGDT,ERXSTS,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:3
+14 ; Related Institution Check
+15 IF '$GET(MBMSITE)
IF +$GET(^PS(52.49,ERXIEN,24))'=$GET(PSNPINST)
QUIT
+16 SET ERXNODE0=$GET(^PS(52.49,ERXIEN,0))
+17 SET EPATIEN=+$PIECE(ERXNODE0,"^",4)
SET VPATIEN=+$PIECE(ERXNODE0,"^",5)
SET CSERX=+$GET(^PS(52.49,ERXIEN,95))
+18 SET VPRVIEN=+$PIECE($GET(^PS(52.49,ERXIEN,2)),"^",3)
SET VDRGIEN=+$PIECE($GET(^PS(52.49,ERXIEN,3)),"^",2)
+19 IF $DATA(^TMP("PSOERSKP",$JOB,EPATIEN))
QUIT
+20 IF $GET(CURPTIEN)
IF EPATIEN=CURPTIEN
SET REACH=1
QUIT
+21 IF 'REACH
SET ^TMP("PSOERSKP",$JOB,EPATIEN)=""
QUIT
+22 ; - Match Status Filter
+23 IF $GET(MATFLTR)
IF '$$MATCHFLT^PSOERPC2(MATFLTR,EPATIEN)
SET ^TMP("PSOERSKP",$JOB,EPATIEN)=""
QUIT
+24 ; - CS/Non-CS Parameter Status Filter
+25 IF $GET(PSOCSERX)="CS"
IF 'CSERX
QUIT
+26 IF $GET(PSOCSERX)="Non-CS"
IF CSERX
QUIT
+27 IF PSOSTFLT="WP"
IF $DATA(^XUSEC("PSO ERX WORKLOAD TECH",DUZ))
IF $DATA(^XTMP("PSOERXWP",EPATIEN))
IF '$DATA(^XTMP("PSOERXWP",EPATIEN,DUZ))
QUIT
+28 SET NEXTPAT=EPATIEN
End DoDot:3
IF NEXTPAT
QUIT
End DoDot:2
IF NEXTPAT
QUIT
End DoDot:1
IF NEXTPAT
QUIT
+29 KILL ^TMP("PSOERSKP",$JOB)
+30 IF $GET(CURPTIEN)
IF 'NEXTPAT
IF $$NEXTPAT(0)'=CURPTIEN
SET NEXTPAT=$$NEXTPAT(0)
+31 IF PSOSTFLT="WP"
IF NEXTPAT
IF $DATA(^XUSEC("PSO ERX WORKLOAD TECH",DUZ))
SET ^XTMP("PSOERXWP",NEXTPAT,DUZ)=""
+32 QUIT NEXTPAT
+33 ;
LOADSTS(STSLST) ; Load Status Filter Array based on the Filter selected
+1 ;Output: STSLST - Return Array passed in by Reference with status IEN as Index (e.g., ARRAY(124))
+2 NEW STS
+3 KILL STSLST
+4 SET PSOSTFLT=$GET(PSOSTFLT)
SET PSOCCRST=$GET(PSOCCRST)
SET PSOHDSTS=$GET(PSOHDSTS)
+5 IF PSOSTFLT="A"!(PSOSTFLT="N")
SET STSLST($$STSIEN("N"))=""
+6 IF PSOSTFLT="WP"
FOR STS="N","I","W"
SET STSLST($$STSIEN(STS))=""
+7 IF PSOSTFLT="A"!(PSOSTFLT="I")
FOR STS="I","RXI","CXI"
SET STSLST($$STSIEN(STS))=""
+8 IF PSOSTFLT="A"!(PSOSTFLT="W")
FOR STS="W","RXW","CXW"
SET STSLST($$STSIEN(STS))=""
+9 IF PSOSTFLT="A"!(PSOSTFLT="C")
Begin DoDot:1
+10 IF PSOSTFLT="A"!(PSOCCRST="ALL")
Begin DoDot:2
+11 FOR STS="RXN","RXR","RXE","RXD","RXF","CAO","CAR","CAH","CAP","CAX","CAF","CXD","CXN","CXV","CXY","CXE","RRE"
Begin DoDot:3
+12 SET STSLST($$STSIEN(STS))=""
End DoDot:3
End DoDot:2
+13 IF '$TEST
IF PSOCCRST'=""
SET STSLST($$STSIEN(PSOCCRST))=""
End DoDot:1
+14 IF PSOSTFLT="A"!(PSOSTFLT="H")
Begin DoDot:1
+15 IF PSOSTFLT="A"!(PSOHDSTS="ALL")
Begin DoDot:2
+16 SET STS="GZ"
FOR
SET STS=$ORDER(^PS(52.45,"B",STS))
if $EXTRACT(STS)'="H"!(STS="")
QUIT
Begin DoDot:3
+17 SET STSLST($$STSIEN(STS))=""
End DoDot:3
End DoDot:2
+18 IF '$TEST
IF PSOHDSTS'=""
SET STSLST($$STSIEN(PSOHDSTS))=""
End DoDot:1
+19 QUIT
+20 ;
STSIEN(STS) ; Returns the eRx Status IEN
+1 ; Input: STS - eRx Status (external format, e.g., 'N', 'I', 'RXN', etc.)
+2 ;Output: ### - eRx Status IEN (internal format - pointer to #52.45)
+3 IF $GET(STS)=""
QUIT 0
+4 QUIT +$ORDER(^PS(52.45,"B",$GET(STS),0))
+5 ;
LOCK(PATIEN) ; Locks eRx Patient
+1 ; Input: PATIEN - eRx Patient IEN (Pointer to #52.46)
+2 ;Output: 1 - Patient Locked Successfully | Patient Not Locked (Already Locked)
+3 ; - Locking the eRx Patient
+4 NEW ERXLOCK
+5 SET ERXLOCK=$$L^PSOERX1A(PATIEN,1,1)
+6 IF 'ERXLOCK
Begin DoDot:1
+7 SET VALMSG="Patient Locked"
+8 IF $GET(^XTMP("PSOERXLOCK",PATIEN))
Begin DoDot:2
+9 SET VALMSG=VALMSG_":"_$EXTRACT($$GET1^DIQ(200,+$GET(^XTMP("PSOERXLOCK",PATIEN)),.01),1,20)
+10 SET VALMSG=VALMSG_"|"_$$FMTE^XLFDT($PIECE($GET(^XTMP("PSOERXLOCK",PATIEN)),"^",2),"2Z")
End DoDot:2
End DoDot:1
QUIT 0
+11 QUIT 1
