Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERRX0

PSOERRX0.m

Go to the documentation of this file.
  1. PSOERRX0 ;BIRM/MFR - All Rxs eRx Queue - ListManager ;08/28/22
  1. ;;7.0;OUTPATIENT PHARMACY;**700,746**;DEC 1997;Build 106
  1. ;
  1. EN ; Entry point for the RX Action in the Patient Centric View
  1. N STSFLTR,MATFLTR,REDTFLTR,PRVFLTR,DRGFLTR,MSTPFLTR,MTARR,PSODETDP
  1. S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
  1. ;
  1. ;Division selection
  1. I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT
  1. I '$G(PSNPINST) S PSNPINST=$$GET1^DIQ(59,PSOSITE,101,"I")
  1. ;
  1. ; Loading User's preferences
  1. S MTARR("RR")="RXRENEWALREQUEST",MTARR("RE")="RXRENEWALRESPONSE",MTARR("N")="NEWRX(ALL)",MTARR("CR")="RXCHANGEREQUEST"
  1. S MTARR("RXF")="RXFILL",MTARR("IE")="INBOUND ERROR",MTARR("OE")="OUTBOUND ERROR",MTARR("CA")="CANCELRX",MTARR("CN")="CANCELRXRESPONSE"
  1. S MTARR("CX")="RXCHANGERESPONSE",MTARR("N")="NEWRX"
  1. D LOAD^PSOERPR1
  1. W !,"Please wait..."
  1. D EN^VALM("PSO ERX ALL RXS QUEUE")
  1. ;
  1. G EXIT
  1. ;
  1. LMHDR ; ListMan Header Code
  1. D SHOW^VALM,HDR^PSOERRX0
  1. I $G(MBMSITE) S XQORM("B")="Next Screen"
  1. S XQORM("#")=$O(^ORD(101,"B","PSO ERX ALL RXS SELECT",""))_"^1:"_VALMCNT
  1. S XQORM("??")="D HELP^VALM2,HDR^PSOERRX0"
  1. Q
  1. ;
  1. HDR ; - Builds the Header section
  1. D HDR^PSOERRX1
  1. Q
  1. ;
  1. INIT ;Populates the Body section for ListMan
  1. N LOCKPATS,PAT
  1. K ^TMP("PSOERRX0",$J),^TMP("PSOERRXS",$J)
  1. S PAT=0 F S PAT=$O(^XTMP("PSOERXLOCK",PAT)) Q:'PAT S LOCKPATS(PAT)=+$G(^XTMP("PSOERXLOCK",PAT))
  1. D SETSORT^PSOERRX1(PSOSRTBY),SETLINE
  1. S:$G(VALMSG)="" VALMSG="Select the entry # to view or ?? for more actions"
  1. Q
  1. ;
  1. SETLINE ;Sets the line to be displayed in ListMan
  1. N SORT,TYPE,STS,SUB,SEQ,LINE,Z,Z1,TOTAL,I,X,X1,ORDCNT,LBL,LN,GROUP,QTYL,ORNUM1,ERXIEN1,HIGHLN
  1. N X,POS
  1. K ^TMP("PSOERRX0",$J)
  1. I '$D(^TMP("PSOERRXS",$J)) D Q
  1. . F I=1:1:6 S ^TMP("PSOERRX0",$J,I,0)=""
  1. . S ^TMP("PSOERRX0",$J,7,0)=" No prescriptions found."
  1. . S VALMCNT=1
  1. ;
  1. ;Resetting list to NORMAL video attributes
  1. D RESET^PSOERUT0() K GRPLN
  1. ;
  1. ;Building the list (line by line)
  1. S (GROUP,SORT)="",(SEQ,LINE)=0,SORTORD=$S(PSORDER="A":1,1:-1)
  1. F S GROUP=$O(^TMP("PSOERRXS",$J,GROUP)) Q:GROUP="" D
  1. . I GROUP'="ALL" D
  1. . . N LBL,POS,X
  1. . . S LBL=$S(GROUP="NON-CS":"NON-",1:"")_"CONTROLLED SUBSTANCE Rx's"
  1. . . S POS=41-($L(LBL)\2) S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL
  1. . . S LINE=LINE+1,^TMP("PSOERRX0",$J,LINE,0)=X,GRPLN(LINE)=LBL
  1. . F S SORT=$O(^TMP("PSOERRXS",$J,GROUP,SORT),SORTORD) Q:SORT="" D
  1. . . S Z=$G(^TMP("PSOERRXS",$J,GROUP,SORT)),SEQ=SEQ+1
  1. . . S Z1=$G(^TMP("PSOERRXS",$J,GROUP,SORT,"ERXIEN")),ERXIEN=+Z1
  1. . . S X1=SEQ_$S(+$G(^PS(52.49,ERXIEN,95)):"]",1:".")
  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)
  1. . . I $G(MBMSITE),$E($P(Z,"^",5),1,3)="REM" S $P(Z,"^",5)="R"_$E($P(Z,"^",5),4,9)
  1. . . 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)
  1. . . S LINE=LINE+1,^TMP("PSOERRX0",$J,LINE,0)=X1,^TMP("PSOERRX0",$J,SEQ,"ERXIEN")=ERXIEN
  1. . . I $P(Z1,"^",2) S HIGHLN(LINE)=1
  1. . . I $G(PSODETDP) D SETDET^PSOERPT0(ERXIEN,.LINE,"PSOERRX0")
  1. ;
  1. ;Saving NORMAL video attributes to be reset later
  1. I LINE>$G(LASTLINE) D
  1. . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
  1. . S LASTLINE=LINE
  1. D VIDEO^PSOERPT1()
  1. S VALMCNT=+$G(LINE) D RV^PSOPMP1
  1. Q
  1. ;
  1. FLTRMT(MSGTYPE) ; Filter By Message Type Action
  1. S MSTPFLTR=MSGTYPE
  1. D REF S VALMBCK="R",VALMBG=1
  1. Q
  1. ;
  1. CS ;Group/Un-group Controlled Substances
  1. S PSOCSGRP=$S($G(PSOCSGRP):0,1:1) D REF
  1. Q
  1. ;
  1. DET ;Display/Remove DET
  1. S PSODETDP=$S($G(PSODETDP):0,1:1),LINE=0 D REF
  1. I 'PSODETDP S VALMBG=VALMBG\2
  1. I PSODETDP S VALMBG=VALMBG*2-1
  1. S:VALMBG>(VALMCNT-10) VALMBG=VALMCNT-10 S:VALMBG<1 VALMBG=1
  1. Q
  1. ;
  1. CV ;Change View
  1. D EN^PSOERPR1 I $G(PSORFRSH) D REF S VALMBG=1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. SORT(FIELD) ;Sort entries by FIELD
  1. I PSOSRTBY=FIELD S PSORDER=$S(PSORDER="A":"D",1:"A")
  1. E S PSOSRTBY=FIELD,PSORDER="A"
  1. D REF
  1. Q
  1. ;
  1. LBD ;Change Look Back Days Parameter Action
  1. D FULL^VALM1 S VALMBCK="R"
  1. W ! K DIR,DIRUT,DIROUT,SAVEX,DA
  1. S DIR(0)="52.353,1",DIR("B")=PSOLKBKD
  1. D ^DIR I $D(DIRUT)!$D(DIROUT) Q
  1. S PSOLKBKD=Y,RESETLBD=0 D REF S VALMBG=1
  1. Q
  1. ;
  1. PC ;Patient Centri View Switch
  1. D EN^PSOERPC0 S VALMBCK="Q"
  1. Q
  1. ;
  1. SEL ;Process selection of one entry
  1. N PSOSEL,ERXIEN,ERXPTIEN
  1. S VALMBCK="R"
  1. S PSOSEL=+$P(XQORNOD(0),"=",2) I 'PSOSEL S VALMSG="Invalid selection!" Q
  1. S ERXIEN=$G(^TMP("PSOERRX0",$J,PSOSEL,"ERXIEN")) I 'ERXIEN S VALMSG="Invalid selection!" Q
  1. S ERXPTIEN=$$GETPAT^PSOERXU5(ERXIEN)
  1. ; - Locking the eRx Patient
  1. I ERXPTIEN,'$$LOCK^PSOERPC1(ERXPTIEN) Q
  1. ; - Entering the eRx Record
  1. D EN^PSOERX1(ERXIEN) K ERXIEN
  1. ; - Unlocking the eRx Patient
  1. I ERXPTIEN D UL^PSOERX1A(ERXPTIEN)
  1. I $G(PSORFRSH) D REF
  1. Q
  1. ;
  1. SQ ; - Search Queue Entry Point
  1. D FULL^VALM1 S VALMBCK="R"
  1. N DIR,DUOUT,DIRUT,Y,X,CHANGE,ERXLOCK,ERXPTIEN,PSOFPICK
  1. S CHANGE=0
  1. REP ; Re-Entry Point
  1. K DIR S DIR("?",1)="Choose one or multiple filter criteria(s) to sort the current list."
  1. S DIR("?",2)="To remove an existing filter type ^#, where '#' is the filter number below."
  1. S DIR("?")=" "
  1. S DIR("A")="SEARCH BY"
  1. S DIR(0)="SO^1:ERX PATIENT" I $D(PATFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$EPATFLST^PSOERUT(44)_")"_IOINORM
  1. S DIR(0)=DIR(0)_";2:ERX DATE OF BIRTH" I $G(DOBFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$FMTE^XLFDT(DOBFLTR,"2Z")_")"_IOINORM
  1. 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
  1. S DIR(0)=DIR(0)_";4:ERX PROVIDER" I $D(PRVFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$EPRVFLST^PSOERUT(44)_")"_IOINORM
  1. S DIR(0)=DIR(0)_";5:ERX STATUS" I $G(STSFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$GET1^DIQ(52.45,+STSFLTR,.01)_")"_IOINORM
  1. S DIR(0)=DIR(0)_";6:DRUG NAME" I $G(DRGFLTR)'="" S DIR(0)=DIR(0)_" "_IOINHI_"('"_DRGFLTR_"')"_IOINORM
  1. S DIR(0)=DIR(0)_";7:MESSAGE TYPE" I $G(MSTPFLTR)'="" S DIR(0)=DIR(0)_" "_IOINHI_"("_MTARR(MSTPFLTR)_")"_IOINORM
  1. S DIR(0)=DIR(0)_";8:ERX REFERENCE NUMBER"
  1. S DIR(0)=DIR(0)_";9:VISTA RX #"
  1. S DIR(0)=DIR(0)_";10:VISTA PATIENT" I $D(VPATFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$VPATFLST^PSOERUT(44)_")"_IOINORM
  1. S DIR(0)=DIR(0)_";11:VISTA PROVIDER" I $D(VPRVFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$VPRVFLST^PSOERUT(44)_")"_IOINORM
  1. S DIR(0)=DIR(0)_";12:MATCH STATUS" I $G(MATFLTR) S DIR(0)=DIR(0)_" "_IOINHI_"("_$$MATCHLBL^PSOERPC2(MATFLTR)_")"_IOINORM
  1. D ^DIR
  1. I X'="^",X?1"^".N D G REP
  1. . K:X="^1" PATFLTR,VPATFLTR K:X="^2" DOBFLTR K:X="^3" REDTFLTR K:X="^4" PRVFLTR,VPRVFLTR K:X="^5" STSFLTR
  1. . K:X="^6" DRGFLTR K:X="^7" MSTPFLTR K:X="^10" PATFLTR,VPATFLTR K:X="^11" PRVFLTR,VPRVFLTR K:X="^12" MATFLTR
  1. . S CHANGE=1
  1. I X=""!$D(DUOUT)!($D(DIRUT)) D:CHANGE REF S:CHANGE VALMBG=1 Q
  1. S PSOFPICK=+$G(Y)
  1. I PSOFPICK=1 D EPATFLTR^PSOERPC0 S CHANGE=1 G REP
  1. I PSOFPICK=2 D DOBFLTR^PSOERPC0 S CHANGE=1 G REP
  1. I PSOFPICK=3 D REDTFLTR S CHANGE=1 G REP
  1. I PSOFPICK=4 D PRVFLTR S CHANGE=1 G REP
  1. I PSOFPICK=5 D STSFLTR S CHANGE=1 G REP
  1. I PSOFPICK=6 D S CHANGE=1 G REP
  1. . D DRGFLTR
  1. I PSOFPICK=7 D MSTPFLTR S CHANGE=1 G REP
  1. I PSOFPICK=8 D ERXFLTR^PSOERPC0 G:'$G(ERXFLTR) REP D I '$G(CHANGE) Q
  1. . ; - Entering the eRx Record
  1. . D EN^PSOERX1(ERXFLTR)
  1. . ; - Unlocking the eRx Patient
  1. . S ERXPTIEN=$$GET1^DIQ(52.49,ERXFLTR,.04,"I") Q:'ERXPTIEN
  1. . D UL^PSOERX1A(ERXPTIEN)
  1. . S CHANGE=1
  1. I PSOFPICK=9 D RXFLTR^PSOERPC0 G:'$G(ERXFLTR) REP D I '$G(CHANGE) Q
  1. . ; - Entering the eRx Record
  1. . D EN^PSOERX1(ERXFLTR)
  1. . ; - Unlocking the eRx Patient
  1. . S ERXPTIEN=$$GET1^DIQ(52.49,ERXFLTR,.04,"I") Q:'ERXPTIEN
  1. . D UL^PSOERX1A(ERXPTIEN)
  1. . S CHANGE=1
  1. I PSOFPICK=10 D VPATFLTR^PSOERPC0 S CHANGE=1 G REP
  1. I PSOFPICK=11 D VPRVFLTR^PSOERRX1 S CHANGE=1 G REP
  1. I PSOFPICK=12 D MATFLTR^PSOERPC0 S CHANGE=1 G REP
  1. D REF S VALMBG=1
  1. Q
  1. ;
  1. REDTFLTR ; - Received Date Range Filter
  1. N %DT,PSOFROM,PSOTO,Y,DTOUT,DIROUT
  1. S %DT(0)=-DT,%DT="AEP",%DT("A")="BEGIN DATE: "
  1. S %DT("B")="T-45" I $P($G(REDTFLTR),"^") S %DT("B")=$$FMTE^XLFDT($P($G(REDTFLTR),"^"),"5Z")
  1. W ! D ^%DT I Y<0!($D(DTOUT)) Q
  1. S PSOFROM=Y\1
  1. ;
  1. K %DT S %DT(0)=PSOFROM\1,%DT="AEP",%DT("A")="END DATE: "
  1. S %DT("B")="TODAY" I $P($G(REDTFLTR),"^",2) S %DT("B")=$$FMTE^XLFDT($P($G(REDTFLTR),"^",2),"5Z")
  1. W ! D ^%DT I Y<0!($D(DTOUT)) Q
  1. S PSOTO=Y\1
  1. ;
  1. S REDTFLTR=PSOFROM_"^"_PSOTO
  1. Q
  1. ;
  1. PRVFLTR ; - eRx Provider Filter
  1. N DIR,PRV,XX,PRVLST,RANGE,COMSEG,I,J,DIRUT,DIROUT,QUIT
  1. S DIR(0)="F^3:30",DIR("A")="ERX PROVIDER NAME"
  1. W ! D ^DIR I $D(DIRUT)!$D(DIROUT) Q
  1. D FIND^DIC(52.48,"","@;.01;1.5;1.6;4.3;4.4;IX","",X,,"B","","","PRVLST")
  1. I '$D(PRVLST("DILIST",2)) W !,"No eRx Provider found" K PRVLST G PRVFLTR
  1. ;
  1. W !!,"#",?4,"ERX PROVIDER NAME",?35,"NPI",?48,"CITY",?68,"STATE"
  1. S (QUIT,CNT)=0,$P(XX,"-",80)="" W !,XX K DIRUT,DTOUT
  1. S PRV="" F S PRV=$O(PRVLST("DILIST","ID",PRV)) Q:'PRV D I QUIT Q
  1. . W !,PRV,".",?4,$E(PRVLST("DILIST","ID",PRV,.01),1,30),?35,PRVLST("DILIST","ID",PRV,1.5)
  1. . W ?48,$E(PRVLST("DILIST","ID",PRV,4.3),1,20),?68,$$STATEABB^PSOERUT(52.48,PRVLST("DILIST",2,PRV))
  1. . S CNT=CNT+1
  1. . I CNT>18,$O(PRVLST("DILIST","ID",PRV)),$Y>(IOSL-4) D
  1. . . K DIR S DIR(0)="E" D ^DIR I $D(DIRUT)!$D(DIROUT) S QUIT=1 Q
  1. . . W @IOF,!,"#",?4,"ERX PROVIDER NAME",?35,"NPI",?48,"CITY",?68,"STATE",!,XX
  1. ;
  1. K DIR S DIR("A")="SELECT (1-"_+$G(PRVLST("DILIST",0))_"): "
  1. S DIR(0)="LA^1:"_+$G(PRVLST("DILIST",0)) W ! D ^DIR I $D(DIRUT)!$D(DIROUT) G PRVFLTR
  1. S RANGE=X
  1. ;
  1. K PRVFLTR
  1. F I=1:1:$L(RANGE,",") D
  1. . S COMSEG=$P(RANGE,",",I)
  1. . F J=+COMSEG:1:$S(COMSEG["-":$P(COMSEG,"-",2),1:+COMSEG) D
  1. . . I '$D(PRVLST("DILIST",2,J)) Q
  1. . . S PRVFLTR(PRVLST("DILIST",2,J))=""
  1. Q
  1. ;
  1. MSTPFLTR ; - Message Type Filter
  1. K DIR,DIRUT,DIROUT,X,Y
  1. W ! S DIR(0)="52.49,.08" S:$G(MSTPFLTR)'="" DIR("B")=MSTPFLTR
  1. D ^DIR I $D(DIRUT)!$D(DIROUT) Q
  1. S MSTPFLTR=Y
  1. Q
  1. ;
  1. STSFLTR ; - eRx Status Filter
  1. ; prompt for erx status
  1. N DIC,Y,DTOUT,DUOUT
  1. I $G(STSFLTR) S DIC("B")=$$GET1^DIQ(52.45,STSFLTR,.01)
  1. S DIC("A")="ERX STATUS: ",DIC=52.45,DIC(0)="AEQ",DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y))"
  1. ; MbM Sites only - Allow selection of Removed Reasons as Status
  1. I $G(MBMSITE) S DIC("S")=DIC("S")_"!$D(^PS(52.45,""TYPE"",""REM"",Y))"
  1. W ! D ^DIC I Y<1 Q
  1. S STSFLTR=+Y
  1. Q
  1. ;
  1. DRGFLTR ; - eRx Drug Name Filter
  1. N DIR,X,Y,DIRUT,DIROUT
  1. S DIR(0)="F^3:30",DIR("A")="DRUG NAME"
  1. W ! D ^DIR I $D(DIRUT)!$D(DIROUT) Q
  1. S DRGFLTR=Y
  1. Q
  1. ;
  1. RF ; Remove All Filters
  1. K PATFLTR,VPATFLTR,DOBFLTR,REDTFLTR,PRVFLTR,VPRVFLTR,STSFLTR,MSTPFLTR,DRGFLTR,MATFLTR
  1. D REF S VALMBG=1
  1. Q
  1. ;
  1. REF ;Screen Refresh
  1. W ?52,"Please wait..." D INIT,HDR S VALMBCK="R"
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ;
  1. K ^TMP("PSOERRX0",$J),^TMP("PSOERRXS",$J)
  1. D FULL^VALM1
  1. Q