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