PSOERSE3 ;ALB/RM - PSO ERX SINGLE ERX DISPLAY INIT section continuation ;Jan 30, 2024@12:43:34
;;7.0;OUTPATIENT PHARMACY;**746,769,770**;DEC 16, 1997;Build 145
;
DISPRX ;continuation of PSOERSE2 routine
N VADRGNME,ERXCOMM,VLOOP,SLOOP,VASIG,FSVPIN,COMARY,COM,FSSIG,VAPIARY,VASARY,DRMANVAL
I "RR,CA,CN,IE"'[MTYPE!(MTYPE="N") D
. I MTYPE="RE",$$GET1^DIQ(52.49,PSOIEN,52.1,"I")'="R" Q
. S LINE=LINE+1 D SET^VALM10(LINE,"")
. S PSNF="" I $G(VADRGIEN) S PSNF=$S($P(^PSDRUG(VADRGIEN,0),"^",9):"***(N/F)***",1:"") ;p689
. S LINE=LINE+1
. S VADRGNME=VADRG_" "_$P($$VADRSCH^PSOERXUT(VADRGIEN),"^",3)_PSNF
. S DRMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.5,"I")
. D SET^VALM10(LINE,"Vista Drug"_$S($G(DRMANVAL):"[v]",1:"")_": "_VADRGNME)
. D CNTRL^VALM10(LINE,$S($G(DRMANVAL):15,1:13),$L(VADRGNME),IOINHI,IOINORM)
. D ADDITEM^PSOERX1A(.LINETXT,"Vista Qty: ",$G(VAQTY),1,25)
. D ADDITEM^PSOERX1A(.LINETXT,"Vista Refills: ",$G(VAREF),27,18)
. D ADDITEM^PSOERX1A(.LINETXT,"Vista Days Supply: ",$G(VADAYS),54,22)
. S LINE=LINE+1 D SET^VALM10(LINE,LINETXT) S LINETXT=""
. D CNTRL^VALM10(LINE,12,$L(VAQTY),IOINHI,IOINORM)
. D CNTRL^VALM10(LINE,43,$L(VAREF),IOINHI,IOINORM)
. D CNTRL^VALM10(LINE,74,$L(VADAYS),IOINHI,IOINORM)
. S VASIG=""
. S SLOOP=0 F S SLOOP=$O(^PS(52.49,PSOIEN,"SIG",SLOOP)) Q:'SLOOP D
. . I '$L($G(VASIG)) S VASIG=$G(^PS(52.49,PSOIEN,"SIG",SLOOP,0)) Q
. . S VASIG=$G(VASIG)_" "_$G(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
. D TXT2ARY^PSOERXD1(.VASARY,VASIG,,68)
. S FSSIG=$O(VASARY(0))
. S ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
. S ERXDSUB=$S(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
. S LINE=LINE+1 D SET^VALM10(LINE,"Substitutions?: "_ERXDSUB)
. I ERXDSUB'="" D CNTRL^VALM10(LINE,17,$L(ERXDSUB),IOINHI,IOINORM)
. S LINE=LINE+1 D SET^VALM10(LINE,"Vista Sig: "_$S(FSSIG:$G(VASARY(FSSIG)),1:""))
. I +FSSIG>0 D CNTRL^VALM10(LINE,12,$L(VASARY(FSSIG)),IOINHI,IOINORM)
. S SLOOP=1 F S SLOOP=$O(VASARY(SLOOP)) Q:'SLOOP D
. . S LINE=LINE+1 D SET^VALM10(LINE," "_VASARY(SLOOP)),CNTRL^VALM10(LINE,12,$L(VASARY(SLOOP)),IOINHI,IOINORM)
. S VPATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
. I VPATINST]"" S VPATINST=$$LSIG^PSOQUTIL(VPATINST)
. D TXT2ARY^PSOERXD1(.VAPIARY,VPATINST," ",68)
. S FSVPIN=$O(VAPIARY(0))
. S LINE=LINE+1 D SET^VALM10(LINE," Pat Inst: "_$S(FSVPIN:$G(VAPIARY(FSVPIN)),1:""))
. I +FSVPIN>0 D CNTRL^VALM10(LINE,12,$L(VAPIARY(FSVPIN)),IOINHI,IOINORM)
. S VLOOP=1 F S VLOOP=$O(VAPIARY(VLOOP)) Q:'VLOOP D
. . S LINE=LINE+1 D SET^VALM10(LINE," "_VAPIARY(VLOOP)),CNTRL^VALM10(LINE,12,$L(VAPIARY(VLOOP)),IOINHI,IOINORM)
S ERXCOMM="eRx Notes: "_$$GET1^DIQ(52.49,PSOIEN,8,"E")
D TXT2ARY^PSOERXD1(.COMARY,ERXCOMM," ",68)
S COM=0 F S COM=$O(COMARY(COM)) Q:'COM D
. S LINE=LINE+1 D SET^VALM10(LINE,$G(COMARY(COM)))
. I COM=1 D CNTRL^VALM10(LINE,12,$L($G(COMARY(COM))),IOINHI,IOINORM) Q
. D CNTRL^VALM10(LINE,1,$L($G(COMARY(COM))),IOINHI,IOINORM)
I $$GET1^DIQ(52.49,PSOIEN,.05,"I") D
. D ALG(.LINE)
I '$G(S2017) D
. D DIAG^PSOERXU1(PSOIEN,.LINE)
I $G(S2017) D
. D:MEDIEN DIAG2017^PSOERXU5(PSOIEN,.LINE,,MEDIEN)
I $$GET1^DIQ(52.49,PSOIEN,95.1,"I") D
. D DEANOTE^PSOERSE1(.LINE) ; DEA Note for CS Digitally Signed eRx records
Q
;
ALG(LINE) ;
N ALGINFO,ALGLINE,DFN,IEN,XX,LDAT,GMRAL,PSONOAL,II,LDATA
S ALGLINE=""
S DFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
D EN1^GMRADPT
S IEN=1
I 'GMRAL D
. S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Allergies: "_$S(GMRAL=0:"NKA",1:"")
. I GMRAL'=0 S PSONOAL="" D ALLERGY^PSOORUT2 I PSONOAL'="" S ^TMP("PSOPI",$J,IEN,0)="Allergies: "_PSONOAL K PSONOAL
. S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" "
. D REMOTE^PSOORUT2
. S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Adverse Reactions:"
D:$G(GMRAL) ^PSOORUT3
S XX=0 F S XX=$O(^TMP("PSOPI",$J,XX)) Q:'XX D
. S LDAT=$G(^TMP("PSOPI",$J,XX,0))
. I $G(LDAT)=" " Q
. S LINE=LINE+1
. D SET^VALM10(LINE,LDAT)
. I $G(LDAT)["Allergies"!($G(LDAT)["Adverse Reactions") Q
. S LDAT=$S(LDAT[":":$P(LDAT,":",2),1:LDAT)
. D CNTRL^VALM10(LINE,15,$L(LDAT)+2,IOINHI,IOINORM)
K ^TMP("PSOPI",$J)
Q
;
DSPLYDUE(ERXIEN,LINE,DSPLYTO,TMPGBL) ;Display the Prescriber Drug Use Evaluation
;Inputs: (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
; (r) LINE - List Manager line
; (o) DSPLYTO - Vista=0 (default), CPRS=1
; (o) TMPGBL - The temporary global if the DUE is displayed in CPRS
;
N PDRGDUE,PDUEHDR,DUECNT,COAGENT,REASON,RESULT,ACK,PDUETOTAL,DDOT
I '+$G(DSPLYTO) S DSPLYTO=0
D PDUEDATA^PSOERXU9(.PDRGDUE,ERXIEN,1) ;1 means to display the DUE in alphabetical order
S PDUEHDR="Prescriber Drug Use Evaluation: "_$S('$D(PDRGDUE):"NONE",1:"")
S LINE=LINE+1
I '+$G(DSPLYTO) D SET^VALM10(LINE,PDUEHDR),CNTRL^VALM10(LINE,33,4,IOINHI,IOINORM)
E S @TMPGBL@(LINE,0)=PDUEHDR
;
I $D(PDRGDUE) D
. S PDUETOTAL=$O(PDRGDUE(""),-1)
. S $P(DDOT,".",81)=""
. S DUECNT=0 F S DUECNT=$O(PDRGDUE(DUECNT)) Q:'DUECNT D
. . K COAGENT,REASON,RESULT,ACK
. . S COAGENT="Co-Agent: "_$P(PDRGDUE(DUECNT),"^",8)
. . S REASON=$P(PDRGDUE(DUECNT),"^",2) I $$PRESOLV^PSOERXA1(REASON,"REA") S REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
. . S REASON="Reason: "_REASON
. . S RESULT=$P(PDRGDUE(DUECNT),"^",4) I $$PRESOLV^PSOERXA1(RESULT,"RES") S RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
. . S RESULT="Result: "_RESULT
. . S ACK="Override: "_$P(PDRGDUE(DUECNT),"^",9)
. . ;
. . I '+$G(DSPLYTO) D Q ;display the DUE in Vista
. . . S LINE=LINE+1 D SET^VALM10(LINE,COAGENT),CNTRL^VALM10(LINE,11,$L(COAGENT)+1,IOINHI,IOINORM)
. . . S LINE=LINE+1 D SET^VALM10(LINE,REASON),CNTRL^VALM10(LINE,9,$L(REASON)+1,IOINHI,IOINORM)
. . . S LINE=LINE+1 D SET^VALM10(LINE,RESULT),CNTRL^VALM10(LINE,9,$L(RESULT)+1,IOINHI,IOINORM)
. . . S LINE=LINE+1 D SET^VALM10(LINE,ACK),CNTRL^VALM10(LINE,11,$L(ACK)+1,IOINHI,IOINORM)
. . . I DUECNT'=+$G(PDUETOTAL) S LINE=LINE+1 D SET^VALM10(LINE,DDOT)
. . ;
. . ;display the DUE in CPRS Addendum
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=COAGENT
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=REASON
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=RESULT
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=ACK
. . I DUECNT'=+$G(PDUETOTAL) S LINE=LINE+1,@TMPGBL@(LINE,0)=DDOT
I +$G(DSPLYTO)=1 S LINE=LINE+1,@TMPGBL@(LINE,0)=""
Q
;
ACCEPT ; Validate All Matches (Patient/Provider/Drug) & Accept eRx
N PASSTRHU,ERXSTS,DIR D FULL^VALM1 S VALMBCK="R"
S PASSTRHU=0 I $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE",$$GET1^DIQ(52.49,ERXIEN,52.1,"I")'="R" S PASSTRHU=1
S ERXSTS=$$GET1^DIQ(52.49,ERXIEN,1)
I ERXSTS="RJ"!(ERXSTS="RM")!($E(ERXSTS,1,3)="REM")!(ERXSTS="PR")!(ERXSTS="CXP")!(ERXSTS="RXP") D Q
. W !!,"Cannot accept a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
. K DIR S DIR(0)="E" D ^DIR
; MbM site won't validate the patient
I 'PASSTRHU D
. I 'PASSTRHU,'$$GET1^DIQ(52.49,ERXIEN,1.7,"I") D
. . I '$G(MBMSITE) W !!,"Validating Patient..." D ACVAL^PSOERX1B(ERXIEN,"P",1)
. . I $G(MBMSITE) W !!,"Patient has not been validated!",!,$C(7) K DIR S DIR(0)="E" D ^DIR
. I '$$GET1^DIQ(52.49,ERXIEN,1.3,"I") D
. . W !!,"Validating Provider..." D ACVAL^PSOERX1B(ERXIEN,"PR",1)
. I '$$GET1^DIQ(52.49,ERXIEN,1.5,"I") D
. . W !!,"Validating Drug/SIG..." D ACVAL^PSOERX1B(ERXIEN,"D",1)
;
I PASSTRHU!($$GET1^DIQ(52.49,ERXIEN,1.7,"I")&$$GET1^DIQ(52.49,ERXIEN,1.3,"I")&$$GET1^DIQ(52.49,ERXIEN,1.5,"I")) D
. N DIR,PSOIEN
. ;Accepting the eRx
. S PSOIEN=ERXIEN D SETUP^PSOERX1F
E D:$G(MBMSITE) REF^PSOERSE1 Q
S VALMBCK="Q" I $G(MBMSITE) D REF^PSOERSE1
Q
;
NEXTDRUG ; Automatically Selects the Next Drug
N NEXTERX,FROMLIST
;
I '$G(EPATIEN) S EPATIEN=$$GET1^DIQ(52.49,+$G(PSOIEN),.04,"I") I 'EPATIEN Q
S FROMLIST='$G(PSOIEN),VALMBCK="Q"
; - Locking the eRx Patient
S NEXTERX=$$NEXTERX^PSOERSE3(EPATIEN,+$G(PSOIEN))
I 'NEXTERX S NEXTERX=$$NEXTERX^PSOERSE3(EPATIEN,0) I 'NEXTERX Q
S (ERXIEN,PSOIEN)=NEXTERX
I $G(PRINTFLG)'="VD" D EN^PSOERXD1
E D INIT^PSOERXD1,HDR^PSOERXD1 S VALMBCK="R" Q
I FROMLIST D EN^PSOERSE1(PSOIEN)
E D INIT^PSOERSE1,HDR^PSOERSE1
I FROMLIST K PSOIEN
Q
;
NEXTERX(ERXPAT,ERXIEN) ; Returns the next Actionable eRx for the Patient
; Input:(r) ERXPAT - Pointer to the ERX EXTERNAL PATIENT file (#52.46)
; (r) ERXIEN - Current eRx - Pointer to the ERX HOLDING QUEUE file (#52.49)
;Output: NEXTERX - Next eRx for the eRx Patient
N NEXTERX,ERX,BEGDATE,ENDDATE,MSGDT,STATUS
S (NEXTERX,ERX)=0,BEGDATE=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1,ENDDATE=DT+.99,MSGDT=BEGDATE
F S MSGDT=$O(^PS(52.49,"PAT2",ERXPAT,MSGDT)) Q:'MSGDT!(MSGDT>ENDDATE) D I NEXTERX Q
. F S ERX=$O(^PS(52.49,"PAT2",ERXPAT,MSGDT,ERX)) Q:'ERX D I NEXTERX Q
. . I ERX'>ERXIEN Q
. . S STATUS=$$GET1^DIQ(52.49,ERX,1)
. . I $F(",RJ,RM,REM,PR,E,RXA,CXA,CAA,CAN,CXP,RXP,RXA,ICA,CNP,CRP,CRC,RRC,CXC,CNE,CRN,CRR,CRX,CXQ,RXA,RXC,RRN,RRX,RRR,RRP,IRA,",","_$E(STATUS,1,3)_",") Q
. . S NEXTERX=ERX
Q NEXTERX
;
EDITDRUG ; Edit Drug fields from Single eRx View/Display
N Y,CURPAGE,XQORM
S VALMBCK="R",CURPAGE=VALMBG
S Y=$P(XQORNOD(0),"=",2) I Y']"" Q
;
I +Y'=1,'$$GET1^DIQ(52.49,PSOIEN,3.2,"I")!'$D(^PS(52.49,PSOIEN,21)) D S VALMBCK="R" Q
. S VALMSG="You must update the Dispense Drug first!" W $C(7)
;
D EDIT^PSOERX1A("D",Y)
D REF^PSOERSE1 S VALMBG=+$G(CURPAGE)
Q
;
MISSINGPI(ERXIEN) ; Returns whether it is likely the eRx should have Patient Instructions entered or not
; Input: (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
;Output: MISSINGPI - 0: Pat.Instr. not likely missing | 1: Pat.Instr. is likely missing
;
N SUGRXIEN,MSGTYPE
I '$D(^PS(52.49,+$G(ERXIEN),0)) Q 0
I $$GET1^DIQ(52.49,ERXIEN,1.4,"I")'=1 Q 0 ; Not auto-matched
I '$F(",N,RE,",","_$E($$GET1^DIQ(52.49,ERXIEN,.08,"I"))_",") Q 0
I '$F(",I,N,W,H,",","_$E($$GET1^DIQ(52.49,ERXIEN,1,"E"))_",") Q 0
I $$GET1^DIQ(52.49,ERXIEN,27)'="" Q 0
S SUGRXIEN=$$GET1^DIQ(52.49,ERXIEN,.15,"I") I 'SUGRXIEN Q 0
I $$VARXPI^PSOERUT(SUGRXIEN)="" Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERSE3 10059 printed Aug 26, 2025@22:44:02 Page 2
PSOERSE3 ;ALB/RM - PSO ERX SINGLE ERX DISPLAY INIT section continuation ;Jan 30, 2024@12:43:34
+1 ;;7.0;OUTPATIENT PHARMACY;**746,769,770**;DEC 16, 1997;Build 145
+2 ;
DISPRX ;continuation of PSOERSE2 routine
+1 NEW VADRGNME,ERXCOMM,VLOOP,SLOOP,VASIG,FSVPIN,COMARY,COM,FSSIG,VAPIARY,VASARY,DRMANVAL
+2 IF "RR,CA,CN,IE"'[MTYPE!(MTYPE="N")
Begin DoDot:1
+3 IF MTYPE="RE"
IF $$GET1^DIQ(52.49,PSOIEN,52.1,"I")'="R"
QUIT
+4 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+5 ;p689
SET PSNF=""
IF $GET(VADRGIEN)
SET PSNF=$SELECT($PIECE(^PSDRUG(VADRGIEN,0),"^",9):"***(N/F)***",1:"")
+6 SET LINE=LINE+1
+7 SET VADRGNME=VADRG_" "_$PIECE($$VADRSCH^PSOERXUT(VADRGIEN),"^",3)_PSNF
+8 SET DRMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.5,"I")
+9 DO SET^VALM10(LINE,"Vista Drug"_$SELECT($GET(DRMANVAL):"[v]",1:"")_": "_VADRGNME)
+10 DO CNTRL^VALM10(LINE,$SELECT($GET(DRMANVAL):15,1:13),$LENGTH(VADRGNME),IOINHI,IOINORM)
+11 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Qty: ",$GET(VAQTY),1,25)
+12 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Refills: ",$GET(VAREF),27,18)
+13 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Days Supply: ",$GET(VADAYS),54,22)
+14 SET LINE=LINE+1
DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
+15 DO CNTRL^VALM10(LINE,12,$LENGTH(VAQTY),IOINHI,IOINORM)
+16 DO CNTRL^VALM10(LINE,43,$LENGTH(VAREF),IOINHI,IOINORM)
+17 DO CNTRL^VALM10(LINE,74,$LENGTH(VADAYS),IOINHI,IOINORM)
+18 SET VASIG=""
+19 SET SLOOP=0
FOR
SET SLOOP=$ORDER(^PS(52.49,PSOIEN,"SIG",SLOOP))
if 'SLOOP
QUIT
Begin DoDot:2
+20 IF '$LENGTH($GET(VASIG))
SET VASIG=$GET(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
QUIT
+21 SET VASIG=$GET(VASIG)_" "_$GET(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
End DoDot:2
+22 DO TXT2ARY^PSOERXD1(.VASARY,VASIG,,68)
+23 SET FSSIG=$ORDER(VASARY(0))
+24 SET ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
+25 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
+26 SET LINE=LINE+1
DO SET^VALM10(LINE,"Substitutions?: "_ERXDSUB)
+27 IF ERXDSUB'=""
DO CNTRL^VALM10(LINE,17,$LENGTH(ERXDSUB),IOINHI,IOINORM)
+28 SET LINE=LINE+1
DO SET^VALM10(LINE,"Vista Sig: "_$SELECT(FSSIG:$GET(VASARY(FSSIG)),1:""))
+29 IF +FSSIG>0
DO CNTRL^VALM10(LINE,12,$LENGTH(VASARY(FSSIG)),IOINHI,IOINORM)
+30 SET SLOOP=1
FOR
SET SLOOP=$ORDER(VASARY(SLOOP))
if 'SLOOP
QUIT
Begin DoDot:2
+31 SET LINE=LINE+1
DO SET^VALM10(LINE," "_VASARY(SLOOP))
DO CNTRL^VALM10(LINE,12,$LENGTH(VASARY(SLOOP)),IOINHI,IOINORM)
End DoDot:2
+32 SET VPATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
+33 IF VPATINST]""
SET VPATINST=$$LSIG^PSOQUTIL(VPATINST)
+34 DO TXT2ARY^PSOERXD1(.VAPIARY,VPATINST," ",68)
+35 SET FSVPIN=$ORDER(VAPIARY(0))
+36 SET LINE=LINE+1
DO SET^VALM10(LINE," Pat Inst: "_$SELECT(FSVPIN:$GET(VAPIARY(FSVPIN)),1:""))
+37 IF +FSVPIN>0
DO CNTRL^VALM10(LINE,12,$LENGTH(VAPIARY(FSVPIN)),IOINHI,IOINORM)
+38 SET VLOOP=1
FOR
SET VLOOP=$ORDER(VAPIARY(VLOOP))
if 'VLOOP
QUIT
Begin DoDot:2
+39 SET LINE=LINE+1
DO SET^VALM10(LINE," "_VAPIARY(VLOOP))
DO CNTRL^VALM10(LINE,12,$LENGTH(VAPIARY(VLOOP)),IOINHI,IOINORM)
End DoDot:2
End DoDot:1
+40 SET ERXCOMM="eRx Notes: "_$$GET1^DIQ(52.49,PSOIEN,8,"E")
+41 DO TXT2ARY^PSOERXD1(.COMARY,ERXCOMM," ",68)
+42 SET COM=0
FOR
SET COM=$ORDER(COMARY(COM))
if 'COM
QUIT
Begin DoDot:1
+43 SET LINE=LINE+1
DO SET^VALM10(LINE,$GET(COMARY(COM)))
+44 IF COM=1
DO CNTRL^VALM10(LINE,12,$LENGTH($GET(COMARY(COM))),IOINHI,IOINORM)
QUIT
+45 DO CNTRL^VALM10(LINE,1,$LENGTH($GET(COMARY(COM))),IOINHI,IOINORM)
End DoDot:1
+46 IF $$GET1^DIQ(52.49,PSOIEN,.05,"I")
Begin DoDot:1
+47 DO ALG(.LINE)
End DoDot:1
+48 IF '$GET(S2017)
Begin DoDot:1
+49 DO DIAG^PSOERXU1(PSOIEN,.LINE)
End DoDot:1
+50 IF $GET(S2017)
Begin DoDot:1
+51 if MEDIEN
DO DIAG2017^PSOERXU5(PSOIEN,.LINE,,MEDIEN)
End DoDot:1
+52 IF $$GET1^DIQ(52.49,PSOIEN,95.1,"I")
Begin DoDot:1
+53 ; DEA Note for CS Digitally Signed eRx records
DO DEANOTE^PSOERSE1(.LINE)
End DoDot:1
+54 QUIT
+55 ;
ALG(LINE) ;
+1 NEW ALGINFO,ALGLINE,DFN,IEN,XX,LDAT,GMRAL,PSONOAL,II,LDATA
+2 SET ALGLINE=""
+3 SET DFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+4 DO EN1^GMRADPT
+5 SET IEN=1
+6 IF 'GMRAL
Begin DoDot:1
+7 SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)="Allergies: "_$SELECT(GMRAL=0:"NKA",1:"")
+8 IF GMRAL'=0
SET PSONOAL=""
DO ALLERGY^PSOORUT2
IF PSONOAL'=""
SET ^TMP("PSOPI",$JOB,IEN,0)="Allergies: "_PSONOAL
KILL PSONOAL
+9 SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)=" "
+10 DO REMOTE^PSOORUT2
+11 SET IEN=IEN+1
SET ^TMP("PSOPI",$JOB,IEN,0)="Adverse Reactions:"
End DoDot:1
+12 if $GET(GMRAL)
DO ^PSOORUT3
+13 SET XX=0
FOR
SET XX=$ORDER(^TMP("PSOPI",$JOB,XX))
if 'XX
QUIT
Begin DoDot:1
+14 SET LDAT=$GET(^TMP("PSOPI",$JOB,XX,0))
+15 IF $GET(LDAT)=" "
QUIT
+16 SET LINE=LINE+1
+17 DO SET^VALM10(LINE,LDAT)
+18 IF $GET(LDAT)["Allergies"!($GET(LDAT)["Adverse Reactions")
QUIT
+19 SET LDAT=$SELECT(LDAT[":":$PIECE(LDAT,":",2),1:LDAT)
+20 DO CNTRL^VALM10(LINE,15,$LENGTH(LDAT)+2,IOINHI,IOINORM)
End DoDot:1
+21 KILL ^TMP("PSOPI",$JOB)
+22 QUIT
+23 ;
DSPLYDUE(ERXIEN,LINE,DSPLYTO,TMPGBL) ;Display the Prescriber Drug Use Evaluation
+1 ;Inputs: (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
+2 ; (r) LINE - List Manager line
+3 ; (o) DSPLYTO - Vista=0 (default), CPRS=1
+4 ; (o) TMPGBL - The temporary global if the DUE is displayed in CPRS
+5 ;
+6 NEW PDRGDUE,PDUEHDR,DUECNT,COAGENT,REASON,RESULT,ACK,PDUETOTAL,DDOT
+7 IF '+$GET(DSPLYTO)
SET DSPLYTO=0
+8 ;1 means to display the DUE in alphabetical order
DO PDUEDATA^PSOERXU9(.PDRGDUE,ERXIEN,1)
+9 SET PDUEHDR="Prescriber Drug Use Evaluation: "_$SELECT('$DATA(PDRGDUE):"NONE",1:"")
+10 SET LINE=LINE+1
+11 IF '+$GET(DSPLYTO)
DO SET^VALM10(LINE,PDUEHDR)
DO CNTRL^VALM10(LINE,33,4,IOINHI,IOINORM)
+12 IF '$TEST
SET @TMPGBL@(LINE,0)=PDUEHDR
+13 ;
+14 IF $DATA(PDRGDUE)
Begin DoDot:1
+15 SET PDUETOTAL=$ORDER(PDRGDUE(""),-1)
+16 SET $PIECE(DDOT,".",81)=""
+17 SET DUECNT=0
FOR
SET DUECNT=$ORDER(PDRGDUE(DUECNT))
if 'DUECNT
QUIT
Begin DoDot:2
+18 KILL COAGENT,REASON,RESULT,ACK
+19 SET COAGENT="Co-Agent: "_$PIECE(PDRGDUE(DUECNT),"^",8)
+20 SET REASON=$PIECE(PDRGDUE(DUECNT),"^",2)
IF $$PRESOLV^PSOERXA1(REASON,"REA")
SET REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
+21 SET REASON="Reason: "_REASON
+22 SET RESULT=$PIECE(PDRGDUE(DUECNT),"^",4)
IF $$PRESOLV^PSOERXA1(RESULT,"RES")
SET RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
+23 SET RESULT="Result: "_RESULT
+24 SET ACK="Override: "_$PIECE(PDRGDUE(DUECNT),"^",9)
+25 ;
+26 ;display the DUE in Vista
IF '+$GET(DSPLYTO)
Begin DoDot:3
+27 SET LINE=LINE+1
DO SET^VALM10(LINE,COAGENT)
DO CNTRL^VALM10(LINE,11,$LENGTH(COAGENT)+1,IOINHI,IOINORM)
+28 SET LINE=LINE+1
DO SET^VALM10(LINE,REASON)
DO CNTRL^VALM10(LINE,9,$LENGTH(REASON)+1,IOINHI,IOINORM)
+29 SET LINE=LINE+1
DO SET^VALM10(LINE,RESULT)
DO CNTRL^VALM10(LINE,9,$LENGTH(RESULT)+1,IOINHI,IOINORM)
+30 SET LINE=LINE+1
DO SET^VALM10(LINE,ACK)
DO CNTRL^VALM10(LINE,11,$LENGTH(ACK)+1,IOINHI,IOINORM)
+31 IF DUECNT'=+$GET(PDUETOTAL)
SET LINE=LINE+1
DO SET^VALM10(LINE,DDOT)
End DoDot:3
QUIT
+32 ;
+33 ;display the DUE in CPRS Addendum
+34 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=COAGENT
+35 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=REASON
+36 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=RESULT
+37 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=ACK
+38 IF DUECNT'=+$GET(PDUETOTAL)
SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=DDOT
End DoDot:2
End DoDot:1
+39 IF +$GET(DSPLYTO)=1
SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+40 QUIT
+41 ;
ACCEPT ; Validate All Matches (Patient/Provider/Drug) & Accept eRx
+1 NEW PASSTRHU,ERXSTS,DIR
DO FULL^VALM1
SET VALMBCK="R"
+2 SET PASSTRHU=0
IF $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE"
IF $$GET1^DIQ(52.49,ERXIEN,52.1,"I")'="R"
SET PASSTRHU=1
+3 SET ERXSTS=$$GET1^DIQ(52.49,ERXIEN,1)
+4 IF ERXSTS="RJ"!(ERXSTS="RM")!($EXTRACT(ERXSTS,1,3)="REM")!(ERXSTS="PR")!(ERXSTS="CXP")!(ERXSTS="RXP")
Begin DoDot:1
+5 WRITE !!,"Cannot accept a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
+6 KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+7 ; MbM site won't validate the patient
+8 IF 'PASSTRHU
Begin DoDot:1
+9 IF 'PASSTRHU
IF '$$GET1^DIQ(52.49,ERXIEN,1.7,"I")
Begin DoDot:2
+10 IF '$GET(MBMSITE)
WRITE !!,"Validating Patient..."
DO ACVAL^PSOERX1B(ERXIEN,"P",1)
+11 IF $GET(MBMSITE)
WRITE !!,"Patient has not been validated!",!,$CHAR(7)
KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:2
+12 IF '$$GET1^DIQ(52.49,ERXIEN,1.3,"I")
Begin DoDot:2
+13 WRITE !!,"Validating Provider..."
DO ACVAL^PSOERX1B(ERXIEN,"PR",1)
End DoDot:2
+14 IF '$$GET1^DIQ(52.49,ERXIEN,1.5,"I")
Begin DoDot:2
+15 WRITE !!,"Validating Drug/SIG..."
DO ACVAL^PSOERX1B(ERXIEN,"D",1)
End DoDot:2
End DoDot:1
+16 ;
+17 IF PASSTRHU!($$GET1^DIQ(52.49,ERXIEN,1.7,"I")&$$GET1^DIQ(52.49,ERXIEN,1.3,"I")&$$GET1^DIQ(52.49,ERXIEN,1.5,"I"))
Begin DoDot:1
+18 NEW DIR,PSOIEN
+19 ;Accepting the eRx
+20 SET PSOIEN=ERXIEN
DO SETUP^PSOERX1F
End DoDot:1
+21 IF '$TEST
if $GET(MBMSITE)
DO REF^PSOERSE1
QUIT
+22 SET VALMBCK="Q"
IF $GET(MBMSITE)
DO REF^PSOERSE1
+23 QUIT
+24 ;
NEXTDRUG ; Automatically Selects the Next Drug
+1 NEW NEXTERX,FROMLIST
+2 ;
+3 IF '$GET(EPATIEN)
SET EPATIEN=$$GET1^DIQ(52.49,+$GET(PSOIEN),.04,"I")
IF 'EPATIEN
QUIT
+4 SET FROMLIST='$GET(PSOIEN)
SET VALMBCK="Q"
+5 ; - Locking the eRx Patient
+6 SET NEXTERX=$$NEXTERX^PSOERSE3(EPATIEN,+$GET(PSOIEN))
+7 IF 'NEXTERX
SET NEXTERX=$$NEXTERX^PSOERSE3(EPATIEN,0)
IF 'NEXTERX
QUIT
+8 SET (ERXIEN,PSOIEN)=NEXTERX
+9 IF $GET(PRINTFLG)'="VD"
DO EN^PSOERXD1
+10 IF '$TEST
DO INIT^PSOERXD1
DO HDR^PSOERXD1
SET VALMBCK="R"
QUIT
+11 IF FROMLIST
DO EN^PSOERSE1(PSOIEN)
+12 IF '$TEST
DO INIT^PSOERSE1
DO HDR^PSOERSE1
+13 IF FROMLIST
KILL PSOIEN
+14 QUIT
+15 ;
NEXTERX(ERXPAT,ERXIEN) ; Returns the next Actionable eRx for the Patient
+1 ; Input:(r) ERXPAT - Pointer to the ERX EXTERNAL PATIENT file (#52.46)
+2 ; (r) ERXIEN - Current eRx - Pointer to the ERX HOLDING QUEUE file (#52.49)
+3 ;Output: NEXTERX - Next eRx for the eRx Patient
+4 NEW NEXTERX,ERX,BEGDATE,ENDDATE,MSGDT,STATUS
+5 SET (NEXTERX,ERX)=0
SET BEGDATE=$$FMADD^XLFDT(DT,-PSOLKBKD)-.1
SET ENDDATE=DT+.99
SET MSGDT=BEGDATE
+6 FOR
SET MSGDT=$ORDER(^PS(52.49,"PAT2",ERXPAT,MSGDT))
if 'MSGDT!(MSGDT>ENDDATE)
QUIT
Begin DoDot:1
+7 FOR
SET ERX=$ORDER(^PS(52.49,"PAT2",ERXPAT,MSGDT,ERX))
if 'ERX
QUIT
Begin DoDot:2
+8 IF ERX'>ERXIEN
QUIT
+9 SET STATUS=$$GET1^DIQ(52.49,ERX,1)
+10 IF $FIND(",RJ,RM,REM,PR,E,RXA,CXA,CAA,CAN,CXP,RXP,RXA,ICA,CNP,CRP,CRC,RRC,CXC,CNE,CRN,CRR,CRX,CXQ,RXA,RXC,RRN,RRX,RRR,RRP,IRA,",","_$EXTRACT(STATUS,1,3)_",")
QUIT
+11 SET NEXTERX=ERX
End DoDot:2
IF NEXTERX
QUIT
End DoDot:1
IF NEXTERX
QUIT
+12 QUIT NEXTERX
+13 ;
EDITDRUG ; Edit Drug fields from Single eRx View/Display
+1 NEW Y,CURPAGE,XQORM
+2 SET VALMBCK="R"
SET CURPAGE=VALMBG
+3 SET Y=$PIECE(XQORNOD(0),"=",2)
IF Y']""
QUIT
+4 ;
+5 IF +Y'=1
IF '$$GET1^DIQ(52.49,PSOIEN,3.2,"I")!'$DATA(^PS(52.49,PSOIEN,21))
Begin DoDot:1
+6 SET VALMSG="You must update the Dispense Drug first!"
WRITE $CHAR(7)
End DoDot:1
SET VALMBCK="R"
QUIT
+7 ;
+8 DO EDIT^PSOERX1A("D",Y)
+9 DO REF^PSOERSE1
SET VALMBG=+$GET(CURPAGE)
+10 QUIT
+11 ;
MISSINGPI(ERXIEN) ; Returns whether it is likely the eRx should have Patient Instructions entered or not
+1 ; Input: (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
+2 ;Output: MISSINGPI - 0: Pat.Instr. not likely missing | 1: Pat.Instr. is likely missing
+3 ;
+4 NEW SUGRXIEN,MSGTYPE
+5 IF '$DATA(^PS(52.49,+$GET(ERXIEN),0))
QUIT 0
+6 ; Not auto-matched
IF $$GET1^DIQ(52.49,ERXIEN,1.4,"I")'=1
QUIT 0
+7 IF '$FIND(",N,RE,",","_$EXTRACT($$GET1^DIQ(52.49,ERXIEN,.08,"I"))_",")
QUIT 0
+8 IF '$FIND(",I,N,W,H,",","_$EXTRACT($$GET1^DIQ(52.49,ERXIEN,1,"E"))_",")
QUIT 0
+9 IF $$GET1^DIQ(52.49,ERXIEN,27)'=""
QUIT 0
+10 SET SUGRXIEN=$$GET1^DIQ(52.49,ERXIEN,.15,"I")
IF 'SUGRXIEN
QUIT 0
+11 IF $$VARXPI^PSOERUT(SUGRXIEN)=""
QUIT 0
+12 QUIT 1
