PSOERXC1 ;ALB/BWF - eRx Utilities/RPC's ; 6/1/2018 5:14pm
;;7.0;OUTPATIENT PHARMACY;**508,551,567,581,631,617**;DEC 1997;Build 110
;
EN(SRCH,SORTT,PCVSTAT) ; -- main entry point for PSO ERX PATIENT CENTRIC VIEW
N PSOC1RE
D EN^VALM("PSO ERX PATIENT CENTRIC VIEW")
Q
;
HDR ; -- header code
N PSOLBK
S VALMHDR(1)=" Patient Centric View"
S PSOLBK=$$GET1^DIQ(59,PSOSITE,10.2,"E")
S VALMHDR(2)=$S(PSOLBK:$J(" ",21),1:$J(" ",14))_"ERX LOOK-BACK DAYS: "_$S(PSOLBK:PSOLBK,1:"Default value 365")_" ("_$$FMTE^XLFDT($$FMADD^XLFDT(DT,-$S(PSOLBK:PSOLBK,1:365)))_")"
I $G(PSOC1RE) K @VALMAR,PSOC1RE D INIT
Q
;
INIT ; -- init variables and list array
N EBDATE,EDATE,BDATE,RXSTAT,RXDATE,ERXIEN,PATIEN,RDATE,ERXSTAT,COUNT,PNAME,DOB,DOB2,NEW,WAIT,IPR,HOLD,TOTAL,RXDATE2
N RXSTATE,PATCNT,B,G,VAR,DIRECT,LINEVAR,EDAYS,EDLOOP,GLOB,LASTUSER,PATINFO,EDAYS2,PATLOOP,CCR,LINE,OTH,CNT,BDOVR,MTYPE
N SVAL,P5246IEN,ESCODE,CSCNT,CSPREFIX
S PSOSRCH=$S($D(SRCH):1,1:0) I PSOSRCH S PSOSRCH(VALMEVL)=""
S PSOSRT=$S($D(SORTT):1,1:0) I PSOSRT S PSOSRT(VALMEVL)=""
K ^TMP("CENTRIC",$J),^TMP("RDATE",$J),^TMP("PSOERXC1",$J)
I '$D(PSOINST) D
.D ^PSOLSET
Q:'$D(PSOINST)
S GLOB=$NA(^TMP("PSOERXC1",$J)) K @GLOB
S BDATE=$$FMADD^XLFDT(DT,-365)
S CNT=0,PATCNT=0
S EDATE=DT_".9999"
S RXDATE=BDATE
S BDOVR=$$GET1^DIQ(59,PSOSITE,10.2,"E") I BDOVR S RXDATE=$$FMADD^XLFDT(DT,-BDOVR)
S RXDATE2=BDATE
F S RXDATE=$O(^PS(52.49,"F",PSNPINST,RXDATE)) Q:'RXDATE!(RXDATE>EDATE)!(RXDATE="")!(PATCNT>998) D
.I $D(SRCH(1)) D Q
..S SVAL=$P(SRCH(1),U)
..S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"EPAT",PSNPINST,RXDATE,SVAL,ERXIEN)) Q:'ERXIEN!(PATCNT>998) D
...D BLDITEM(ERXIEN,.PATCNT,$G(PCVSTAT))
.I $D(SRCH(2)) D Q
..S SVAL=$P(SRCH(2),U)
..S P5246IEN=0 F S P5246IEN=$O(^PS(52.46,"DOB",SVAL,P5246IEN)) Q:'P5246IEN!(PATCNT>998) D
...S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"EPAT",PSNPINST,RXDATE,P5246IEN,ERXIEN)) Q:'ERXIEN!(PATCNT>998) D
....D BLDITEM(ERXIEN,.PATCNT,$G(PCVSTAT))
.S RXSTAT=0 F S RXSTAT=$O(^PS(52.49,"F",PSNPINST,RXDATE,RXSTAT)) Q:'RXSTAT!(PATCNT=999) D
..I +$G(STAT),$G(STAT)'=RXSTAT Q
..S RXSTATE=$$GET1^DIQ(52.45,RXSTAT,.01,"E")
..I ((RXSTATE="RJ")!(RXSTATE="RM")!(RXSTATE="PR")!(RXSTATE="E")) Q
..S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"F",PSNPINST,RXDATE,RXSTAT,ERXIEN)) Q:'ERXIEN!(PATCNT=999) D
...D BLDITEM(ERXIEN,.PATCNT,$G(PCVSTAT))
S PATIEN=0,LINE=0
I '$O(^TMP("CENTRIC",$J,0)) S LINE=$G(LINE)+1,VALMCNT=LINE D SET^VALM10(LINE,"No records found.") Q
F S PATIEN=$O(^TMP("CENTRIC",$J,PATIEN)) Q:'PATIEN D
.S PNAME=$$GET1^DIQ(52.46,PATIEN,.01)
.S DOB=$$GET1^DIQ(52.46,PATIEN,.08,"I"),DOB2=$$FMTE^XLFDT(DOB,"5Z")
.F S RXDATE2=$O(^PS(52.49,"PAT2",PATIEN,RXDATE2)) Q:'RXDATE2!(RXDATE2>EDATE) D
..S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"PAT2",PATIEN,RXDATE2,ERXIEN)) Q:'ERXIEN D
...Q:$$GET1^DIQ(52.49,ERXIEN,24.1,"I")'=PSNPINST
...I '$$CSFILTER^PSOERXUT(ERXIEN) Q
...S ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
...I (ERXSTAT="PR")!(ERXSTAT="RM")!(ERXSTAT="RJ")!(ERXSTAT="E") Q
...S ESCODE=","_$S($E(ERXSTAT)="H":$E(ERXSTAT),1:ERXSTAT)_","
...I ",RRE,RXI,RXW,RXR,RXE,RXN,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,CXI,CXW,CRE,N,I,W,H,"'[ESCODE Q
...S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
...S RDATE=$E($$GET1^DIQ(52.49,ERXIEN,.03,"I"),1,7)
...I '$D(^TMP("RDATE",$J,PATIEN,0)) S ^TMP("RDATE",$J,PATIEN,0)=$G(RDATE)
...I $D(^TMP("RDATE",$J,PATIEN,0)),^TMP("RDATE",$J,PATIEN,0)>$G(RDATE) S ^TMP("RDATE",$J,PATIEN,0)=$G(RDATE)
...S COUNT=$G(^TMP("CENTRIC",$J,PATIEN,0))
...I ERXSTAT="N" S $P(COUNT,U,1)=$P($G(COUNT),U)+1
...I ",W,RXW,CXW,"[(","_ERXSTAT_",") S $P(COUNT,U,2)=$P($G(COUNT),U,2)+1
...I ",I,RXI,CXI,"[(","_ERXSTAT_",") S $P(COUNT,U,3)=$P($G(COUNT),U,3)+1
...I $E(ERXSTAT)="H" S $P(COUNT,U,4)=$P($G(COUNT),U,4)+1
...I ",RXN,RXE,RXR,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,"[(","_ERXSTAT_",") D
....S $P(COUNT,U,5)=$P($G(COUNT),U,5)+1
...; finalize and display count for 'other' types.
...I MTYPE="IE",",RRE,CRE,"[(","_ERXSTAT_",") S $P(COUNT,U,6)=$P($G(COUNT),U,6)+1
...I $$GET1^DIQ(52.49,ERXIEN,95.1,"I") S $P(COUNT,U,7)=$P($G(COUNT),U,7)+1
...S ^TMP("CENTRIC",$J,PATIEN,0)=COUNT
.S COUNT=$G(^TMP("CENTRIC",$J,PATIEN,0))
.F G=1:1:7 D
..I $P(COUNT,U,G)="" D
...S $P(COUNT,U,G)=0
.S NEW=$P(COUNT,U)
.S WAIT=$P(COUNT,U,2)
.S IPR=$P(COUNT,U,3)
.S HOLD=$P(COUNT,U,4)
.S CCR=$P(COUNT,U,5)
.S OTH=$P(COUNT,U,6)
.S CSCNT=$P(COUNT,U,7)
.S EDAYS=$$FMDIFF^XLFDT(DT,$G(^TMP("RDATE",$J,PATIEN,0)))
.S LASTUSER=$S($D(^XTMP("PSOERXLOCK",PATIEN)):$$GET1^DIQ(200,$P(^XTMP("PSOERXLOCK",PATIEN),U),.01,"E"),1:"")
.S TOTAL=""
.F B=1:1:6 D
..S VAR=$P(COUNT,U,B)
..S TOTAL=TOTAL+VAR
.I TOTAL=0 Q
.I TOTAL>999 S TOTAL=999
.S EDAYS2=$S($L(EDAYS)=1:" "_EDAYS,1:EDAYS)
.I $L(TOTAL)=1 S TOTAL=" "_TOTAL
.I $L(TOTAL)=2 S TOTAL=" "_TOTAL
.I NEW>99 S NEW=99
.I $L(NEW)=1 S NEW=" "_NEW
.I WAIT>99 S WAIT=99
.I $L(WAIT)=1 S WAIT=" "_WAIT
.I IPR>99 S IPR=99
.I $L(IPR)=1 S IPR=" "_IPR
.I HOLD>99 S HOLD=99
.I $L(HOLD)=1 S HOLD=" "_HOLD
.I CCR>99 S CCR=99
.I $L(CCR)=1 S CCR=" "_CCR
.I $L(CCR)=2 S CCR=" "_CCR
.I OTH>99 S OTH=99
.I $L(OTH)=1 S OTH=" "_OTH
.I $L(OTH)=2 S OTH=" "_OTH
.S CSPREFIX=$S($G(SORTBYCS):$S(CSCNT:"A",1:"B"),1:"Z")
.I $G(SORTT)=1 S CSPREFIX=CSPREFIX_PNAME,DIRECT=1
.I $G(SORTT)=2 S CSPREFIX=CSPREFIX_DOB,DIRECT=1
.I '$G(SORTT)!($G(SORTT)=3) S CSPREFIX=CSPREFIX_(99999-EDAYS),DIRECT=1
.S @GLOB@(CSPREFIX,PATIEN)=PNAME_U_DOB2_U_EDAYS2_U_LASTUSER_U_NEW_U_WAIT_U_IPR_U_HOLD_U_CCR_U_OTH_U_TOTAL_U_CSCNT
I '$D(DIRECT) S DIRECT=-1
S EDLOOP=""
F S EDLOOP=$O(@GLOB@(EDLOOP),DIRECT) Q:EDLOOP="" D
.S PATLOOP=""
.F S PATLOOP=$O(@GLOB@(EDLOOP,PATLOOP)) Q:PATLOOP="" D
..S LINE=LINE+1,LINEVAR=""
..S PATINFO=$G(@GLOB@(EDLOOP,PATLOOP))
..S LINEVAR=$$SETFLD^VALM1(LINE_$S($P(PATINFO,U,12)>0:"]",1:"."),LINEVAR,"#")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U),LINEVAR,"ERX PATIENT")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U,2),LINEVAR,"DOB")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U,3),LINEVAR,"ED")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U,4),LINEVAR,"LOCKED BY")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U,5),LINEVAR,"NW")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U,6),LINEVAR,"WT")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U,7),LINEVAR,"IP")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U,8),LINEVAR,"HD")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U,9),LINEVAR,"CCR")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U,10),LINEVAR,"OTH")
..S LINEVAR=$$SETFLD^VALM1($P(PATINFO,U,11),LINEVAR,"TOT")
..D SET^VALM10(LINE,LINEVAR,PATLOOP)
S VALMCNT=LINE
K ^TMP("CENTRIC",$J),^TMP("RDATE",$J),^TMP("PSOERXC1",$J)
Q
CENTSRCH ;
N RES,SVAL,I,DONE,SRCHARY
D FULL^VALM1
S DONE=0
S VALMBCK="R",PSOC1RE=1
F I=1:1 D Q:DONE
.S RES=$$DIR(,I,.SRCHARY)
.I '+RES S DONE=1 Q
.S SRCHARY(+RES)=$P(RES,U,2,99)
.I $D(SRCHARY(3)) S DONE=1 Q
I '$D(SRCHARY) S VALMBCK="R" Q
I $G(SRCHARY(3))]"" D Q
.I '$D(^PS(52.49,"B",SRCHARY(3))) W !,"eRx could not be found." D DIRE^PSOERXX1 S VALMBCK="R" Q
.S ERXIEN=$O(^PS(52.49,"B",SRCHARY(3),0))
.I ERXIEN,$$GET1^DIQ(52.49,ERXIEN,24.1,"I")'=PSNPINST W !!,"eRx does not belong to this division.",! D DIRE^PSOERXX1 S VALMBCK="R" Q
.S PATIEN=$$GET1^DIQ(52.49,ERXIEN,.04,"I") Q:'PATIEN
.S ERXLOCK=$$L^PSOERX1A(PATIEN,1)
.I 'ERXLOCK S DIR(0)="E" D ^DIR K DIR S VALMBCK="R" Q
.D EN^PSOERX1(ERXIEN)
.D UL^PSOERX1A(PATIEN)
.S VALMBCK="R"
I $D(STYP) D EN(.SRCHARY,STYP) Q
D EN(.SRCHARY)
Q
CENTSORT ;
N RES,STYP,SVAL
D FULL^VALM1
S VALMBCK="R",PSOC1RE=1
S RES=$$DIR(1,0)
I '+$P(RES,U) S VALMBCK="R" Q
S STYP=$P(RES,U)
I $D(SRCHARY) D EN(.SRCHARY,STYP) Q
S SORTBYCS=$$ASKCSSORT()
Q:SORTBYCS'?1N
D EN(,STYP,PCVSTAT)
Q
ASKCSSORT() ;
Q:PSOCSERX'="B" 0
S DIR(0)="Y"
S DIR("B")="YES"
W !!,"Do you want to group by controlled substance? ",!
D ^DIR
Q Y
SBN ;NOTES: KEEPS UNLOCKING REGARDLESS OF THE USER COMING BACK FROM AN ACTUAL LOCK. MAY NEED TO CONSIDER A TAG THAT DETERMINES WHETHER OR NOT TO
;GO TO THE LOCK IN THE FIRST PLACE, OR RE-WRITE THE ENTIRE SBN FUNCTIONS.
N Y,ERXPAT,PATIEN,ERXLOCK,SRCH
D FULL^VALM1
S Y=+$P(XQORNOD(0),"=",2)
I 'Y S VALMBCK="R" Q
S PATIEN=$O(@VALMAR@("IDX",Y,"")) Q:'PATIEN
S ERXLOCK=$$L^PSOERX1A(PATIEN,1)
I 'ERXLOCK S DIR(0)="E" D ^DIR K DIR S VALMBCK="R" Q
S SRCH(1)=PATIEN D EN^PSOERX(.SRCH,,1)
D UL^PSOERX1A(PATIEN)
S VALMBCK="R"
K %
Q
PATDATA ;
I '$O(@VALMAR@("IDX",0)) S VALMSG="No records found!" S VALMBCK="" Q
N DIR,Y,RESP,PATIEN,SRCH
D FULL^VALM1
S DIR(0)="N^"_VALMBG_":"_VALMLST_":0" D ^DIR
I 'Y S VALMBCK="R" Q
S RESP=Y
S PATIEN=$O(@VALMAR@("IDX",RESP,"")) Q:'PATIEN
S ERXLOCK=$$L^PSOERX1A(PATIEN,1)
I 'ERXLOCK S DIR(0)="E" D ^DIR K DIR S VALMBCK="R" Q
S SRCH(1)=PATIEN D EN^PSOERX(.SRCH,,1)
D UL^PSOERX1A(PATIEN)
K %
S VALMBCK="R"
Q
DIR(SORT,CNT,SLIST) ;
N DIR,Y,RLINE,STAG,SVAL
K DIR
S DIR(0)="SO^1:PATIENT NAME;2:DATE OF BIRTH"
S DIR(0)=DIR(0)_";3:"_$S($G(SORT):"ELAPSED DAYS (ED)",1:"ERX REFERENCE NUMBER")
I CNT<2 S DIR("L")="Select one of the following "_$S($G(SORT):"sort",1:"search")_" criteria:"
I CNT>1 D
.S DIR("L")=""
.S DIR("L",11)="Select another search criteria or '^' to exit. Press enter to use the currently"
.S DIR("L",12)="selected search criteria."
S DIR("L",2)=""
S DIR("L",3)=" "_$S($D(SLIST(1)):"*",1:"")_"1.) PATIENT NAME"
S DIR("L",4)=" "_$S($D(SLIST(2)):"*",1:"")_"2.) DATE OF BIRTH"
S DIR("L",5)=" "_$S($D(SLIST(3)):"*",1:"")_"3.) "
S DIR("L",5)=DIR("L",5)_$S($G(SORT):"ELAPSED DAYS (ED)",1:"ERX REFERENCE NUMBER")
S DIR("L",6)=""
S DIR("L",7)=$S($D(SLIST):" * - indicates selected criteria.",1:"")
D ^DIR K DIR Q:'Y 0
S RES=Y I $G(SORT) Q RES
S RLINE=$S(RES=1:"PAT",RES=2:"DOB",RES=3:"EREFNUM",1:"")
I RLINE']"" Q 0
S STAG=RLINE
S SVAL=$$@STAG I SVAL="" Q 0
Q RES_U_SVAL
PAT() ;
N Y,DIC
S DIC=52.46,DIC(0)="AEMQ" D ^DIC
I Y<1 Q ""
Q Y
DOB() ;
N %DT,Y
S %DT="A"
S %DT("A")="Enter the Date of Birth (DOB): "
D ^%DT
I Y<1 Q ""
Q Y
EREFNUM() ;
N DIR,Y
S DIR(0)="FO",DIR("A")="Enter the eRx Reference number" D ^DIR
I Y=""!(Y="^") Q ""
Q $$UP^XLFSTR(Y)
BLDITEM(ERXIEN,PATCNT,STAT) ;
N PATIEN,DOB,ERXSTAT,ERXESTAT,ESCODE,MTYPE,DRGCSCH,ERXCSFLG
I '$$CSFILTER^PSOERXUT(ERXIEN) Q
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
S ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"I")
S ERXESTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
; 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",ERXESTAT="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",ERXESTAT="CRN" D CHKEXP^PSOERX(ERXIEN,MTYPE)
S ESCODE=","_$S($E(ERXESTAT)="H":$E(ERXESTAT),1:ERXESTAT)_","
I ",RXI,RXR,RXE,RXW,RXN,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,CXI,CXW,N,I,W,H,"'[ESCODE Q
I $G(STAT)]"" Q:'$$CHKSTAT(STAT,ERXESTAT,ERXSTAT)
S PATIEN=$$GET1^DIQ(52.49,ERXIEN,.04,"I") Q:'PATIEN
I $D(SRCH(1)),PATIEN'=$P($G(SRCH(1)),U) Q
S DOB=$$GET1^DIQ(52.46,PATIEN,.08,"I")
I $D(SRCH(2)),DOB'=$G(SRCH(2)) Q
I $D(^TMP("CENTRIC",$J,PATIEN)) Q
S ^TMP("CENTRIC",$J,PATIEN)="",PATCNT=$G(PATCNT)+1
Q
CHKSTAT(FILSTAT,ERXSTAT,ERXISTAT) ;
N RET,IWCHECK
S RET=0
I +$G(FILSTAT) S IWCHECK=$$GET1^DIQ(52.45,FILSTAT,.01,"E") ; checking user selected PCV filter for IP or WAIT status - both pass as numeric
I $G(IWCHECK)="W" Q $S(",RXW,W,CXW,"'[(","_ERXSTAT_","):RET,1:1)
I $G(IWCHECK)="I" Q $S(",RXI,I,CXI,"'[(","_ERXSTAT_","):RET,1:1)
I $G(FILSTAT)="CCR" Q $S(",RXN,RXR,RXE,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,"'[(","_ERXSTAT_","):RET,1:1)
I $G(FILSTAT)="AH" Q $S($E(ERXSTAT)'="H":RET,1:1)
I $G(FILSTAT)'="A",FILSTAT'=ERXISTAT Q RET
Q 1
EX ; early exit logic
K PSOSRCH,PSOSRT,SRCH,SORTT,PSOPRMPT
S PSOC1RE=1
D EX^PSOORFI1
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K PSOPRMPT,@VALMAR
K CSPREFIX,SORTBYCS
S PSOC1RE=1
Q
;
EXPND ; -- expand code
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXC1 12268 printed Dec 13, 2024@02:28:27 Page 2
PSOERXC1 ;ALB/BWF - eRx Utilities/RPC's ; 6/1/2018 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**508,551,567,581,631,617**;DEC 1997;Build 110
+2 ;
EN(SRCH,SORTT,PCVSTAT) ; -- main entry point for PSO ERX PATIENT CENTRIC VIEW
+1 NEW PSOC1RE
+2 DO EN^VALM("PSO ERX PATIENT CENTRIC VIEW")
+3 QUIT
+4 ;
HDR ; -- header code
+1 NEW PSOLBK
+2 SET VALMHDR(1)=" Patient Centric View"
+3 SET PSOLBK=$$GET1^DIQ(59,PSOSITE,10.2,"E")
+4 SET VALMHDR(2)=$SELECT(PSOLBK:$JUSTIFY(" ",21),1:$JUSTIFY(" ",14))_"ERX LOOK-BACK DAYS: "_$SELECT(PSOLBK:PSOLBK,1:"Default value 365")_" ("_$$FMTE^XLFDT($$FMADD^XLFDT(DT,-$SELECT(PSOLBK:PSOLBK,1:365)))_")"
+5 IF $GET(PSOC1RE)
KILL @VALMAR,PSOC1RE
DO INIT
+6 QUIT
+7 ;
INIT ; -- init variables and list array
+1 NEW EBDATE,EDATE,BDATE,RXSTAT,RXDATE,ERXIEN,PATIEN,RDATE,ERXSTAT,COUNT,PNAME,DOB,DOB2,NEW,WAIT,IPR,HOLD,TOTAL,RXDATE2
+2 NEW RXSTATE,PATCNT,B,G,VAR,DIRECT,LINEVAR,EDAYS,EDLOOP,GLOB,LASTUSER,PATINFO,EDAYS2,PATLOOP,CCR,LINE,OTH,CNT,BDOVR,MTYPE
+3 NEW SVAL,P5246IEN,ESCODE,CSCNT,CSPREFIX
+4 SET PSOSRCH=$SELECT($DATA(SRCH):1,1:0)
IF PSOSRCH
SET PSOSRCH(VALMEVL)=""
+5 SET PSOSRT=$SELECT($DATA(SORTT):1,1:0)
IF PSOSRT
SET PSOSRT(VALMEVL)=""
+6 KILL ^TMP("CENTRIC",$JOB),^TMP("RDATE",$JOB),^TMP("PSOERXC1",$JOB)
+7 IF '$DATA(PSOINST)
Begin DoDot:1
+8 DO ^PSOLSET
End DoDot:1
+9 if '$DATA(PSOINST)
QUIT
+10 SET GLOB=$NAME(^TMP("PSOERXC1",$JOB))
KILL @GLOB
+11 SET BDATE=$$FMADD^XLFDT(DT,-365)
+12 SET CNT=0
SET PATCNT=0
+13 SET EDATE=DT_".9999"
+14 SET RXDATE=BDATE
+15 SET BDOVR=$$GET1^DIQ(59,PSOSITE,10.2,"E")
IF BDOVR
SET RXDATE=$$FMADD^XLFDT(DT,-BDOVR)
+16 SET RXDATE2=BDATE
+17 FOR
SET RXDATE=$ORDER(^PS(52.49,"F",PSNPINST,RXDATE))
if 'RXDATE!(RXDATE>EDATE)!(RXDATE="")!(PATCNT>998)
QUIT
Begin DoDot:1
+18 IF $DATA(SRCH(1))
Begin DoDot:2
+19 SET SVAL=$PIECE(SRCH(1),U)
+20 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"EPAT",PSNPINST,RXDATE,SVAL,ERXIEN))
if 'ERXIEN!(PATCNT>998)
QUIT
Begin DoDot:3
+21 DO BLDITEM(ERXIEN,.PATCNT,$GET(PCVSTAT))
End DoDot:3
End DoDot:2
QUIT
+22 IF $DATA(SRCH(2))
Begin DoDot:2
+23 SET SVAL=$PIECE(SRCH(2),U)
+24 SET P5246IEN=0
FOR
SET P5246IEN=$ORDER(^PS(52.46,"DOB",SVAL,P5246IEN))
if 'P5246IEN!(PATCNT>998)
QUIT
Begin DoDot:3
+25 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"EPAT",PSNPINST,RXDATE,P5246IEN,ERXIEN))
if 'ERXIEN!(PATCNT>998)
QUIT
Begin DoDot:4
+26 DO BLDITEM(ERXIEN,.PATCNT,$GET(PCVSTAT))
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+27 SET RXSTAT=0
FOR
SET RXSTAT=$ORDER(^PS(52.49,"F",PSNPINST,RXDATE,RXSTAT))
if 'RXSTAT!(PATCNT=999)
QUIT
Begin DoDot:2
+28 IF +$GET(STAT)
IF $GET(STAT)'=RXSTAT
QUIT
+29 SET RXSTATE=$$GET1^DIQ(52.45,RXSTAT,.01,"E")
+30 IF ((RXSTATE="RJ")!(RXSTATE="RM")!(RXSTATE="PR")!(RXSTATE="E"))
QUIT
+31 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"F",PSNPINST,RXDATE,RXSTAT,ERXIEN))
if 'ERXIEN!(PATCNT=999)
QUIT
Begin DoDot:3
+32 DO BLDITEM(ERXIEN,.PATCNT,$GET(PCVSTAT))
End DoDot:3
End DoDot:2
End DoDot:1
+33 SET PATIEN=0
SET LINE=0
+34 IF '$ORDER(^TMP("CENTRIC",$JOB,0))
SET LINE=$GET(LINE)+1
SET VALMCNT=LINE
DO SET^VALM10(LINE,"No records found.")
QUIT
+35 FOR
SET PATIEN=$ORDER(^TMP("CENTRIC",$JOB,PATIEN))
if 'PATIEN
QUIT
Begin DoDot:1
+36 SET PNAME=$$GET1^DIQ(52.46,PATIEN,.01)
+37 SET DOB=$$GET1^DIQ(52.46,PATIEN,.08,"I")
SET DOB2=$$FMTE^XLFDT(DOB,"5Z")
+38 FOR
SET RXDATE2=$ORDER(^PS(52.49,"PAT2",PATIEN,RXDATE2))
if 'RXDATE2!(RXDATE2>EDATE)
QUIT
Begin DoDot:2
+39 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"PAT2",PATIEN,RXDATE2,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:3
+40 if $$GET1^DIQ(52.49,ERXIEN,24.1,"I")'=PSNPINST
QUIT
+41 IF '$$CSFILTER^PSOERXUT(ERXIEN)
QUIT
+42 SET ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
+43 IF (ERXSTAT="PR")!(ERXSTAT="RM")!(ERXSTAT="RJ")!(ERXSTAT="E")
QUIT
+44 SET ESCODE=","_$SELECT($EXTRACT(ERXSTAT)="H":$EXTRACT(ERXSTAT),1:ERXSTAT)_","
+45 IF ",RRE,RXI,RXW,RXR,RXE,RXN,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,CXI,CXW,CRE,N,I,W,H,"'[ESCODE
QUIT
+46 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+47 SET RDATE=$EXTRACT($$GET1^DIQ(52.49,ERXIEN,.03,"I"),1,7)
+48 IF '$DATA(^TMP("RDATE",$JOB,PATIEN,0))
SET ^TMP("RDATE",$JOB,PATIEN,0)=$GET(RDATE)
+49 IF $DATA(^TMP("RDATE",$JOB,PATIEN,0))
IF ^TMP("RDATE",$JOB,PATIEN,0)>$GET(RDATE)
SET ^TMP("RDATE",$JOB,PATIEN,0)=$GET(RDATE)
+50 SET COUNT=$GET(^TMP("CENTRIC",$JOB,PATIEN,0))
+51 IF ERXSTAT="N"
SET $PIECE(COUNT,U,1)=$PIECE($GET(COUNT),U)+1
+52 IF ",W,RXW,CXW,"[(","_ERXSTAT_",")
SET $PIECE(COUNT,U,2)=$PIECE($GET(COUNT),U,2)+1
+53 IF ",I,RXI,CXI,"[(","_ERXSTAT_",")
SET $PIECE(COUNT,U,3)=$PIECE($GET(COUNT),U,3)+1
+54 IF $EXTRACT(ERXSTAT)="H"
SET $PIECE(COUNT,U,4)=$PIECE($GET(COUNT),U,4)+1
+55 IF ",RXN,RXE,RXR,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,"[(","_ERXSTAT_",")
Begin DoDot:4
+56 SET $PIECE(COUNT,U,5)=$PIECE($GET(COUNT),U,5)+1
End DoDot:4
+57 ; finalize and display count for 'other' types.
+58 IF MTYPE="IE"
IF ",RRE,CRE,"[(","_ERXSTAT_",")
SET $PIECE(COUNT,U,6)=$PIECE($GET(COUNT),U,6)+1
+59 IF $$GET1^DIQ(52.49,ERXIEN,95.1,"I")
SET $PIECE(COUNT,U,7)=$PIECE($GET(COUNT),U,7)+1
+60 SET ^TMP("CENTRIC",$JOB,PATIEN,0)=COUNT
End DoDot:3
End DoDot:2
+61 SET COUNT=$GET(^TMP("CENTRIC",$JOB,PATIEN,0))
+62 FOR G=1:1:7
Begin DoDot:2
+63 IF $PIECE(COUNT,U,G)=""
Begin DoDot:3
+64 SET $PIECE(COUNT,U,G)=0
End DoDot:3
End DoDot:2
+65 SET NEW=$PIECE(COUNT,U)
+66 SET WAIT=$PIECE(COUNT,U,2)
+67 SET IPR=$PIECE(COUNT,U,3)
+68 SET HOLD=$PIECE(COUNT,U,4)
+69 SET CCR=$PIECE(COUNT,U,5)
+70 SET OTH=$PIECE(COUNT,U,6)
+71 SET CSCNT=$PIECE(COUNT,U,7)
+72 SET EDAYS=$$FMDIFF^XLFDT(DT,$GET(^TMP("RDATE",$JOB,PATIEN,0)))
+73 SET LASTUSER=$SELECT($DATA(^XTMP("PSOERXLOCK",PATIEN)):$$GET1^DIQ(200,$PIECE(^XTMP("PSOERXLOCK",PATIEN),U),.01,"E"),1:"")
+74 SET TOTAL=""
+75 FOR B=1:1:6
Begin DoDot:2
+76 SET VAR=$PIECE(COUNT,U,B)
+77 SET TOTAL=TOTAL+VAR
End DoDot:2
+78 IF TOTAL=0
QUIT
+79 IF TOTAL>999
SET TOTAL=999
+80 SET EDAYS2=$SELECT($LENGTH(EDAYS)=1:" "_EDAYS,1:EDAYS)
+81 IF $LENGTH(TOTAL)=1
SET TOTAL=" "_TOTAL
+82 IF $LENGTH(TOTAL)=2
SET TOTAL=" "_TOTAL
+83 IF NEW>99
SET NEW=99
+84 IF $LENGTH(NEW)=1
SET NEW=" "_NEW
+85 IF WAIT>99
SET WAIT=99
+86 IF $LENGTH(WAIT)=1
SET WAIT=" "_WAIT
+87 IF IPR>99
SET IPR=99
+88 IF $LENGTH(IPR)=1
SET IPR=" "_IPR
+89 IF HOLD>99
SET HOLD=99
+90 IF $LENGTH(HOLD)=1
SET HOLD=" "_HOLD
+91 IF CCR>99
SET CCR=99
+92 IF $LENGTH(CCR)=1
SET CCR=" "_CCR
+93 IF $LENGTH(CCR)=2
SET CCR=" "_CCR
+94 IF OTH>99
SET OTH=99
+95 IF $LENGTH(OTH)=1
SET OTH=" "_OTH
+96 IF $LENGTH(OTH)=2
SET OTH=" "_OTH
+97 SET CSPREFIX=$SELECT($GET(SORTBYCS):$SELECT(CSCNT:"A",1:"B"),1:"Z")
+98 IF $GET(SORTT)=1
SET CSPREFIX=CSPREFIX_PNAME
SET DIRECT=1
+99 IF $GET(SORTT)=2
SET CSPREFIX=CSPREFIX_DOB
SET DIRECT=1
+100 IF '$GET(SORTT)!($GET(SORTT)=3)
SET CSPREFIX=CSPREFIX_(99999-EDAYS)
SET DIRECT=1
+101 SET @GLOB@(CSPREFIX,PATIEN)=PNAME_U_DOB2_U_EDAYS2_U_LASTUSER_U_NEW_U_WAIT_U_IPR_U_HOLD_U_CCR_U_OTH_U_TOTAL_U_CSCNT
End DoDot:1
+102 IF '$DATA(DIRECT)
SET DIRECT=-1
+103 SET EDLOOP=""
+104 FOR
SET EDLOOP=$ORDER(@GLOB@(EDLOOP),DIRECT)
if EDLOOP=""
QUIT
Begin DoDot:1
+105 SET PATLOOP=""
+106 FOR
SET PATLOOP=$ORDER(@GLOB@(EDLOOP,PATLOOP))
if PATLOOP=""
QUIT
Begin DoDot:2
+107 SET LINE=LINE+1
SET LINEVAR=""
+108 SET PATINFO=$GET(@GLOB@(EDLOOP,PATLOOP))
+109 SET LINEVAR=$$SETFLD^VALM1(LINE_$SELECT($PIECE(PATINFO,U,12)>0:"]",1:"."),LINEVAR,"#")
+110 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U),LINEVAR,"ERX PATIENT")
+111 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U,2),LINEVAR,"DOB")
+112 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U,3),LINEVAR,"ED")
+113 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U,4),LINEVAR,"LOCKED BY")
+114 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U,5),LINEVAR,"NW")
+115 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U,6),LINEVAR,"WT")
+116 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U,7),LINEVAR,"IP")
+117 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U,8),LINEVAR,"HD")
+118 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U,9),LINEVAR,"CCR")
+119 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U,10),LINEVAR,"OTH")
+120 SET LINEVAR=$$SETFLD^VALM1($PIECE(PATINFO,U,11),LINEVAR,"TOT")
+121 DO SET^VALM10(LINE,LINEVAR,PATLOOP)
End DoDot:2
End DoDot:1
+122 SET VALMCNT=LINE
+123 KILL ^TMP("CENTRIC",$JOB),^TMP("RDATE",$JOB),^TMP("PSOERXC1",$JOB)
+124 QUIT
CENTSRCH ;
+1 NEW RES,SVAL,I,DONE,SRCHARY
+2 DO FULL^VALM1
+3 SET DONE=0
+4 SET VALMBCK="R"
SET PSOC1RE=1
+5 FOR I=1:1
Begin DoDot:1
+6 SET RES=$$DIR(,I,.SRCHARY)
+7 IF '+RES
SET DONE=1
QUIT
+8 SET SRCHARY(+RES)=$PIECE(RES,U,2,99)
+9 IF $DATA(SRCHARY(3))
SET DONE=1
QUIT
End DoDot:1
if DONE
QUIT
+10 IF '$DATA(SRCHARY)
SET VALMBCK="R"
QUIT
+11 IF $GET(SRCHARY(3))]""
Begin DoDot:1
+12 IF '$DATA(^PS(52.49,"B",SRCHARY(3)))
WRITE !,"eRx could not be found."
DO DIRE^PSOERXX1
SET VALMBCK="R"
QUIT
+13 SET ERXIEN=$ORDER(^PS(52.49,"B",SRCHARY(3),0))
+14 IF ERXIEN
IF $$GET1^DIQ(52.49,ERXIEN,24.1,"I")'=PSNPINST
WRITE !!,"eRx does not belong to this division.",!
DO DIRE^PSOERXX1
SET VALMBCK="R"
QUIT
+15 SET PATIEN=$$GET1^DIQ(52.49,ERXIEN,.04,"I")
if 'PATIEN
QUIT
+16 SET ERXLOCK=$$L^PSOERX1A(PATIEN,1)
+17 IF 'ERXLOCK
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET VALMBCK="R"
QUIT
+18 DO EN^PSOERX1(ERXIEN)
+19 DO UL^PSOERX1A(PATIEN)
+20 SET VALMBCK="R"
End DoDot:1
QUIT
+21 IF $DATA(STYP)
DO EN(.SRCHARY,STYP)
QUIT
+22 DO EN(.SRCHARY)
+23 QUIT
CENTSORT ;
+1 NEW RES,STYP,SVAL
+2 DO FULL^VALM1
+3 SET VALMBCK="R"
SET PSOC1RE=1
+4 SET RES=$$DIR(1,0)
+5 IF '+$PIECE(RES,U)
SET VALMBCK="R"
QUIT
+6 SET STYP=$PIECE(RES,U)
+7 IF $DATA(SRCHARY)
DO EN(.SRCHARY,STYP)
QUIT
+8 SET SORTBYCS=$$ASKCSSORT()
+9 if SORTBYCS'?1N
QUIT
+10 DO EN(,STYP,PCVSTAT)
+11 QUIT
ASKCSSORT() ;
+1 if PSOCSERX'="B"
QUIT 0
+2 SET DIR(0)="Y"
+3 SET DIR("B")="YES"
+4 WRITE !!,"Do you want to group by controlled substance? ",!
+5 DO ^DIR
+6 QUIT Y
SBN ;NOTES: KEEPS UNLOCKING REGARDLESS OF THE USER COMING BACK FROM AN ACTUAL LOCK. MAY NEED TO CONSIDER A TAG THAT DETERMINES WHETHER OR NOT TO
+1 ;GO TO THE LOCK IN THE FIRST PLACE, OR RE-WRITE THE ENTIRE SBN FUNCTIONS.
+2 NEW Y,ERXPAT,PATIEN,ERXLOCK,SRCH
+3 DO FULL^VALM1
+4 SET Y=+$PIECE(XQORNOD(0),"=",2)
+5 IF 'Y
SET VALMBCK="R"
QUIT
+6 SET PATIEN=$ORDER(@VALMAR@("IDX",Y,""))
if 'PATIEN
QUIT
+7 SET ERXLOCK=$$L^PSOERX1A(PATIEN,1)
+8 IF 'ERXLOCK
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET VALMBCK="R"
QUIT
+9 SET SRCH(1)=PATIEN
DO EN^PSOERX(.SRCH,,1)
+10 DO UL^PSOERX1A(PATIEN)
+11 SET VALMBCK="R"
+12 KILL %
+13 QUIT
PATDATA ;
+1 IF '$ORDER(@VALMAR@("IDX",0))
SET VALMSG="No records found!"
SET VALMBCK=""
QUIT
+2 NEW DIR,Y,RESP,PATIEN,SRCH
+3 DO FULL^VALM1
+4 SET DIR(0)="N^"_VALMBG_":"_VALMLST_":0"
DO ^DIR
+5 IF 'Y
SET VALMBCK="R"
QUIT
+6 SET RESP=Y
+7 SET PATIEN=$ORDER(@VALMAR@("IDX",RESP,""))
if 'PATIEN
QUIT
+8 SET ERXLOCK=$$L^PSOERX1A(PATIEN,1)
+9 IF 'ERXLOCK
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET VALMBCK="R"
QUIT
+10 SET SRCH(1)=PATIEN
DO EN^PSOERX(.SRCH,,1)
+11 DO UL^PSOERX1A(PATIEN)
+12 KILL %
+13 SET VALMBCK="R"
+14 QUIT
DIR(SORT,CNT,SLIST) ;
+1 NEW DIR,Y,RLINE,STAG,SVAL
+2 KILL DIR
+3 SET DIR(0)="SO^1:PATIENT NAME;2:DATE OF BIRTH"
+4 SET DIR(0)=DIR(0)_";3:"_$SELECT($GET(SORT):"ELAPSED DAYS (ED)",1:"ERX REFERENCE NUMBER")
+5 IF CNT<2
SET DIR("L")="Select one of the following "_$SELECT($GET(SORT):"sort",1:"search")_" criteria:"
+6 IF CNT>1
Begin DoDot:1
+7 SET DIR("L")=""
+8 SET DIR("L",11)="Select another search criteria or '^' to exit. Press enter to use the currently"
+9 SET DIR("L",12)="selected search criteria."
End DoDot:1
+10 SET DIR("L",2)=""
+11 SET DIR("L",3)=" "_$SELECT($DATA(SLIST(1)):"*",1:"")_"1.) PATIENT NAME"
+12 SET DIR("L",4)=" "_$SELECT($DATA(SLIST(2)):"*",1:"")_"2.) DATE OF BIRTH"
+13 SET DIR("L",5)=" "_$SELECT($DATA(SLIST(3)):"*",1:"")_"3.) "
+14 SET DIR("L",5)=DIR("L",5)_$SELECT($GET(SORT):"ELAPSED DAYS (ED)",1:"ERX REFERENCE NUMBER")
+15 SET DIR("L",6)=""
+16 SET DIR("L",7)=$SELECT($DATA(SLIST):" * - indicates selected criteria.",1:"")
+17 DO ^DIR
KILL DIR
if 'Y
QUIT 0
+18 SET RES=Y
IF $GET(SORT)
QUIT RES
+19 SET RLINE=$SELECT(RES=1:"PAT",RES=2:"DOB",RES=3:"EREFNUM",1:"")
+20 IF RLINE']""
QUIT 0
+21 SET STAG=RLINE
+22 SET SVAL=$$@STAG
IF SVAL=""
QUIT 0
+23 QUIT RES_U_SVAL
PAT() ;
+1 NEW Y,DIC
+2 SET DIC=52.46
SET DIC(0)="AEMQ"
DO ^DIC
+3 IF Y<1
QUIT ""
+4 QUIT Y
DOB() ;
+1 NEW %DT,Y
+2 SET %DT="A"
+3 SET %DT("A")="Enter the Date of Birth (DOB): "
+4 DO ^%DT
+5 IF Y<1
QUIT ""
+6 QUIT Y
EREFNUM() ;
+1 NEW DIR,Y
+2 SET DIR(0)="FO"
SET DIR("A")="Enter the eRx Reference number"
DO ^DIR
+3 IF Y=""!(Y="^")
QUIT ""
+4 QUIT $$UP^XLFSTR(Y)
BLDITEM(ERXIEN,PATCNT,STAT) ;
+1 NEW PATIEN,DOB,ERXSTAT,ERXESTAT,ESCODE,MTYPE,DRGCSCH,ERXCSFLG
+2 IF '$$CSFILTER^PSOERXUT(ERXIEN)
QUIT
+3 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+4 SET ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"I")
+5 SET ERXESTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
+6 ; If the eRx is a new refill request and the status is refill request new, check for a response.
+7 ; If no response within 14 days, change to RRE (refill request expired)
+8 IF MTYPE="RR"
IF ERXESTAT="RRN"
DO CHKEXP^PSOERX(ERXIEN,MTYPE)
+9 ; ChangeRequest messages will be checked for expiration status, but will not be displayed in the holding queue list view.
+10 IF MTYPE="CR"
IF ERXESTAT="CRN"
DO CHKEXP^PSOERX(ERXIEN,MTYPE)
+11 SET ESCODE=","_$SELECT($EXTRACT(ERXESTAT)="H":$EXTRACT(ERXESTAT),1:ERXESTAT)_","
+12 IF ",RXI,RXR,RXE,RXW,RXN,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,CXI,CXW,N,I,W,H,"'[ESCODE
QUIT
+13 IF $GET(STAT)]""
if '$$CHKSTAT(STAT,ERXESTAT,ERXSTAT)
QUIT
+14 SET PATIEN=$$GET1^DIQ(52.49,ERXIEN,.04,"I")
if 'PATIEN
QUIT
+15 IF $DATA(SRCH(1))
IF PATIEN'=$PIECE($GET(SRCH(1)),U)
QUIT
+16 SET DOB=$$GET1^DIQ(52.46,PATIEN,.08,"I")
+17 IF $DATA(SRCH(2))
IF DOB'=$GET(SRCH(2))
QUIT
+18 IF $DATA(^TMP("CENTRIC",$JOB,PATIEN))
QUIT
+19 SET ^TMP("CENTRIC",$JOB,PATIEN)=""
SET PATCNT=$GET(PATCNT)+1
+20 QUIT
CHKSTAT(FILSTAT,ERXSTAT,ERXISTAT) ;
+1 NEW RET,IWCHECK
+2 SET RET=0
+3 ; checking user selected PCV filter for IP or WAIT status - both pass as numeric
IF +$GET(FILSTAT)
SET IWCHECK=$$GET1^DIQ(52.45,FILSTAT,.01,"E")
+4 IF $GET(IWCHECK)="W"
QUIT $SELECT(",RXW,W,CXW,"'[(","_ERXSTAT_","):RET,1:1)
+5 IF $GET(IWCHECK)="I"
QUIT $SELECT(",RXI,I,CXI,"'[(","_ERXSTAT_","):RET,1:1)
+6 IF $GET(FILSTAT)="CCR"
QUIT $SELECT(",RXN,RXR,RXE,RXD,RXF,CAO,CAR,CAH,CAP,CAX,CAF,CXD,CXN,CXV,CXY,CXE,"'[(","_ERXSTAT_","):RET,1:1)
+7 IF $GET(FILSTAT)="AH"
QUIT $SELECT($EXTRACT(ERXSTAT)'="H":RET,1:1)
+8 IF $GET(FILSTAT)'="A"
IF FILSTAT'=ERXISTAT
QUIT RET
+9 QUIT 1
EX ; early exit logic
+1 KILL PSOSRCH,PSOSRT,SRCH,SORTT,PSOPRMPT
+2 SET PSOC1RE=1
+3 DO EX^PSOORFI1
+4 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL PSOPRMPT,@VALMAR
+2 KILL CSPREFIX,SORTBYCS
+3 SET PSOC1RE=1
+4 QUIT
+5 ;
EXPND ; -- expand code
+1 QUIT
