PSOERXU7 ;ALB/BLB - eRx Utilities/RPC's ; 11/27/2019 11:02am
;;7.0;OUTPATIENT PHARMACY;**581,617,700**;DEC 1997;Build 261
;
Q
MEDDIS(ERXIEN,LINE) ;
N DRUG,DIEN,QTY,DAYS,WDATE,EFDATE,REFILL,EXDATE,LFDATE,DIRECT,CLQ,USC,PUC,F,IENS,I,LTXT
N RXIEN,RXNUM,INS,DDAT,PARIEN,OREFILL,DLOOP,DIARY,MIEN,MTYPE,DATAIEN,QUOM
S F=52.49311
S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"****************************MEDICATION DISPENSED****************************")
S PARIEN=$$RESOLV^PSOERXU2(ERXIEN)
I PARIEN S RXIEN=$$GET1^DIQ(52.49,PARIEN,.13,"I")
I $G(RXIEN) S OREFILL=$$GET1^DIQ(52,RXIEN,9,"E")
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
I MTYPE="RE" S DATAIEN=$$GETREQ^PSOERXU2(ERXIEN)
I MTYPE="RR" S DATAIEN=ERXIEN
S MIEN=0 F S MIEN=$O(^PS(52.49,DATAIEN,311,"C","D",MIEN)) Q:'MIEN D
.S IENS=MIEN_","_DATAIEN_","
.D GETS^DIQ(F,IENS,".03;2.1;2.3;2.4;2.5;2.8","IE","DDAT")
.S DRUG=$G(DDAT(F,IENS,.03,"E"))
.S:DRUG'="" DIEN=$O(^PSDRUG("B",DRUG,0))
.S QTY=$G(DDAT(F,IENS,2.1,"E"))
.S DAYS=$G(DDAT(F,IENS,2.4,"E"))
.S REFILL=$G(DDAT(F,IENS,2.8,"E"))
.S WDATE=$G(DDAT(F,IENS,2.5,"E"))
.S I=$G(DDAT(F,IENS,2.3,"I"))
.S QUOM=$$CODEDESC(I)
.; if there is an RX ien, reset the refills to that value - may need to adjust other fields as well
.I $G(RXIEN) S REFILL=$$GET1^DIQ(52,RXIEN,9,"E")
.S LINE=LINE+1 D SET^VALM10(LINE,"Vista Drug: "_DRUG_" "_$P($$VADRSCH^PSOERXUT(+$G(DIEN)),"^",3))
.S LINE=LINE+1
.D ADDITEM^PSOERX1A(.LTXT,"Vista Qty: ",$G(QTY),1,25)
.D ADDITEM^PSOERX1A(.LTXT,"Vista Refills: ",$G(REFILL),27,18)
.D ADDITEM^PSOERX1A(.LTXT,"Vista Days Supply: ",$G(DAYS),54,22)
.D SET^VALM10(LINE,LTXT) S LTXT=""
.S LINE=LINE+1 D SET^VALM10(LINE,"Quantity Unit Of Measure: "_QUOM)
I $G(RXIEN) D
.S LINE=LINE+1
.D SET^VALM10(LINE,"Vista Sig: ")
.S RXNUM=$$GET1^DIQ(52,RXIEN,.01,"E")
.S INS=0 F S INS=$O(^PSRX(RXIEN,"SIG1",INS)) Q:'INS D
..S LINE=LINE+1 D SET^VALM10(LINE,$G(^PSRX(RXIEN,"SIG1",INS,0)))
I '$L($G(RXNUM)) S RXNUM="Unable to resolve."
S LINE=LINE+1 D SET^VALM10(LINE,"VA Rx#: "_$G(RXNUM))
Q
; CODE - code value such as C12345 (.01 value in file 52.45)
; TYPE - The type of code you are looking for such as "NCI", "CLQ", "RES", etc.
CODERES(CODE,TYPE) ;
Q:TYPE=""!(CODE="") ""
N IEN
S IEN=$O(^PS(52.45,"C",TYPE,CODE,0))
Q $$CODEDESC(IEN)
; IEN - ien of the code in file 52.45
CODEDESC(IEN) ;
Q $$GET1^DIQ(52.45,IEN,.02,"E")
GETPTPH(PATIEN,S2017,CODES) ; Get Patient primary telephone
N CIEN,CODE,EXT,FILE,IENS,PATEL,SUB,TYPE
I S2017 D
.S CODE=$P(CODES,",")
.S PATEL=$$COMMVAL^PSOERXU5(PATIEN,52.46,13,CODE)
I 'S2017 D
.S SUB=3,CODE=$P(CODES,",",2),FILE=52.462
.S PATEL=""
.S CIEN=$O(^PS(52.46,PATIEN,SUB,"C",CODE,0))
.I CIEN D
..S IENS=CIEN_","_PATIEN_","
..S PATEL=$$GET1^DIQ(FILE,IENS,.01,"I")
.I 'CIEN D
..S CIEN=0
..F S CIEN=$O(^PS(52.46,PATIEN,SUB,CIEN)) Q:CIEN'?1.N D Q:PATEL]""
...S IENS=CIEN_","_PATIEN_","
...S PATEL=$$GET1^DIQ(FILE,IENS,.01,"I")
...S TYPE=$$GET1^DIQ(FILE,IENS,.02,"I")
...S:TYPE="EM" PATEL=""
.I PATEL]"" D
..S EXT=$$GET1^DIQ(FILE,IENS,.03,"I")
..S:EXT]"" PATEL=PATEL_"X"_EXT
;/JSG/ PSO*7.0*581 - END CHANGE
Q PATEL
RXEPRMT(ERXIEN) ;
N DIR,Y,RES,ERXSTAT,MTYPE,NSTAT
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
S RES=""
S DIR(0)="YO"
W !,"There was a processing error."
W !,"Please validate that the eRx was discontinued in Outpatient Pharmacy and/or"
W !,"canceled in the Holding Queue."
S DIR("A")="Would you like to continue to process the record?"
S DIR("B")="YES"
D ^DIR
; if they wish to continue, update the status to RXI
S NSTAT=$S(MTYPE="RE":"RXI",1:"CXI")
I Y S RES=Y D UPDSTAT^PSOERXU1(ERXIEN,NSTAT)
Q RES
OPACCESS(OPTION,DUZ,ERXIEN) ;
N MTYPE,EVAL,RESVAL,MSTAT,DELTA,RET,RESIEN,REQIEN,RESCHECK,MESREQ,MBMALLOW
S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
S MSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
S RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
I MSTAT="CXE",($G(OPTION)'["PSO ERX VALIDATE") Q 0
S MESREQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"E")
I MTYPE="CX"!(MTYPE="CR"),$E(RESVAL)'="V",($E(RESVAL)'="A"!(",G,T,S,OS,D,"'[MESREQ)) Q 0
I MSTAT="CXP"!(MSTAT="CXQ")!(MSTAT="CXC") Q 0
I MSTAT="CRE" Q 0
I MSTAT="RRE"!(MSTAT="RRN") Q 0
I MTYPE="RE",((RESVAL="D")!(RESVAL="DNP"))!(RESVAL="A") Q 0
I MTYPE="RE",(MSTAT="RXP")!(MSTAT="RXC")!(MSTAT="RRC") Q 0
I MTYPE="RE",$G(OPTION)["HOLD",MSTAT="RXE" Q 0
I MTYPE="RR",(MSTAT="RRC")!(MSTAT="RRR") Q 0
I (MTYPE="RE")!(MTYPE="RR"),(MSTAT="CAN")!(MSTAT="RXD")!(MSTAT="RRP") Q 0
I MTYPE="CA"!(MTYPE="CN")!(MTYPE="IE") Q 0
I MTYPE="N",$$GET1^DIQ(52.49,PSOIEN,1,"E")="CAN" Q 0
; MbM Only - Change to allow users to validate Patient, Provider and Drug for records on Hold, as well as Accept Validation
S MBMALLOW=0
I $$GET1^DIQ(59.7,1,102,"I")="MBM",$E(MSTAT)="H",'$D(^XUSEC("PSO ERX VIEW",DUZ)) D I $G(MBMALLOW) Q 1
. I OPTION="PSO ERX VALIDATE PATIENT" S MBMALLOW=1
. I OPTION="PSO ERX VALIDATE PROVIDER" S MBMALLOW=1
. I OPTION="PSO ERX VALIDATE DRUG" S MBMALLOW=1
. I OPTION="PSO ERX ACCEPT VALIDATION" S MBMALLOW=1
I $E(MSTAT)="H",OPTION'["UNHOLD",OPTION'["PRINT",OPTION'["HISTORY",OPTION'["REMOVE" Q 0
I OPTION="PSO ERX ACCEPT ERX",(RESVAL="AWC"!(RESVAL="R")),MTYPE="RE",(MSTAT="RXN"!(MSTAT="RXW")) D Q RET
.S RET=0 I ('$D(^XUSEC("PSDRPH",DUZ))),('$D(^XUSEC("PSO ERX ADV TECH",DUZ))) Q
.I MSTAT="RXW" S RET=1 Q
.S RESIEN=PSOIEN,REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
.D RRDELTA^PSOERXU2(.DELTA,REQIEN,RESIEN)
.I $D(DELTA(52.49,"EXTERNAL PROVIDER")) S RET=1
; block all but accept erx on eRx's in RXW status
I OPTION'="PSO ERX ACCEPT ERX",MSTAT="RXW",RESVAL'="R" Q 0
;
I OPTION="PSO ERX UNHOLD",($D(^XUSEC("PSO ERX VIEW",DUZ))) Q 0
I OPTION="PSO ERX REJECT"!(OPTION="PSO ERX REMOVE"),MSTAT="RXE" Q 0
I OPTION="PSO ERX REJECT"!(OPTION="PSO ERX REMOVE")!(OPTION="PSO ERX HOLD")!(OPTION="PSO ERX UNHOLD"),MSTAT="RXN" Q 0
I OPTION="PSO ERX ACCEPT ERX",('$D(^XUSEC("PSDRPH",DUZ))),('$D(^XUSEC("PSO ERX ADV TECH",DUZ))) Q 0
I OPTION="PSO ERX ACCEPT VALIDATION",$D(^XUSEC("PSO ERX VIEW",DUZ)) Q 0
I OPTION="PSO ERX REJECT",($D(^XUSEC("PSO ERX VIEW",DUZ))) Q 0
I OPTION="PSO ERX REMOVE",($D(^XUSEC("PSO ERX VIEW",DUZ))) Q 0
I OPTION="PSO ERX VALIDATE PATIENT",$D(^XUSEC("PSO ERX VIEW",DUZ)) Q 0
I OPTION="PSO ERX VALIDATE PROVIDER",$D(^XUSEC("PSO ERX VIEW",DUZ)) Q 0
I OPTION="PSO ERX VALIDATE DRUG",$D(^XUSEC("PSO ERX VIEW",DUZ)) Q 0
I OPTION="PSO ERX HOLD",$D(^XUSEC("PSO ERX VIEW",DUZ)) Q 0
Q 1
ERRDISP(ERXIEN,LINE) ;
N ECODE,ETEXT,EDECODE,EDICODE,I,ERRDTTM
S ECODE=$$GET1^DIQ(52.49,ERXIEN,60.1,"E")
S ETEXT=$$GET1^DIQ(52.49,ERXIEN,60,"E")
S ERRDTTM=$$GET1^DIQ(52.49,ERXIEN,.03,"E")
S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"*****************************ERROR DETAILS********************************")
S LINE=LINE+1 D SET^VALM10(LINE,"Error Date/Time: "_ERRDTTM)
S LINE=LINE+1 D SET^VALM10(LINE,"Code: "_ECODE)
S LINE=LINE+1 D SET^VALM10(LINE,"Details: "_ETEXT)
I $D(^PS(52.49,ERXIEN,61)) D
.S LINE=LINE+1 D SET^VALM10(LINE,"")
.S LINE=LINE+1 D SET^VALM10(LINE,"Description Codes")
.S LINE=LINE+1 D SET^VALM10(LINE,"=================")
.S LINE=LINE+1 D SET^VALM10(LINE,"")
S I=0 F S I=$O(^PS(52.49,ERXIEN,61,I)) Q:'I D
.S EDECODE=$$GET1^DIQ(52.4961,I_","_ERXIEN_",",.01,"E")
.S EDICODE=$$GET1^DIQ(52.4961,I_","_ERXIEN_",",.01,"I")
.S LINE=LINE+1 D SET^VALM10(LINE,EDICODE_" - "_EDECODE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXU7 7501 printed Apr 09, 2024@21:36:41 Page 2
PSOERXU7 ;ALB/BLB - eRx Utilities/RPC's ; 11/27/2019 11:02am
+1 ;;7.0;OUTPATIENT PHARMACY;**581,617,700**;DEC 1997;Build 261
+2 ;
+3 QUIT
MEDDIS(ERXIEN,LINE) ;
+1 NEW DRUG,DIEN,QTY,DAYS,WDATE,EFDATE,REFILL,EXDATE,LFDATE,DIRECT,CLQ,USC,PUC,F,IENS,I,LTXT
+2 NEW RXIEN,RXNUM,INS,DDAT,PARIEN,OREFILL,DLOOP,DIARY,MIEN,MTYPE,DATAIEN,QUOM
+3 SET F=52.49311
+4 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+5 SET LINE=LINE+1
DO SET^VALM10(LINE,"****************************MEDICATION DISPENSED****************************")
+6 SET PARIEN=$$RESOLV^PSOERXU2(ERXIEN)
+7 IF PARIEN
SET RXIEN=$$GET1^DIQ(52.49,PARIEN,.13,"I")
+8 IF $GET(RXIEN)
SET OREFILL=$$GET1^DIQ(52,RXIEN,9,"E")
+9 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+10 IF MTYPE="RE"
SET DATAIEN=$$GETREQ^PSOERXU2(ERXIEN)
+11 IF MTYPE="RR"
SET DATAIEN=ERXIEN
+12 SET MIEN=0
FOR
SET MIEN=$ORDER(^PS(52.49,DATAIEN,311,"C","D",MIEN))
if 'MIEN
QUIT
Begin DoDot:1
+13 SET IENS=MIEN_","_DATAIEN_","
+14 DO GETS^DIQ(F,IENS,".03;2.1;2.3;2.4;2.5;2.8","IE","DDAT")
+15 SET DRUG=$GET(DDAT(F,IENS,.03,"E"))
+16 if DRUG'=""
SET DIEN=$ORDER(^PSDRUG("B",DRUG,0))
+17 SET QTY=$GET(DDAT(F,IENS,2.1,"E"))
+18 SET DAYS=$GET(DDAT(F,IENS,2.4,"E"))
+19 SET REFILL=$GET(DDAT(F,IENS,2.8,"E"))
+20 SET WDATE=$GET(DDAT(F,IENS,2.5,"E"))
+21 SET I=$GET(DDAT(F,IENS,2.3,"I"))
+22 SET QUOM=$$CODEDESC(I)
+23 ; if there is an RX ien, reset the refills to that value - may need to adjust other fields as well
+24 IF $GET(RXIEN)
SET REFILL=$$GET1^DIQ(52,RXIEN,9,"E")
+25 SET LINE=LINE+1
DO SET^VALM10(LINE,"Vista Drug: "_DRUG_" "_$PIECE($$VADRSCH^PSOERXUT(+$GET(DIEN)),"^",3))
+26 SET LINE=LINE+1
+27 DO ADDITEM^PSOERX1A(.LTXT,"Vista Qty: ",$GET(QTY),1,25)
+28 DO ADDITEM^PSOERX1A(.LTXT,"Vista Refills: ",$GET(REFILL),27,18)
+29 DO ADDITEM^PSOERX1A(.LTXT,"Vista Days Supply: ",$GET(DAYS),54,22)
+30 DO SET^VALM10(LINE,LTXT)
SET LTXT=""
+31 SET LINE=LINE+1
DO SET^VALM10(LINE,"Quantity Unit Of Measure: "_QUOM)
End DoDot:1
+32 IF $GET(RXIEN)
Begin DoDot:1
+33 SET LINE=LINE+1
+34 DO SET^VALM10(LINE,"Vista Sig: ")
+35 SET RXNUM=$$GET1^DIQ(52,RXIEN,.01,"E")
+36 SET INS=0
FOR
SET INS=$ORDER(^PSRX(RXIEN,"SIG1",INS))
if 'INS
QUIT
Begin DoDot:2
+37 SET LINE=LINE+1
DO SET^VALM10(LINE,$GET(^PSRX(RXIEN,"SIG1",INS,0)))
End DoDot:2
End DoDot:1
+38 IF '$LENGTH($GET(RXNUM))
SET RXNUM="Unable to resolve."
+39 SET LINE=LINE+1
DO SET^VALM10(LINE,"VA Rx#: "_$GET(RXNUM))
+40 QUIT
+41 ; CODE - code value such as C12345 (.01 value in file 52.45)
+42 ; TYPE - The type of code you are looking for such as "NCI", "CLQ", "RES", etc.
CODERES(CODE,TYPE) ;
+1 if TYPE=""!(CODE="")
QUIT ""
+2 NEW IEN
+3 SET IEN=$ORDER(^PS(52.45,"C",TYPE,CODE,0))
+4 QUIT $$CODEDESC(IEN)
+5 ; IEN - ien of the code in file 52.45
CODEDESC(IEN) ;
+1 QUIT $$GET1^DIQ(52.45,IEN,.02,"E")
GETPTPH(PATIEN,S2017,CODES) ; Get Patient primary telephone
+1 NEW CIEN,CODE,EXT,FILE,IENS,PATEL,SUB,TYPE
+2 IF S2017
Begin DoDot:1
+3 SET CODE=$PIECE(CODES,",")
+4 SET PATEL=$$COMMVAL^PSOERXU5(PATIEN,52.46,13,CODE)
End DoDot:1
+5 IF 'S2017
Begin DoDot:1
+6 SET SUB=3
SET CODE=$PIECE(CODES,",",2)
SET FILE=52.462
+7 SET PATEL=""
+8 SET CIEN=$ORDER(^PS(52.46,PATIEN,SUB,"C",CODE,0))
+9 IF CIEN
Begin DoDot:2
+10 SET IENS=CIEN_","_PATIEN_","
+11 SET PATEL=$$GET1^DIQ(FILE,IENS,.01,"I")
End DoDot:2
+12 IF 'CIEN
Begin DoDot:2
+13 SET CIEN=0
+14 FOR
SET CIEN=$ORDER(^PS(52.46,PATIEN,SUB,CIEN))
if CIEN'?1.N
QUIT
Begin DoDot:3
+15 SET IENS=CIEN_","_PATIEN_","
+16 SET PATEL=$$GET1^DIQ(FILE,IENS,.01,"I")
+17 SET TYPE=$$GET1^DIQ(FILE,IENS,.02,"I")
+18 if TYPE="EM"
SET PATEL=""
End DoDot:3
if PATEL]""
QUIT
End DoDot:2
+19 IF PATEL]""
Begin DoDot:2
+20 SET EXT=$$GET1^DIQ(FILE,IENS,.03,"I")
+21 if EXT]""
SET PATEL=PATEL_"X"_EXT
End DoDot:2
End DoDot:1
+22 ;/JSG/ PSO*7.0*581 - END CHANGE
+23 QUIT PATEL
RXEPRMT(ERXIEN) ;
+1 NEW DIR,Y,RES,ERXSTAT,MTYPE,NSTAT
+2 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+3 SET RES=""
+4 SET DIR(0)="YO"
+5 WRITE !,"There was a processing error."
+6 WRITE !,"Please validate that the eRx was discontinued in Outpatient Pharmacy and/or"
+7 WRITE !,"canceled in the Holding Queue."
+8 SET DIR("A")="Would you like to continue to process the record?"
+9 SET DIR("B")="YES"
+10 DO ^DIR
+11 ; if they wish to continue, update the status to RXI
+12 SET NSTAT=$SELECT(MTYPE="RE":"RXI",1:"CXI")
+13 IF Y
SET RES=Y
DO UPDSTAT^PSOERXU1(ERXIEN,NSTAT)
+14 QUIT RES
OPACCESS(OPTION,DUZ,ERXIEN) ;
+1 NEW MTYPE,EVAL,RESVAL,MSTAT,DELTA,RET,RESIEN,REQIEN,RESCHECK,MESREQ,MBMALLOW
+2 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+3 SET MSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+4 SET RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
+5 IF MSTAT="CXE"
IF ($GET(OPTION)'["PSO ERX VALIDATE")
QUIT 0
+6 SET MESREQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"E")
+7 IF MTYPE="CX"!(MTYPE="CR")
IF $EXTRACT(RESVAL)'="V"
IF ($EXTRACT(RESVAL)'="A"!(",G,T,S,OS,D,"'[MESREQ))
QUIT 0
+8 IF MSTAT="CXP"!(MSTAT="CXQ")!(MSTAT="CXC")
QUIT 0
+9 IF MSTAT="CRE"
QUIT 0
+10 IF MSTAT="RRE"!(MSTAT="RRN")
QUIT 0
+11 IF MTYPE="RE"
IF ((RESVAL="D")!(RESVAL="DNP"))!(RESVAL="A")
QUIT 0
+12 IF MTYPE="RE"
IF (MSTAT="RXP")!(MSTAT="RXC")!(MSTAT="RRC")
QUIT 0
+13 IF MTYPE="RE"
IF $GET(OPTION)["HOLD"
IF MSTAT="RXE"
QUIT 0
+14 IF MTYPE="RR"
IF (MSTAT="RRC")!(MSTAT="RRR")
QUIT 0
+15 IF (MTYPE="RE")!(MTYPE="RR")
IF (MSTAT="CAN")!(MSTAT="RXD")!(MSTAT="RRP")
QUIT 0
+16 IF MTYPE="CA"!(MTYPE="CN")!(MTYPE="IE")
QUIT 0
+17 IF MTYPE="N"
IF $$GET1^DIQ(52.49,PSOIEN,1,"E")="CAN"
QUIT 0
+18 ; MbM Only - Change to allow users to validate Patient, Provider and Drug for records on Hold, as well as Accept Validation
+19 SET MBMALLOW=0
+20 IF $$GET1^DIQ(59.7,1,102,"I")="MBM"
IF $EXTRACT(MSTAT)="H"
IF '$DATA(^XUSEC("PSO ERX VIEW",DUZ))
Begin DoDot:1
+21 IF OPTION="PSO ERX VALIDATE PATIENT"
SET MBMALLOW=1
+22 IF OPTION="PSO ERX VALIDATE PROVIDER"
SET MBMALLOW=1
+23 IF OPTION="PSO ERX VALIDATE DRUG"
SET MBMALLOW=1
+24 IF OPTION="PSO ERX ACCEPT VALIDATION"
SET MBMALLOW=1
End DoDot:1
IF $GET(MBMALLOW)
QUIT 1
+25 IF $EXTRACT(MSTAT)="H"
IF OPTION'["UNHOLD"
IF OPTION'["PRINT"
IF OPTION'["HISTORY"
IF OPTION'["REMOVE"
QUIT 0
+26 IF OPTION="PSO ERX ACCEPT ERX"
IF (RESVAL="AWC"!(RESVAL="R"))
IF MTYPE="RE"
IF (MSTAT="RXN"!(MSTAT="RXW"))
Begin DoDot:1
+27 SET RET=0
IF ('$DATA(^XUSEC("PSDRPH",DUZ)))
IF ('$DATA(^XUSEC("PSO ERX ADV TECH",DUZ)))
QUIT
+28 IF MSTAT="RXW"
SET RET=1
QUIT
+29 SET RESIEN=PSOIEN
SET REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
+30 DO RRDELTA^PSOERXU2(.DELTA,REQIEN,RESIEN)
+31 IF $DATA(DELTA(52.49,"EXTERNAL PROVIDER"))
SET RET=1
End DoDot:1
QUIT RET
+32 ; block all but accept erx on eRx's in RXW status
+33 IF OPTION'="PSO ERX ACCEPT ERX"
IF MSTAT="RXW"
IF RESVAL'="R"
QUIT 0
+34 ;
+35 IF OPTION="PSO ERX UNHOLD"
IF ($DATA(^XUSEC("PSO ERX VIEW",DUZ)))
QUIT 0
+36 IF OPTION="PSO ERX REJECT"!(OPTION="PSO ERX REMOVE")
IF MSTAT="RXE"
QUIT 0
+37 IF OPTION="PSO ERX REJECT"!(OPTION="PSO ERX REMOVE")!(OPTION="PSO ERX HOLD")!(OPTION="PSO ERX UNHOLD")
IF MSTAT="RXN"
QUIT 0
+38 IF OPTION="PSO ERX ACCEPT ERX"
IF ('$DATA(^XUSEC("PSDRPH",DUZ)))
IF ('$DATA(^XUSEC("PSO ERX ADV TECH",DUZ)))
QUIT 0
+39 IF OPTION="PSO ERX ACCEPT VALIDATION"
IF $DATA(^XUSEC("PSO ERX VIEW",DUZ))
QUIT 0
+40 IF OPTION="PSO ERX REJECT"
IF ($DATA(^XUSEC("PSO ERX VIEW",DUZ)))
QUIT 0
+41 IF OPTION="PSO ERX REMOVE"
IF ($DATA(^XUSEC("PSO ERX VIEW",DUZ)))
QUIT 0
+42 IF OPTION="PSO ERX VALIDATE PATIENT"
IF $DATA(^XUSEC("PSO ERX VIEW",DUZ))
QUIT 0
+43 IF OPTION="PSO ERX VALIDATE PROVIDER"
IF $DATA(^XUSEC("PSO ERX VIEW",DUZ))
QUIT 0
+44 IF OPTION="PSO ERX VALIDATE DRUG"
IF $DATA(^XUSEC("PSO ERX VIEW",DUZ))
QUIT 0
+45 IF OPTION="PSO ERX HOLD"
IF $DATA(^XUSEC("PSO ERX VIEW",DUZ))
QUIT 0
+46 QUIT 1
ERRDISP(ERXIEN,LINE) ;
+1 NEW ECODE,ETEXT,EDECODE,EDICODE,I,ERRDTTM
+2 SET ECODE=$$GET1^DIQ(52.49,ERXIEN,60.1,"E")
+3 SET ETEXT=$$GET1^DIQ(52.49,ERXIEN,60,"E")
+4 SET ERRDTTM=$$GET1^DIQ(52.49,ERXIEN,.03,"E")
+5 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+6 SET LINE=LINE+1
DO SET^VALM10(LINE,"*****************************ERROR DETAILS********************************")
+7 SET LINE=LINE+1
DO SET^VALM10(LINE,"Error Date/Time: "_ERRDTTM)
+8 SET LINE=LINE+1
DO SET^VALM10(LINE,"Code: "_ECODE)
+9 SET LINE=LINE+1
DO SET^VALM10(LINE,"Details: "_ETEXT)
+10 IF $DATA(^PS(52.49,ERXIEN,61))
Begin DoDot:1
+11 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+12 SET LINE=LINE+1
DO SET^VALM10(LINE,"Description Codes")
+13 SET LINE=LINE+1
DO SET^VALM10(LINE,"=================")
+14 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
End DoDot:1
+15 SET I=0
FOR
SET I=$ORDER(^PS(52.49,ERXIEN,61,I))
if 'I
QUIT
Begin DoDot:1
+16 SET EDECODE=$$GET1^DIQ(52.4961,I_","_ERXIEN_",",.01,"E")
+17 SET EDICODE=$$GET1^DIQ(52.4961,I_","_ERXIEN_",",.01,"I")
+18 SET LINE=LINE+1
DO SET^VALM10(LINE,EDICODE_" - "_EDECODE)
End DoDot:1
+19 QUIT
