PSOERX1G ;ALB/MFR - eRx Holding Queue Rx View INIT section ;Aug 14, 2020@12:43:34
;;7.0;OUTPATIENT PHARMACY;**617,646,689,700,743**;DEC 1997;Build 24
;
INIT ;
N PATIEN,PHARMIEN,PRVIEN,PHDAT,PATDAT,SUPDAT,PRVDAT,LINE,PRVLNM,PRVMI,PRVFN,EPAT,EPATDOB,VPATIEN,HARY,HL,PROHIBIT,ERXWRDT
N VPATNM,VPATDOB,EPRVIEN,EPRVNM,EPRVNPI,EPRVDEA,VAPRVIEN,VAPRVNM,VAPRVNPI,VAPRVDEA,SUPIEN,ERXDRUG,ERXQTY,ERXFLS,CSCOMM,MEDIEN
N ERXDS,ERXDT,VADRGIEN,VADRG,LINETXT,ERXCOMM,ERXRFLS,PATIENS,VAHREA,VAQTY,VAREF,VASIG,PATDAT,CURSTATE,CURSTATI,WDATE,RRNRXIEN
N LHFOUND,LHMATCH,LHSTATI,VAPDEAEX,ERXCOMM,COMFRST,COMARY,SIGDATA,SIGLOOP,SFIRSPROT,SGLOOP,SIGARY,VADAYS,NRXIEN
N SLOOP,VASIG,VASARY,FSSIG,VAHSTA,EDIRECT,VAHPER,PAMANVAL,DRMANVAL,PRMANVAL,VPATINST,VAPIARY,VLOOP,FSVPIN,S2017,NEWRXIEN
N DRGARY,DLP,MTYPE,MTYPEE,ERXSTAT,STATIEN,PDIAGTXT,SDIAGTXT,RELIEN,RELMTYPE,ERRIEN,LERXSTAT,LOPSTAT,OPIEN,ERXDSUB,COM,EXSTATUS,R2017,REQIEN
N SFIRST,PATPT,EPRVPT,CIEN,CHGMESRI,CHGMESRQ,NO311,RESPVAL,ERRFLG,PSNF
S LINE=0
; set the standard field
S S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
S MTYPEE=$$GET1^DIQ(52.49,PSOIEN,.08,"E")
S STATIEN=$$GET1^DIQ(52.49,PSOIEN,1,"I")
S ERXSTAT=$$GET1^DIQ(52.45,STATIEN,.02,"E")
I MTYPE="IE" D
.I ",ERROR,CANCEL RESPONSE/INBOUND ERROR,"[(","_ERXSTAT_",") S ERRFLG=1 Q
.I ",RXCHANGE REQUEST ERROR,RXRENEWAL REQUEST ERROR,"[(","_ERXSTAT_",") S ERRFLG=1 Q
.I ",INBOUND RXCHANGE ERROR ACKNOWLEDGED,INBOUND RXRENEWAL ERROR ACKNOWLEDGED,"[(","_ERXSTAT_",") S ERRFLG=1 Q
.S ERRFLG=0
I MTYPE'="IE" S ERRFLG=0
S PATIEN=$$GET1^DIQ(52.49,PSOIEN,.04,"I") I 'PATIEN S PATIEN=$$GETPAT^PSOERXU5(PSOIEN)
S PATIENS=PATIEN_","
D GETS^DIQ(52.46,PATIENS,"**","IE","PATDAT")
I 'ERRFLG D
.S EPAT=$G(PATDAT(52.46,PATIENS,.01,"E"))
.S EPATDOB=$G(PATDAT(52.46,PATIENS,.08,"I")),EPATDOB=$$FMTE^XLFDT(EPATDOB,"2D")
I ERRFLG D
.S (EPAT,EPATDOB)=""
S VPATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
S VPATNM=$S(VPATIEN&'ERRFLG:$$GET1^DIQ(2,VPATIEN,.01,"E"),1:"NOT LINKED")
S VPATDOB=$S(VPATIEN&'ERRFLG:$$GET1^DIQ(2,VPATIEN,.03,"I"),1:"N/A")
I VPATDOB S VPATDOB=$$FMTE^XLFDT(VPATDOB,"2D")
S PHARMIEN=$$GET1^DIQ(52.49,PSOIEN,2.5,"I")
D GETS^DIQ(52.47,PHARMIEN,"**","E","PHDAT")
S EPRVIEN=$$GET1^DIQ(52.49,PSOIEN,2.1,"I") I 'EPRVIEN S EPRVIEN=$$GETPROV^PSOERXU5(PSOIEN)
S EPRVNM=$$GET1^DIQ(52.48,EPRVIEN,.01,"E")
; erx provider primary phone 2017071
I S2017 D
.S EPRVPT=$$COMMVAL^PSOERXU5(EPRVIEN,52.48,11,"PT",1)
I 'S2017 D
.N IENS,TYPE,EXT
.S EPRVPT="",CIEN=$O(^PS(52.48,EPRVIEN,3,"C","TE",0))
.I CIEN D
..S IENS=CIEN_","_EPRVIEN_","
..S EPRVPT=$$GET1^DIQ(52.483,IENS,.01,"I")
.I 'CIEN D
..S CIEN=0
..F S CIEN=$O(^PS(52.48,EPRVIEN,3,CIEN)) Q:CIEN'?1.N D Q:EPRVPT]""
...S IENS=CIEN_","_EPRVIEN_","
...S EPRVPT=$$GET1^DIQ(52.483,IENS,.01,"I")
...S TYPE=$$GET1^DIQ(52.483,IENS,.02,"I")
...S:TYPE="EM" EPRVPT=""
.I EPRVPT]"" D
..S EXT=$$GET1^DIQ(52.483,IENS,.03,"I")
..S:EXT]"" EPRVPT=EPRVPT_"X"_EXT
I 'S2017 S EPRVNPI=$$GET1^DIQ(52.48,EPRVIEN,1.5,"E")
I S2017 S EPRVNPI=$$GET1^DIQ(52.48,EPRVIEN,15.1,"E")
S EPRVDEA=$$GET1^DIQ(52.48,EPRVIEN,1.6,"E")
S VAPRVIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I")
S ERXWRDT=$$GET1^DIQ(52.49,PSOIEN,5.9,"I")
S VAPRVNM=$S(VAPRVIEN:$$GET1^DIQ(200,VAPRVIEN,.01,"E"),1:"NOT LINKED")
S VAPRVNPI=$S(VAPRVIEN:$$GET1^DIQ(200,VAPRVIEN,41.99,"E"),1:"N/A")
S VAPRVDEA=$S(VAPRVIEN:$P($$VADEA^PSOERXU8(VAPRVIEN,PSOIEN),"^",2),1:"N/A") ; PSO*7*743
D GETS^DIQ(52.48,EPRVIEN,"**","E","PRVDAT")
S SUPIEN=$$GET1^DIQ(52.49,PSOIEN,2.6,"I")
D GETS^DIQ(52.48,SUPIEN,"**","E","SUPDAT")
S PAMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.7,"I")
S PRMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.3,"I")
S DRMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.5,"I")
S WDATE=$$GET1^DIQ(52.49,PSOIEN,5.9,"E")
S CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
S CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
S RESPVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
S:'ERRFLG PATPT=$$GETPTPH^PSOERXU7(PATIEN,S2017,"PT,HP")
; only set the hold reason if the eRx has a hold status
S CURSTATE=$$GET1^DIQ(52.49,PSOIEN,1,"E")
S (VAHSTA,VAHREA)=""
I S2017,MTYPE'="RE" D
.S MEDIEN=$O(^PS(52.49,PSOIEN,311,"C","P",0))
.S EDIRECT=$$GET1^DIQ(52.49,MEDIEN_","_PSOIEN_",",8,"E")
I S2017,MTYPE="RE" D
.S MEDIEN=$O(^PS(52.49,PSOIEN,311,"C","MR",0))
I 'S2017 D
.S EDIRECT=$$GET1^DIQ(52.49,PSOIEN,7,"E")
I $E(CURSTATE,1)="H" D
.S CURSTATI=$$GET1^DIQ(52.49,PSOIEN,1,"I")
.S LHMATCH=999999,LHFOUND=0 F S LHMATCH=$O(^PS(52.49,PSOIEN,19,LHMATCH),-1) Q:'LHMATCH!(LHFOUND) D
..S LHSTATI=$$GET1^DIQ(52.4919,LHMATCH_","_PSOIEN_",",.02,"I") I LHSTATI=CURSTATI D S LHFOUND=LHMATCH Q
...S VAHREA=$$GET1^DIQ(52.4919,LHMATCH_","_PSOIEN_",",1)
...S VAHSTA=$$GET1^DIQ(52.45,LHSTATI,.01,"E")_" - "_$$GET1^DIQ(52.45,LHSTATI,.02,"E")
...S VAHPER=$$GET1^DIQ(52.4919,LHMATCH_","_PSOIEN_",",.03,"E")
I (",RE,CN,"[(","_MTYPE_","))!((MTYPE="CX")&$$CHGMTYPE^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)) S MTYPEE=$G(MTYPEE)_" - "_$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
S LINETXT=""
S LINE=LINE+1 D CNTRL^VALM10(LINE,1,$L(MTYPEE),IORVON,IORVOFF)
I $$GET1^DIQ(52.49,PSOIEN,95.1,"I") S $E(MTYPEE,63)="EPCS DEA VALIDATED" D CNTRL^VALM10(LINE,63,80,IORVON,IORVOFF)
D SET^VALM10(LINE,MTYPEE)
S LINE=LINE+1 D SET^VALM10(LINE,"eRx Status: "_$S($E(CURSTATE,1)="H":VAHSTA,1:ERXSTAT))
I ",CX,CR,"[(","_MTYPE_","),$$QTSUMDT1^PSOERX1D(PSOIEN,MTYPE,CHGMESRI,CHGMESRQ,RESPVAL,.LINE) S VALMCNT=LINE Q
I MTYPE="CA" D
.S NRXIEN=$$RESOLV^PSOERXU2(PSOIEN) Q:'NRXIEN
.S LERXSTAT=$$LASTSTAT^PSOERXU5(NRXIEN)
.; over-ride for new rx's that have no status history
.I '$L(LERXSTAT) S LERXSTAT="N - NEW"
.S OPIEN=$$GET1^DIQ(52.49,NRXIEN,.13,"I") Q:'OPIEN
.S LOPSTAT=$$GET1^DIQ(52,OPIEN,100,"E")
.I NRXIEN S CSCOMM=$$CSCOMM^PSOERXU5(NRXIEN)
I MTYPE="CN" D
.S RELIEN=$$RESOLV^PSOERXU2(PSOIEN) Q:'RELIEN
.S NRXIEN=$$RESOLV^PSOERXU2(RELIEN)
.S LERXSTAT=$$LASTSTAT^PSOERXU5(NRXIEN)
.I NRXIEN S CSCOMM=$$CSCOMM^PSOERXU5(NRXIEN)
.I '$L(LERXSTAT) S LERXSTAT="N - NEW"
.S OPIEN=$$GET1^DIQ(52.49,NRXIEN,.13,"I") Q:'OPIEN
.S LOPSTAT=$$GET1^DIQ(52,OPIEN,100,"E")
I $G(CSCOMM)]"" S LINE=LINE+1 D SET^VALM10(LINE,"Current Status Details: "_CSCOMM)
I $D(LERXSTAT) S LINE=LINE+1 D SET^VALM10(LINE,"Last New Rx status: "_LERXSTAT)
I $D(LOPSTAT) S LINE=LINE+1 D SET^VALM10(LINE,"Outpatient Prescription status: "_LOPSTAT)
I (",RR,RE,CR,"[MTYPE)!((MTYPE="CX")&$$ADMDPRLN^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI)) S LINE=LINE+1 D SET^VALM10(LINE,"**************************MEDICATION PRESCRIBED******************************")
I 'ERRFLG,$L($G(PATPT)) S LINE=LINE+1 D SET^VALM10(LINE,"eRx Patient Primary Telephone: "_PATPT)
S LINE=LINE+1
D ADDITEM^PSOERX1A(.LINETXT,"eRx Patient: ",$E(EPAT,1,39),1,52)
D ADDITEM^PSOERX1A(.LINETXT,"DOB: ",EPATDOB,57,20)
D SET^VALM10(LINE,LINETXT) S LINETXT=""
I $L(EPAT)>39 D
.S LINE=LINE+1 D SET^VALM10(LINE," "_$E(EPAT,40,78))
I $L(EPAT)>78 D
.S LINE=LINE+1 D SET^VALM10(LINE," "_$E(EPAT,79,135))
S LINETXT=""
S LINE=LINE+1
I MTYPE'="CA",MTYPE'="CN" D
.D ADDITEM^PSOERX1A(.LINETXT,"Vista Patient"_$S(PAMANVAL:"[v]",1:"")_": ",$E(VPATNM,1,55),1,55)
.D ADDITEM^PSOERX1A(.LINETXT,"DOB: ",VPATDOB,57,20)
.D SET^VALM10(LINE,LINETXT) S LINETXT=""
.S LINE=LINE+1 D SET^VALM10(LINE,"")
I $L($G(EPRVPT)) S LINE=LINE+1 D SET^VALM10(LINE,"eRx Provider Primary Telephone: "_EPRVPT)
S LINE=LINE+1
D ADDITEM^PSOERX1A(.LINETXT,"eRx Provider: ",$E(EPRVNM,1,39),1,52)
D SET^VALM10(LINE,LINETXT) S LINETXT=""
D ADDITEM^PSOERX1A(.LINETXT,"DEA#: ",EPRVDEA,30,20)
D ADDITEM^PSOERX1A(.LINETXT,"NPI: ",EPRVNPI,57,20)
S LINE=LINE+1 D SET^VALM10(LINE,LINETXT) S LINETXT=""
I $L(EPRVNM)>39 D
.S LINE=LINE+1 D SET^VALM10(LINE," "_$E(EPRVNM,40,77))
I $L(EPRVNM)>77 D
.S LINE=LINE+1 D SET^VALM10(LINE," "_$E(EPRVNM,78,135))
I MTYPE'="CA",MTYPE'="CN" D
.S LINE=LINE+1
.D ADDITEM^PSOERX1A(.LINETXT,"Vista Provider"_$S(PRMANVAL:"[v]",1:"")_": ",$E(VAPRVNM,1,55),1,55)
.D SET^VALM10(LINE,LINETXT) S LINETXT=""
.D ADDITEM^PSOERX1A(.LINETXT,"DEA#: ",VAPRVDEA,30,20)
.D ADDITEM^PSOERX1A(.LINETXT,"NPI: ",VAPRVNPI,57,20)
.S LINE=LINE+1 D SET^VALM10(LINE,LINETXT) S LINETXT=""
S LINE=LINE+1 D SET^VALM10(LINE,"")
S ERXDRUG=$$GET1^DIQ(52.49,PSOIEN,3.1,"E") I '$L(ERXDRUG) S ERXDRUG=$$GETDRUG^PSOERXU5(PSOIEN)
S ERXQTY=$$GET1^DIQ(52.49,PSOIEN,5.1,"E")
I $G(S2017) D
.S ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
;setting 10.6 refill value
I '$G(S2017) D
.S ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
.I ERXRFLS="" S ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.7,"I")
; refills for a refill response is # of refills-1
I MTYPE="RE",ERXRFLS S ERXRFLS=ERXRFLS-1
S ERXDS=$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
S ERXDT=$$GET1^DIQ(52.49,PSOIEN,.03,"E")
I S2017 D
.S ERXDT=$S(MEDIEN:$$EFFDATE^PSOERXU5(PSOIEN,MEDIEN),1:"")
S VADRGIEN=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
S VADRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"E")
S VAREF=$$GET1^DIQ(52.49,PSOIEN,20.5,"E")
;PSO*7*635, Adjust va refills for renewal response messages
I MTYPE="RE",VAREF,VAREF=$$GET1^DIQ(52.49,PSOIEN,5.6,"E") S VAREF=VAREF-1
S VAQTY=$$GET1^DIQ(52.49,PSOIEN,20.1,"E")
S VADAYS=$$GET1^DIQ(52.49,PSOIEN,20.2,"E")
I VADRG']"" S VADRG="NOT LINKED"
D TXT2ARY^PSOERXD1(.DRGARY,ERXDRUG,,70)
S LINE=LINE+1 D SET^VALM10(LINE,"eRx Drug: "_$G(DRGARY(1))_" "_$P($$ERXDRSCH^PSOERXUT(PSOIEN),"^",2))
S DLP=1
F S DLP=$O(DRGARY(DLP)) Q:'DLP D
.S LINE=LINE+1 D SET^VALM10(LINE," "_$G(DRGARY(DLP)))
S LINE=LINE+1
D ADDITEM^PSOERX1A(.LINETXT,"eRx Qty: ",ERXQTY,1,17)
D ADDITEM^PSOERX1A(.LINETXT,"eRx Refills: ",ERXRFLS,19,16)
D ADDITEM^PSOERX1A(.LINETXT,"eRx Days Supply: ",ERXDS,37,20)
I 'S2017 D ADDITEM^PSOERX1A(.LINETXT,"eRx Date: ",$P(ERXDT,"@"),58,22)
D SET^VALM10(LINE,LINETXT) S LINETXT=""
I S2017 D
.S LINE=LINE+1
.D ADDITEM^PSOERX1A(.LINETXT,"eRx Written Date: ",$P(WDATE,"@"),1,35)
.D ADDITEM^PSOERX1A(.LINETXT,"eRx Issue Date: ",ERXDT,40,70)
.D SET^VALM10(LINE,LINETXT) S LINETXT=""
.S LINE=LINE+1
.I MTYPE="N"!((MTYPE="CX")&$$PROHIBIT^PSOERX1D(RESPVAL,CHGMESRI)) D
..S PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
..S PROHIBIT=$S(PROHIBIT=1:"Yes",1:"No")
..D SET^VALM10(LINE,"Prohibit Renewals: "_PROHIBIT)
D TXT2ARY^PSOERXD1(.SIGARY,$G(EDIRECT),,70)
S SFIRST=$O(SIGARY(0))
I 'S2017 D
.S SGLOOP=0 F S SGLOOP=$O(SIGARY(SGLOOP)) Q:'SGLOOP D
..S LINE=LINE+1 D SET^VALM10(LINE,$S(SGLOOP=SFIRST:"eRx Sig: ",1:" ")_$G(SIGARY(SGLOOP)))
I S2017,$G(MEDIEN) D
.S LINE=LINE+1 D SET^VALM10(LINE,"eRx Sig:")
.S SGLOOP=0 F S SGLOOP=$O(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP)) Q:'SGLOOP D
..S LINE=LINE+1 D SET^VALM10(LINE,$G(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP,0)))
I (",CX,CR,"[(","_MTYPE_",")),$$QTSUMDT2^PSOERX1D(PSOIEN,MTYPE,CHGMESRI,RESPVAL,.LINE) S VALMCNT=LINE Q
I MTYPE="RR" D S VALMCNT=LINE Q
.; if the renew request is 2017, use psoerxu7 to build from 311 subfile
.I S2017 D MEDDIS^PSOERXU7(PSOIEN,.LINE)
.; if either of them are not 2017, build the med dispensed from PSOERXU7 (old 49 subfile)
.; if it is not 2017, build from psoerxu3 (49 subfile)
.I 'S2017 D MEDDIS^PSOERXU3(PSOIEN,"D",.LINE)
.D RRRES^PSOERXU3(PSOIEN,.LINE,1),RRREQ^PSOERXU3(PSOIEN,.LINE),MSGHIS^PSOERXU3(PSOIEN,.LINE)
I MTYPE="RE" D S VALMCNT=LINE Q
.S REQIEN=$$RESOLV^PSOERXU2(PSOIEN)
.S R2017=$$GET1^DIQ(52.49,REQIEN,312.1,"I")
.D DISPRX,RRRES^PSOERXU3(PSOIEN,.LINE,1)
.; if the response is 2017 and the request is 2017, build the med dispensed from PSOERXU7 (311 subfile)
.I S2017,R2017 D MEDDIS^PSOERXU7(PSOIEN,.LINE)
.I 'R2017 D MEDDIS^PSOERXU3(REQIEN,"D",.LINE)
.D RRREQ^PSOERXU3(PSOIEN,.LINE),MSGHIS^PSOERXU3(PSOIEN,.LINE)
.; if the status is one of the failed status values, display the error details.
.I $$GET1^DIQ(52.49,PSOIEN,1,"E")="RXF" D PROCERR^PSOERXU3(PSOIEN,.LINE)
I MTYPE="IE" D S VALMCNT=LINE Q
.S RELIEN=$$RESOLV^PSOERXU2(PSOIEN)
.S RELMTYPE=$$GET1^DIQ(52.49,RELIEN,.08,"I")
.I RELMTYPE="RE" D ERRDISP^PSOERXU3(PSOIEN,.LINE),RRREQ^PSOERXU3(PSOIEN,.LINE),MSGHIS^PSOERXU3(PSOIEN,.LINE) Q
.I RELMTYPE="CA" D ERRDISP^PSOERXU3(PSOIEN,.LINE),CANREQ^PSOERXU5(PSOIEN,.LINE),CANRES^PSOERXU5(PSOIEN,.LINE),MSGHIS^PSOERXU3(PSOIEN,.LINE) Q
.I RELMTYPE="CN" D ERRDISP^PSOERXU3(PSOIEN,.LINE),CANRES^PSOERXU5(PSOIEN,.LINE),CANREQ^PSOERXU5(PSOIEN,.LINE) Q
.D ERRDISP^PSOERXU3(PSOIEN,.LINE),MSGHIS^PSOERXU3(PSOIEN,.LINE)
I MTYPE="CA" D S VALMCNT=LINE Q
.D CANREQ^PSOERXU5(PSOIEN,.LINE),CANRES^PSOERXU5(PSOIEN,.LINE),MSGHIS^PSOERXU3(PSOIEN,.LINE)
I MTYPE="CN" D S VALMCNT=LINE Q
.I $$GET1^DIQ(52.49,PSOIEN,1,"E")="CNE" D Q
..S ERRIEN=$$GETRESP^PSOERXU2(PSOIEN)
..D ERRDISP^PSOERXU3(ERRIEN,.LINE),CANRES^PSOERXU5(PSOIEN,.LINE),CANREQ^PSOERXU5(PSOIEN,.LINE),MSGHIS^PSOERXU3(PSOIEN,.LINE) Q
.D CANRES^PSOERXU5(PSOIEN,.LINE),CANREQ^PSOERXU5(PSOIEN,.LINE),MSGHIS^PSOERXU3(PSOIEN,.LINE)
DISPRX ;
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 D SET^VALM10(LINE,"Vista Drug"_$S(DRMANVAL:"[v]",1:"")_": "_VADRG_" "_$P($$VADRSCH^PSOERXUT(VADRGIEN),"^",3)_PSNF)
.S LINE=LINE+1
.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)
.D SET^VALM10(LINE,LINETXT) S LINETXT=""
.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)
.S LINE=LINE+1 D SET^VALM10(LINE,"Vista Sig: "_$S(FSSIG:$G(VASARY(FSSIG)),1:""))
.S SLOOP=1 F S SLOOP=$O(VASARY(SLOOP)) Q:'SLOOP D
..S LINE=LINE+1 D SET^VALM10(LINE," "_VASARY(SLOOP))
.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:""))
.S VLOOP=1 F S VLOOP=$O(VAPIARY(VLOOP)) Q:'VLOOP D
..S LINE=LINE+1 D SET^VALM10(LINE," "_VAPIARY(VLOOP))
S LINE=LINE+1 D SET^VALM10(LINE,"Hold Status: "_$G(VAHSTA))
S VAHREA="Hold Reason: "_$G(VAHREA)
D TXT2ARY^PSOERXD1(.HARY,VAHREA," ",80)
S HL=0 F S HL=$O(HARY(HL)) Q:'HL D
.S LINE=LINE+1 D SET^VALM10(LINE,$G(HARY(HL)))
S LINE=LINE+1 D SET^VALM10(LINE,"Placed on hold by: "_$G(VAHPER))
S LINE=LINE+1 D SET^VALM10(LINE,"")
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 S LINE=LINE+1 D SET^VALM10(LINE,$G(COMARY(COM)))
S LINE=LINE+1 D SET^VALM10(LINE,"")
I $$GET1^DIQ(52.49,PSOIEN,.05,"I") D
.D ALG^PSOERXU1(.LINE)
I '$G(S2017) D
.D DIAG^PSOERXU1(PSOIEN,.LINE)
I $G(S2017) D
.D:MEDIEN DIAG2017^PSOERXU5(PSOIEN,.LINE,,MEDIEN)
; DEA Note for CS Digitally Signed eRx records
I $$GET1^DIQ(52.49,PSOIEN,95.1,"I") D
. D DEANOTE^PSOERX1H
;
S VALMCNT=LINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERX1G 15528 printed Dec 13, 2024@02:28:17 Page 2
PSOERX1G ;ALB/MFR - eRx Holding Queue Rx View INIT section ;Aug 14, 2020@12:43:34
+1 ;;7.0;OUTPATIENT PHARMACY;**617,646,689,700,743**;DEC 1997;Build 24
+2 ;
INIT ;
+1 NEW PATIEN,PHARMIEN,PRVIEN,PHDAT,PATDAT,SUPDAT,PRVDAT,LINE,PRVLNM,PRVMI,PRVFN,EPAT,EPATDOB,VPATIEN,HARY,HL,PROHIBIT,ERXWRDT
+2 NEW VPATNM,VPATDOB,EPRVIEN,EPRVNM,EPRVNPI,EPRVDEA,VAPRVIEN,VAPRVNM,VAPRVNPI,VAPRVDEA,SUPIEN,ERXDRUG,ERXQTY,ERXFLS,CSCOMM,MEDIEN
+3 NEW ERXDS,ERXDT,VADRGIEN,VADRG,LINETXT,ERXCOMM,ERXRFLS,PATIENS,VAHREA,VAQTY,VAREF,VASIG,PATDAT,CURSTATE,CURSTATI,WDATE,RRNRXIEN
+4 NEW LHFOUND,LHMATCH,LHSTATI,VAPDEAEX,ERXCOMM,COMFRST,COMARY,SIGDATA,SIGLOOP,SFIRSPROT,SGLOOP,SIGARY,VADAYS,NRXIEN
+5 NEW SLOOP,VASIG,VASARY,FSSIG,VAHSTA,EDIRECT,VAHPER,PAMANVAL,DRMANVAL,PRMANVAL,VPATINST,VAPIARY,VLOOP,FSVPIN,S2017,NEWRXIEN
+6 NEW DRGARY,DLP,MTYPE,MTYPEE,ERXSTAT,STATIEN,PDIAGTXT,SDIAGTXT,RELIEN,RELMTYPE,ERRIEN,LERXSTAT,LOPSTAT,OPIEN,ERXDSUB,COM,EXSTATUS,R2017,REQIEN
+7 NEW SFIRST,PATPT,EPRVPT,CIEN,CHGMESRI,CHGMESRQ,NO311,RESPVAL,ERRFLG,PSNF
+8 SET LINE=0
+9 ; set the standard field
+10 SET S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
+11 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+12 SET MTYPEE=$$GET1^DIQ(52.49,PSOIEN,.08,"E")
+13 SET STATIEN=$$GET1^DIQ(52.49,PSOIEN,1,"I")
+14 SET ERXSTAT=$$GET1^DIQ(52.45,STATIEN,.02,"E")
+15 IF MTYPE="IE"
Begin DoDot:1
+16 IF ",ERROR,CANCEL RESPONSE/INBOUND ERROR,"[(","_ERXSTAT_",")
SET ERRFLG=1
QUIT
+17 IF ",RXCHANGE REQUEST ERROR,RXRENEWAL REQUEST ERROR,"[(","_ERXSTAT_",")
SET ERRFLG=1
QUIT
+18 IF ",INBOUND RXCHANGE ERROR ACKNOWLEDGED,INBOUND RXRENEWAL ERROR ACKNOWLEDGED,"[(","_ERXSTAT_",")
SET ERRFLG=1
QUIT
+19 SET ERRFLG=0
End DoDot:1
+20 IF MTYPE'="IE"
SET ERRFLG=0
+21 SET PATIEN=$$GET1^DIQ(52.49,PSOIEN,.04,"I")
IF 'PATIEN
SET PATIEN=$$GETPAT^PSOERXU5(PSOIEN)
+22 SET PATIENS=PATIEN_","
+23 DO GETS^DIQ(52.46,PATIENS,"**","IE","PATDAT")
+24 IF 'ERRFLG
Begin DoDot:1
+25 SET EPAT=$GET(PATDAT(52.46,PATIENS,.01,"E"))
+26 SET EPATDOB=$GET(PATDAT(52.46,PATIENS,.08,"I"))
SET EPATDOB=$$FMTE^XLFDT(EPATDOB,"2D")
End DoDot:1
+27 IF ERRFLG
Begin DoDot:1
+28 SET (EPAT,EPATDOB)=""
End DoDot:1
+29 SET VPATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+30 SET VPATNM=$SELECT(VPATIEN&'ERRFLG:$$GET1^DIQ(2,VPATIEN,.01,"E"),1:"NOT LINKED")
+31 SET VPATDOB=$SELECT(VPATIEN&'ERRFLG:$$GET1^DIQ(2,VPATIEN,.03,"I"),1:"N/A")
+32 IF VPATDOB
SET VPATDOB=$$FMTE^XLFDT(VPATDOB,"2D")
+33 SET PHARMIEN=$$GET1^DIQ(52.49,PSOIEN,2.5,"I")
+34 DO GETS^DIQ(52.47,PHARMIEN,"**","E","PHDAT")
+35 SET EPRVIEN=$$GET1^DIQ(52.49,PSOIEN,2.1,"I")
IF 'EPRVIEN
SET EPRVIEN=$$GETPROV^PSOERXU5(PSOIEN)
+36 SET EPRVNM=$$GET1^DIQ(52.48,EPRVIEN,.01,"E")
+37 ; erx provider primary phone 2017071
+38 IF S2017
Begin DoDot:1
+39 SET EPRVPT=$$COMMVAL^PSOERXU5(EPRVIEN,52.48,11,"PT",1)
End DoDot:1
+40 IF 'S2017
Begin DoDot:1
+41 NEW IENS,TYPE,EXT
+42 SET EPRVPT=""
SET CIEN=$ORDER(^PS(52.48,EPRVIEN,3,"C","TE",0))
+43 IF CIEN
Begin DoDot:2
+44 SET IENS=CIEN_","_EPRVIEN_","
+45 SET EPRVPT=$$GET1^DIQ(52.483,IENS,.01,"I")
End DoDot:2
+46 IF 'CIEN
Begin DoDot:2
+47 SET CIEN=0
+48 FOR
SET CIEN=$ORDER(^PS(52.48,EPRVIEN,3,CIEN))
if CIEN'?1.N
QUIT
Begin DoDot:3
+49 SET IENS=CIEN_","_EPRVIEN_","
+50 SET EPRVPT=$$GET1^DIQ(52.483,IENS,.01,"I")
+51 SET TYPE=$$GET1^DIQ(52.483,IENS,.02,"I")
+52 if TYPE="EM"
SET EPRVPT=""
End DoDot:3
if EPRVPT]""
QUIT
End DoDot:2
+53 IF EPRVPT]""
Begin DoDot:2
+54 SET EXT=$$GET1^DIQ(52.483,IENS,.03,"I")
+55 if EXT]""
SET EPRVPT=EPRVPT_"X"_EXT
End DoDot:2
End DoDot:1
+56 IF 'S2017
SET EPRVNPI=$$GET1^DIQ(52.48,EPRVIEN,1.5,"E")
+57 IF S2017
SET EPRVNPI=$$GET1^DIQ(52.48,EPRVIEN,15.1,"E")
+58 SET EPRVDEA=$$GET1^DIQ(52.48,EPRVIEN,1.6,"E")
+59 SET VAPRVIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I")
+60 SET ERXWRDT=$$GET1^DIQ(52.49,PSOIEN,5.9,"I")
+61 SET VAPRVNM=$SELECT(VAPRVIEN:$$GET1^DIQ(200,VAPRVIEN,.01,"E"),1:"NOT LINKED")
+62 SET VAPRVNPI=$SELECT(VAPRVIEN:$$GET1^DIQ(200,VAPRVIEN,41.99,"E"),1:"N/A")
+63 ; PSO*7*743
SET VAPRVDEA=$SELECT(VAPRVIEN:$PIECE($$VADEA^PSOERXU8(VAPRVIEN,PSOIEN),"^",2),1:"N/A")
+64 DO GETS^DIQ(52.48,EPRVIEN,"**","E","PRVDAT")
+65 SET SUPIEN=$$GET1^DIQ(52.49,PSOIEN,2.6,"I")
+66 DO GETS^DIQ(52.48,SUPIEN,"**","E","SUPDAT")
+67 SET PAMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.7,"I")
+68 SET PRMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.3,"I")
+69 SET DRMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.5,"I")
+70 SET WDATE=$$GET1^DIQ(52.49,PSOIEN,5.9,"E")
+71 SET CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
+72 SET CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
+73 SET RESPVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
+74 if 'ERRFLG
SET PATPT=$$GETPTPH^PSOERXU7(PATIEN,S2017,"PT,HP")
+75 ; only set the hold reason if the eRx has a hold status
+76 SET CURSTATE=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+77 SET (VAHSTA,VAHREA)=""
+78 IF S2017
IF MTYPE'="RE"
Begin DoDot:1
+79 SET MEDIEN=$ORDER(^PS(52.49,PSOIEN,311,"C","P",0))
+80 SET EDIRECT=$$GET1^DIQ(52.49,MEDIEN_","_PSOIEN_",",8,"E")
End DoDot:1
+81 IF S2017
IF MTYPE="RE"
Begin DoDot:1
+82 SET MEDIEN=$ORDER(^PS(52.49,PSOIEN,311,"C","MR",0))
End DoDot:1
+83 IF 'S2017
Begin DoDot:1
+84 SET EDIRECT=$$GET1^DIQ(52.49,PSOIEN,7,"E")
End DoDot:1
+85 IF $EXTRACT(CURSTATE,1)="H"
Begin DoDot:1
+86 SET CURSTATI=$$GET1^DIQ(52.49,PSOIEN,1,"I")
+87 SET LHMATCH=999999
SET LHFOUND=0
FOR
SET LHMATCH=$ORDER(^PS(52.49,PSOIEN,19,LHMATCH),-1)
if 'LHMATCH!(LHFOUND)
QUIT
Begin DoDot:2
+88 SET LHSTATI=$$GET1^DIQ(52.4919,LHMATCH_","_PSOIEN_",",.02,"I")
IF LHSTATI=CURSTATI
Begin DoDot:3
+89 SET VAHREA=$$GET1^DIQ(52.4919,LHMATCH_","_PSOIEN_",",1)
+90 SET VAHSTA=$$GET1^DIQ(52.45,LHSTATI,.01,"E")_" - "_$$GET1^DIQ(52.45,LHSTATI,.02,"E")
+91 SET VAHPER=$$GET1^DIQ(52.4919,LHMATCH_","_PSOIEN_",",.03,"E")
End DoDot:3
SET LHFOUND=LHMATCH
QUIT
End DoDot:2
End DoDot:1
+92 IF (",RE,CN,"[(","_MTYPE_","))!((MTYPE="CX")&$$CHGMTYPE^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI))
SET MTYPEE=$GET(MTYPEE)_" - "_$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
+93 SET LINETXT=""
+94 SET LINE=LINE+1
DO CNTRL^VALM10(LINE,1,$LENGTH(MTYPEE),IORVON,IORVOFF)
+95 IF $$GET1^DIQ(52.49,PSOIEN,95.1,"I")
SET $EXTRACT(MTYPEE,63)="EPCS DEA VALIDATED"
DO CNTRL^VALM10(LINE,63,80,IORVON,IORVOFF)
+96 DO SET^VALM10(LINE,MTYPEE)
+97 SET LINE=LINE+1
DO SET^VALM10(LINE,"eRx Status: "_$SELECT($EXTRACT(CURSTATE,1)="H":VAHSTA,1:ERXSTAT))
+98 IF ",CX,CR,"[(","_MTYPE_",")
IF $$QTSUMDT1^PSOERX1D(PSOIEN,MTYPE,CHGMESRI,CHGMESRQ,RESPVAL,.LINE)
SET VALMCNT=LINE
QUIT
+99 IF MTYPE="CA"
Begin DoDot:1
+100 SET NRXIEN=$$RESOLV^PSOERXU2(PSOIEN)
if 'NRXIEN
QUIT
+101 SET LERXSTAT=$$LASTSTAT^PSOERXU5(NRXIEN)
+102 ; over-ride for new rx's that have no status history
+103 IF '$LENGTH(LERXSTAT)
SET LERXSTAT="N - NEW"
+104 SET OPIEN=$$GET1^DIQ(52.49,NRXIEN,.13,"I")
if 'OPIEN
QUIT
+105 SET LOPSTAT=$$GET1^DIQ(52,OPIEN,100,"E")
+106 IF NRXIEN
SET CSCOMM=$$CSCOMM^PSOERXU5(NRXIEN)
End DoDot:1
+107 IF MTYPE="CN"
Begin DoDot:1
+108 SET RELIEN=$$RESOLV^PSOERXU2(PSOIEN)
if 'RELIEN
QUIT
+109 SET NRXIEN=$$RESOLV^PSOERXU2(RELIEN)
+110 SET LERXSTAT=$$LASTSTAT^PSOERXU5(NRXIEN)
+111 IF NRXIEN
SET CSCOMM=$$CSCOMM^PSOERXU5(NRXIEN)
+112 IF '$LENGTH(LERXSTAT)
SET LERXSTAT="N - NEW"
+113 SET OPIEN=$$GET1^DIQ(52.49,NRXIEN,.13,"I")
if 'OPIEN
QUIT
+114 SET LOPSTAT=$$GET1^DIQ(52,OPIEN,100,"E")
End DoDot:1
+115 IF $GET(CSCOMM)]""
SET LINE=LINE+1
DO SET^VALM10(LINE,"Current Status Details: "_CSCOMM)
+116 IF $DATA(LERXSTAT)
SET LINE=LINE+1
DO SET^VALM10(LINE,"Last New Rx status: "_LERXSTAT)
+117 IF $DATA(LOPSTAT)
SET LINE=LINE+1
DO SET^VALM10(LINE,"Outpatient Prescription status: "_LOPSTAT)
+118 IF (",RR,RE,CR,"[MTYPE)!((MTYPE="CX")&$$ADMDPRLN^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI))
SET LINE=LINE+1
DO SET^VALM10(LINE,"**************************MEDICATION PRESCRIBED******************************")
+119 IF 'ERRFLG
IF $LENGTH($GET(PATPT))
SET LINE=LINE+1
DO SET^VALM10(LINE,"eRx Patient Primary Telephone: "_PATPT)
+120 SET LINE=LINE+1
+121 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Patient: ",$EXTRACT(EPAT,1,39),1,52)
+122 DO ADDITEM^PSOERX1A(.LINETXT,"DOB: ",EPATDOB,57,20)
+123 DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
+124 IF $LENGTH(EPAT)>39
Begin DoDot:1
+125 SET LINE=LINE+1
DO SET^VALM10(LINE," "_$EXTRACT(EPAT,40,78))
End DoDot:1
+126 IF $LENGTH(EPAT)>78
Begin DoDot:1
+127 SET LINE=LINE+1
DO SET^VALM10(LINE," "_$EXTRACT(EPAT,79,135))
End DoDot:1
+128 SET LINETXT=""
+129 SET LINE=LINE+1
+130 IF MTYPE'="CA"
IF MTYPE'="CN"
Begin DoDot:1
+131 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Patient"_$SELECT(PAMANVAL:"[v]",1:"")_": ",$EXTRACT(VPATNM,1,55),1,55)
+132 DO ADDITEM^PSOERX1A(.LINETXT,"DOB: ",VPATDOB,57,20)
+133 DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
+134 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
End DoDot:1
+135 IF $LENGTH($GET(EPRVPT))
SET LINE=LINE+1
DO SET^VALM10(LINE,"eRx Provider Primary Telephone: "_EPRVPT)
+136 SET LINE=LINE+1
+137 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Provider: ",$EXTRACT(EPRVNM,1,39),1,52)
+138 DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
+139 DO ADDITEM^PSOERX1A(.LINETXT,"DEA#: ",EPRVDEA,30,20)
+140 DO ADDITEM^PSOERX1A(.LINETXT,"NPI: ",EPRVNPI,57,20)
+141 SET LINE=LINE+1
DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
+142 IF $LENGTH(EPRVNM)>39
Begin DoDot:1
+143 SET LINE=LINE+1
DO SET^VALM10(LINE," "_$EXTRACT(EPRVNM,40,77))
End DoDot:1
+144 IF $LENGTH(EPRVNM)>77
Begin DoDot:1
+145 SET LINE=LINE+1
DO SET^VALM10(LINE," "_$EXTRACT(EPRVNM,78,135))
End DoDot:1
+146 IF MTYPE'="CA"
IF MTYPE'="CN"
Begin DoDot:1
+147 SET LINE=LINE+1
+148 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Provider"_$SELECT(PRMANVAL:"[v]",1:"")_": ",$EXTRACT(VAPRVNM,1,55),1,55)
+149 DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
+150 DO ADDITEM^PSOERX1A(.LINETXT,"DEA#: ",VAPRVDEA,30,20)
+151 DO ADDITEM^PSOERX1A(.LINETXT,"NPI: ",VAPRVNPI,57,20)
+152 SET LINE=LINE+1
DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
End DoDot:1
+153 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+154 SET ERXDRUG=$$GET1^DIQ(52.49,PSOIEN,3.1,"E")
IF '$LENGTH(ERXDRUG)
SET ERXDRUG=$$GETDRUG^PSOERXU5(PSOIEN)
+155 SET ERXQTY=$$GET1^DIQ(52.49,PSOIEN,5.1,"E")
+156 IF $GET(S2017)
Begin DoDot:1
+157 SET ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
End DoDot:1
+158 ;setting 10.6 refill value
+159 IF '$GET(S2017)
Begin DoDot:1
+160 SET ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
+161 IF ERXRFLS=""
SET ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.7,"I")
End DoDot:1
+162 ; refills for a refill response is # of refills-1
+163 IF MTYPE="RE"
IF ERXRFLS
SET ERXRFLS=ERXRFLS-1
+164 SET ERXDS=$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
+165 SET ERXDT=$$GET1^DIQ(52.49,PSOIEN,.03,"E")
+166 IF S2017
Begin DoDot:1
+167 SET ERXDT=$SELECT(MEDIEN:$$EFFDATE^PSOERXU5(PSOIEN,MEDIEN),1:"")
End DoDot:1
+168 SET VADRGIEN=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
+169 SET VADRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"E")
+170 SET VAREF=$$GET1^DIQ(52.49,PSOIEN,20.5,"E")
+171 ;PSO*7*635, Adjust va refills for renewal response messages
+172 IF MTYPE="RE"
IF VAREF
IF VAREF=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
SET VAREF=VAREF-1
+173 SET VAQTY=$$GET1^DIQ(52.49,PSOIEN,20.1,"E")
+174 SET VADAYS=$$GET1^DIQ(52.49,PSOIEN,20.2,"E")
+175 IF VADRG']""
SET VADRG="NOT LINKED"
+176 DO TXT2ARY^PSOERXD1(.DRGARY,ERXDRUG,,70)
+177 SET LINE=LINE+1
DO SET^VALM10(LINE,"eRx Drug: "_$GET(DRGARY(1))_" "_$PIECE($$ERXDRSCH^PSOERXUT(PSOIEN),"^",2))
+178 SET DLP=1
+179 FOR
SET DLP=$ORDER(DRGARY(DLP))
if 'DLP
QUIT
Begin DoDot:1
+180 SET LINE=LINE+1
DO SET^VALM10(LINE," "_$GET(DRGARY(DLP)))
End DoDot:1
+181 SET LINE=LINE+1
+182 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Qty: ",ERXQTY,1,17)
+183 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Refills: ",ERXRFLS,19,16)
+184 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Days Supply: ",ERXDS,37,20)
+185 IF 'S2017
DO ADDITEM^PSOERX1A(.LINETXT,"eRx Date: ",$PIECE(ERXDT,"@"),58,22)
+186 DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
+187 IF S2017
Begin DoDot:1
+188 SET LINE=LINE+1
+189 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Written Date: ",$PIECE(WDATE,"@"),1,35)
+190 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Issue Date: ",ERXDT,40,70)
+191 DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
+192 SET LINE=LINE+1
+193 IF MTYPE="N"!((MTYPE="CX")&$$PROHIBIT^PSOERX1D(RESPVAL,CHGMESRI))
Begin DoDot:2
+194 SET PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
+195 SET PROHIBIT=$SELECT(PROHIBIT=1:"Yes",1:"No")
+196 DO SET^VALM10(LINE,"Prohibit Renewals: "_PROHIBIT)
End DoDot:2
End DoDot:1
+197 DO TXT2ARY^PSOERXD1(.SIGARY,$GET(EDIRECT),,70)
+198 SET SFIRST=$ORDER(SIGARY(0))
+199 IF 'S2017
Begin DoDot:1
+200 SET SGLOOP=0
FOR
SET SGLOOP=$ORDER(SIGARY(SGLOOP))
if 'SGLOOP
QUIT
Begin DoDot:2
+201 SET LINE=LINE+1
DO SET^VALM10(LINE,$SELECT(SGLOOP=SFIRST:"eRx Sig: ",1:" ")_$GET(SIGARY(SGLOOP)))
End DoDot:2
End DoDot:1
+202 IF S2017
IF $GET(MEDIEN)
Begin DoDot:1
+203 SET LINE=LINE+1
DO SET^VALM10(LINE,"eRx Sig:")
+204 SET SGLOOP=0
FOR
SET SGLOOP=$ORDER(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP))
if 'SGLOOP
QUIT
Begin DoDot:2
+205 SET LINE=LINE+1
DO SET^VALM10(LINE,$GET(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP,0)))
End DoDot:2
End DoDot:1
+206 IF (",CX,CR,"[(","_MTYPE_","))
IF $$QTSUMDT2^PSOERX1D(PSOIEN,MTYPE,CHGMESRI,RESPVAL,.LINE)
SET VALMCNT=LINE
QUIT
+207 IF MTYPE="RR"
Begin DoDot:1
+208 ; if the renew request is 2017, use psoerxu7 to build from 311 subfile
+209 IF S2017
DO MEDDIS^PSOERXU7(PSOIEN,.LINE)
+210 ; if either of them are not 2017, build the med dispensed from PSOERXU7 (old 49 subfile)
+211 ; if it is not 2017, build from psoerxu3 (49 subfile)
+212 IF 'S2017
DO MEDDIS^PSOERXU3(PSOIEN,"D",.LINE)
+213 DO RRRES^PSOERXU3(PSOIEN,.LINE,1)
DO RRREQ^PSOERXU3(PSOIEN,.LINE)
DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
End DoDot:1
SET VALMCNT=LINE
QUIT
+214 IF MTYPE="RE"
Begin DoDot:1
+215 SET REQIEN=$$RESOLV^PSOERXU2(PSOIEN)
+216 SET R2017=$$GET1^DIQ(52.49,REQIEN,312.1,"I")
+217 DO DISPRX
DO RRRES^PSOERXU3(PSOIEN,.LINE,1)
+218 ; if the response is 2017 and the request is 2017, build the med dispensed from PSOERXU7 (311 subfile)
+219 IF S2017
IF R2017
DO MEDDIS^PSOERXU7(PSOIEN,.LINE)
+220 IF 'R2017
DO MEDDIS^PSOERXU3(REQIEN,"D",.LINE)
+221 DO RRREQ^PSOERXU3(PSOIEN,.LINE)
DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
+222 ; if the status is one of the failed status values, display the error details.
+223 IF $$GET1^DIQ(52.49,PSOIEN,1,"E")="RXF"
DO PROCERR^PSOERXU3(PSOIEN,.LINE)
End DoDot:1
SET VALMCNT=LINE
QUIT
+224 IF MTYPE="IE"
Begin DoDot:1
+225 SET RELIEN=$$RESOLV^PSOERXU2(PSOIEN)
+226 SET RELMTYPE=$$GET1^DIQ(52.49,RELIEN,.08,"I")
+227 IF RELMTYPE="RE"
DO ERRDISP^PSOERXU3(PSOIEN,.LINE)
DO RRREQ^PSOERXU3(PSOIEN,.LINE)
DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
QUIT
+228 IF RELMTYPE="CA"
DO ERRDISP^PSOERXU3(PSOIEN,.LINE)
DO CANREQ^PSOERXU5(PSOIEN,.LINE)
DO CANRES^PSOERXU5(PSOIEN,.LINE)
DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
QUIT
+229 IF RELMTYPE="CN"
DO ERRDISP^PSOERXU3(PSOIEN,.LINE)
DO CANRES^PSOERXU5(PSOIEN,.LINE)
DO CANREQ^PSOERXU5(PSOIEN,.LINE)
QUIT
+230 DO ERRDISP^PSOERXU3(PSOIEN,.LINE)
DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
End DoDot:1
SET VALMCNT=LINE
QUIT
+231 IF MTYPE="CA"
Begin DoDot:1
+232 DO CANREQ^PSOERXU5(PSOIEN,.LINE)
DO CANRES^PSOERXU5(PSOIEN,.LINE)
DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
End DoDot:1
SET VALMCNT=LINE
QUIT
+233 IF MTYPE="CN"
Begin DoDot:1
+234 IF $$GET1^DIQ(52.49,PSOIEN,1,"E")="CNE"
Begin DoDot:2
+235 SET ERRIEN=$$GETRESP^PSOERXU2(PSOIEN)
+236 DO ERRDISP^PSOERXU3(ERRIEN,.LINE)
DO CANRES^PSOERXU5(PSOIEN,.LINE)
DO CANREQ^PSOERXU5(PSOIEN,.LINE)
DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
QUIT
End DoDot:2
QUIT
+237 DO CANRES^PSOERXU5(PSOIEN,.LINE)
DO CANREQ^PSOERXU5(PSOIEN,.LINE)
DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
End DoDot:1
SET VALMCNT=LINE
QUIT
DISPRX ;
+1 IF "RR,CA,CN,IE"'[MTYPE!(MTYPE="N")
Begin DoDot:1
+2 IF MTYPE="RE"
IF $$GET1^DIQ(52.49,PSOIEN,52.1,"I")'="R"
QUIT
+3 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+4 ;p689
SET PSNF=""
IF $GET(VADRGIEN)
SET PSNF=$SELECT($PIECE(^PSDRUG(VADRGIEN,0),"^",9):"***(N/F)***",1:"")
+5 SET LINE=LINE+1
DO SET^VALM10(LINE,"Vista Drug"_$SELECT(DRMANVAL:"[v]",1:"")_": "_VADRG_" "_$PIECE($$VADRSCH^PSOERXUT(VADRGIEN),"^",3)_PSNF)
+6 SET LINE=LINE+1
+7 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Qty: ",$GET(VAQTY),1,25)
+8 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Refills: ",$GET(VAREF),27,18)
+9 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Days Supply: ",$GET(VADAYS),54,22)
+10 DO SET^VALM10(LINE,LINETXT)
SET LINETXT=""
+11 SET VASIG=""
+12 SET SLOOP=0
FOR
SET SLOOP=$ORDER(^PS(52.49,PSOIEN,"SIG",SLOOP))
if 'SLOOP
QUIT
Begin DoDot:2
+13 IF '$LENGTH($GET(VASIG))
SET VASIG=$GET(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
QUIT
+14 SET VASIG=$GET(VASIG)_" "_$GET(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
End DoDot:2
+15 DO TXT2ARY^PSOERXD1(.VASARY,VASIG,,68)
+16 SET FSSIG=$ORDER(VASARY(0))
+17 SET ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
+18 SET ERXDSUB=$SELECT(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
+19 SET LINE=LINE+1
DO SET^VALM10(LINE,"Substitutions? :"_ERXDSUB)
+20 SET LINE=LINE+1
DO SET^VALM10(LINE,"Vista Sig: "_$SELECT(FSSIG:$GET(VASARY(FSSIG)),1:""))
+21 SET SLOOP=1
FOR
SET SLOOP=$ORDER(VASARY(SLOOP))
if 'SLOOP
QUIT
Begin DoDot:2
+22 SET LINE=LINE+1
DO SET^VALM10(LINE," "_VASARY(SLOOP))
End DoDot:2
+23 SET VPATINST=$$GET1^DIQ(52.49,PSOIEN,27,"E")
+24 IF VPATINST]""
SET VPATINST=$$LSIG^PSOQUTIL(VPATINST)
+25 DO TXT2ARY^PSOERXD1(.VAPIARY,VPATINST," ",68)
+26 SET FSVPIN=$ORDER(VAPIARY(0))
+27 SET LINE=LINE+1
DO SET^VALM10(LINE," Pat Inst: "_$SELECT(FSVPIN:$GET(VAPIARY(FSVPIN)),1:""))
+28 SET VLOOP=1
FOR
SET VLOOP=$ORDER(VAPIARY(VLOOP))
if 'VLOOP
QUIT
Begin DoDot:2
+29 SET LINE=LINE+1
DO SET^VALM10(LINE," "_VAPIARY(VLOOP))
End DoDot:2
End DoDot:1
+30 SET LINE=LINE+1
DO SET^VALM10(LINE,"Hold Status: "_$GET(VAHSTA))
+31 SET VAHREA="Hold Reason: "_$GET(VAHREA)
+32 DO TXT2ARY^PSOERXD1(.HARY,VAHREA," ",80)
+33 SET HL=0
FOR
SET HL=$ORDER(HARY(HL))
if 'HL
QUIT
Begin DoDot:1
+34 SET LINE=LINE+1
DO SET^VALM10(LINE,$GET(HARY(HL)))
End DoDot:1
+35 SET LINE=LINE+1
DO SET^VALM10(LINE,"Placed on hold by: "_$GET(VAHPER))
+36 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+37 SET ERXCOMM="eRx Notes: "_$$GET1^DIQ(52.49,PSOIEN,8,"E")
+38 DO TXT2ARY^PSOERXD1(.COMARY,ERXCOMM," ",68)
+39 SET COM=0
FOR
SET COM=$ORDER(COMARY(COM))
if 'COM
QUIT
SET LINE=LINE+1
DO SET^VALM10(LINE,$GET(COMARY(COM)))
+40 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+41 IF $$GET1^DIQ(52.49,PSOIEN,.05,"I")
Begin DoDot:1
+42 DO ALG^PSOERXU1(.LINE)
End DoDot:1
+43 IF '$GET(S2017)
Begin DoDot:1
+44 DO DIAG^PSOERXU1(PSOIEN,.LINE)
End DoDot:1
+45 IF $GET(S2017)
Begin DoDot:1
+46 if MEDIEN
DO DIAG2017^PSOERXU5(PSOIEN,.LINE,,MEDIEN)
End DoDot:1
+47 ; DEA Note for CS Digitally Signed eRx records
+48 IF $$GET1^DIQ(52.49,PSOIEN,95.1,"I")
Begin DoDot:1
+49 DO DEANOTE^PSOERX1H
End DoDot:1
+50 ;
+51 SET VALMCNT=LINE
+52 QUIT
