- PSOERRX0 ;BIRM/MFR - All Rxs eRx Queue - ListManager ;08/28/22
- ;;7.0;OUTPATIENT PHARMACY;**700,746**;DEC 1997;Build 106
- ;
- EN ; Entry point for the RX Action in the Patient Centric View
- N STSFLTR,MATFLTR,REDTFLTR,PRVFLTR,DRGFLTR,MSTPFLTR,MTARR,PSODETDP
- 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")
- ;
- ; Loading User's preferences
- 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"
- 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
- 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),$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_"("_$$GET1^DIQ(52.45,+STSFLTR,.01)_")"_IOINORM
- S DIR(0)=DIR(0)_";6: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_"("_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
- 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
- . K:X="^6" DRGFLTR K:X="^7" MSTPFLTR K:X="^10" PATFLTR,VPATFLTR K:X="^11" PRVFLTR,VPRVFLTR K:X="^12" MATFLTR
- . 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 CHANGE=1 G REP
- I PSOFPICK=2 D DOBFLTR^PSOERPC0 S CHANGE=1 G REP
- I PSOFPICK=3 D REDTFLTR S CHANGE=1 G REP
- I PSOFPICK=4 D PRVFLTR S CHANGE=1 G REP
- I PSOFPICK=5 D STSFLTR S CHANGE=1 G REP
- I PSOFPICK=6 D S CHANGE=1 G REP
- . D DRGFLTR
- 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 CHANGE=1 G REP
- I PSOFPICK=11 D VPRVFLTR^PSOERRX1 S CHANGE=1 G REP
- I PSOFPICK=12 D MATFLTR^PSOERPC0 S 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
- ;
- 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
- K DIR,DIRUT,DIROUT,X,Y
- W ! S DIR(0)="52.49,.08" S:$G(MSTPFLTR)'="" DIR("B")=MSTPFLTR
- D ^DIR I $D(DIRUT)!$D(DIROUT) Q
- S MSTPFLTR=Y
- Q
- ;
- STSFLTR ; - eRx Status Filter
- ; prompt for erx status
- N DIC,Y,DTOUT,DUOUT
- 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
- Q
- ;
- DRGFLTR ; - eRx Drug Name Filter
- N DIR,X,Y,DIRUT,DIROUT
- S DIR(0)="F^3:30",DIR("A")="DRUG NAME"
- W ! D ^DIR I $D(DIRUT)!$D(DIROUT) Q
- S DRGFLTR=Y
- Q
- ;
- RF ; Remove All Filters
- K PATFLTR,VPATFLTR,DOBFLTR,REDTFLTR,PRVFLTR,VPRVFLTR,STSFLTR,MSTPFLTR,DRGFLTR,MATFLTR
- D REF S VALMBG=1
- Q
- ;
- REF ;Screen Refresh
- W ?52,"Please wait..." D INIT,HDR S VALMBCK="R"
- 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 10850 printed Feb 18, 2025@23:54:20 Page 2
- PSOERRX0 ;BIRM/MFR - All Rxs eRx Queue - ListManager ;08/28/22
- +1 ;;7.0;OUTPATIENT PHARMACY;**700,746**;DEC 1997;Build 106
- +2 ;
- EN ; Entry point for the RX Action in the Patient Centric View
- +1 NEW STSFLTR,MATFLTR,REDTFLTR,PRVFLTR,DRGFLTR,MSTPFLTR,MTARR,PSODETDP
- +2 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
- +3 ;
- +4 ;Division selection
- +5 IF '$GET(PSOSITE)
- DO ^PSOLSET
- IF '$DATA(PSOPAR)
- WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
- GOTO EXIT
- +6 IF '$GET(PSNPINST)
- SET PSNPINST=$$GET1^DIQ(59,PSOSITE,101,"I")
- +7 ;
- +8 ; Loading User's preferences
- +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 DO LOAD^PSOERPR1
- +13 WRITE !,"Please wait..."
- +14 DO EN^VALM("PSO ERX ALL RXS QUEUE")
- +15 ;
- +16 GOTO EXIT
- +17 ;
- 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
- +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)
- SET $EXTRACT(X1,35)=$EXTRACT($PIECE(Z,"^",3),1,21)
- +25 IF $GET(MBMSITE)
- IF $EXTRACT($PIECE(Z,"^",5),1,3)="REM"
- SET $PIECE(Z,"^",5)="R"_$EXTRACT($PIECE(Z,"^",5),4,9)
- +26 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)
- +27 SET LINE=LINE+1
- SET ^TMP("PSOERRX0",$JOB,LINE,0)=X1
- SET ^TMP("PSOERRX0",$JOB,SEQ,"ERXIEN")=ERXIEN
- +28 IF $PIECE(Z1,"^",2)
- SET HIGHLN(LINE)=1
- +29 IF $GET(PSODETDP)
- DO SETDET^PSOERPT0(ERXIEN,.LINE,"PSOERRX0")
- End DoDot:2
- End DoDot:1
- +30 ;
- +31 ;Saving NORMAL video attributes to be reset later
- +32 IF LINE>$GET(LASTLINE)
- Begin DoDot:1
- +33 FOR I=($GET(LASTLINE)+1):1:LINE
- DO SAVE^VALM10(I)
- +34 SET LASTLINE=LINE
- End DoDot:1
- +35 DO VIDEO^PSOERPT1()
- +36 SET VALMCNT=+$GET(LINE)
- DO RV^PSOPMP1
- +37 QUIT
- +38 ;
- 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_"("_$$GET1^DIQ(52.45,+STSFLTR,.01)_")"_IOINORM
- +10 SET DIR(0)=DIR(0)_";6: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_"("_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 DO ^DIR
- +18 IF X'="^"
- IF X?1"^".N
- Begin DoDot:1
- +19 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
- +20 if X="^6"
- KILL DRGFLTR
- if X="^7"
- KILL MSTPFLTR
- if X="^10"
- KILL PATFLTR,VPATFLTR
- if X="^11"
- KILL PRVFLTR,VPRVFLTR
- if X="^12"
- KILL MATFLTR
- +21 SET CHANGE=1
- End DoDot:1
- GOTO REP
- +22 IF X=""!$DATA(DUOUT)!($DATA(DIRUT))
- if CHANGE
- DO REF
- if CHANGE
- SET VALMBG=1
- QUIT
- +23 SET PSOFPICK=+$GET(Y)
- +24 IF PSOFPICK=1
- DO EPATFLTR^PSOERPC0
- SET CHANGE=1
- GOTO REP
- +25 IF PSOFPICK=2
- DO DOBFLTR^PSOERPC0
- SET CHANGE=1
- GOTO REP
- +26 IF PSOFPICK=3
- DO REDTFLTR
- SET CHANGE=1
- GOTO REP
- +27 IF PSOFPICK=4
- DO PRVFLTR
- SET CHANGE=1
- GOTO REP
- +28 IF PSOFPICK=5
- DO STSFLTR
- SET CHANGE=1
- GOTO REP
- +29 IF PSOFPICK=6
- Begin DoDot:1
- +30 DO DRGFLTR
- End DoDot: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 CHANGE=1
- GOTO REP
- +47 IF PSOFPICK=11
- DO VPRVFLTR^PSOERRX1
- SET CHANGE=1
- GOTO REP
- +48 IF PSOFPICK=12
- DO MATFLTR^PSOERPC0
- SET CHANGE=1
- GOTO REP
- +49 DO REF
- SET VALMBG=1
- +50 QUIT
- +51 ;
- 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 KILL DIR
- SET DIR("A")="SELECT (1-"_+$GET(PRVLST("DILIST",0))_"): "
- +18 SET DIR(0)="LA^1:"_+$GET(PRVLST("DILIST",0))
- WRITE !
- DO ^DIR
- IF $DATA(DIRUT)!$DATA(DIROUT)
- GOTO PRVFLTR
- +19 SET RANGE=X
- +20 ;
- +21 KILL PRVFLTR
- +22 FOR I=1:1:$LENGTH(RANGE,",")
- Begin DoDot:1
- +23 SET COMSEG=$PIECE(RANGE,",",I)
- +24 FOR J=+COMSEG:1:$SELECT(COMSEG["-":$PIECE(COMSEG,"-",2),1:+COMSEG)
- Begin DoDot:2
- +25 IF '$DATA(PRVLST("DILIST",2,J))
- QUIT
- +26 SET PRVFLTR(PRVLST("DILIST",2,J))=""
- End DoDot:2
- End DoDot:1
- +27 QUIT
- +28 ;
- MSTPFLTR ; - Message Type Filter
- +1 KILL DIR,DIRUT,DIROUT,X,Y
- +2 WRITE !
- SET DIR(0)="52.49,.08"
- if $GET(MSTPFLTR)'=""
- SET DIR("B")=MSTPFLTR
- +3 DO ^DIR
- IF $DATA(DIRUT)!$DATA(DIROUT)
- QUIT
- +4 SET MSTPFLTR=Y
- +5 QUIT
- +6 ;
- STSFLTR ; - eRx Status Filter
- +1 ; prompt for erx status
- +2 NEW DIC,Y,DTOUT,DUOUT
- +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 QUIT
- +10 ;
- DRGFLTR ; - eRx Drug Name Filter
- +1 NEW DIR,X,Y,DIRUT,DIROUT
- +2 SET DIR(0)="F^3:30"
- SET DIR("A")="DRUG NAME"
- +3 WRITE !
- DO ^DIR
- IF $DATA(DIRUT)!$DATA(DIROUT)
- QUIT
- +4 SET DRGFLTR=Y
- +5 QUIT
- +6 ;
- RF ; Remove All Filters
- +1 KILL PATFLTR,VPATFLTR,DOBFLTR,REDTFLTR,PRVFLTR,VPRVFLTR,STSFLTR,MSTPFLTR,DRGFLTR,MATFLTR
- +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 ;
- 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