- PSOERSE2 ;ALB/RM - PSO ERX SINGLE ERX DISPLAY INIT section ;Jan 30, 2024@12:43:34
- ;;7.0;OUTPATIENT PHARMACY;**746**;DEC 16, 1997;Build 106
- ;
- INIT(PSOIEN,SDERXFLG) ;Clone of PSOERX1G routine, but it will only be processed solely for the PSO ERX SINGLE ERX DISPLAY.
- ;Input: PSOIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- ; (o)SDERXFLG - Single eRx View/Display Flag - 1: Single eRx View/Display SIDE-BY-SIDE Format | 0: NOT SIDE-BY-SIDE Format
- N PATIEN,PHARMIEN,PRVIEN,PHDAT,PATDAT,SUPDAT,PRVDAT,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,SIG311AR
- 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,DDASH,ERXDRG1,ERXDSIG,ERXFIRST,ERXLAST,ERXPNC,ERXPNARY,PNLOOP
- S $P(DDASH,"_",81)=""
- 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 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")
- I S2017 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:$$DEA^XUSER(0,VAPRVIEN,ERXWRDT),1:"N/A")
- 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")
- 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 $G(MEDIEN) D
- . . S ERXPNC=$$GET1^DIQ(52.49311,MEDIEN_","_PSOIEN_",",5) ;retrieved provider notes/comments
- . . K ERXPNARY D TXT2ARY^PSOERXD1(.ERXPNARY,$G(ERXPNC),,80)
- I S2017,MTYPE="RE" S MEDIEN=$O(^PS(52.49,PSOIEN,311,"C","MR",0))
- I 'S2017 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=""
- I $$GET1^DIQ(52.49,PSOIEN,95.1,"I") S $E(MTYPEE,63)="EPCS DEA VALIDATED" ;controlled substance indicator
- S ERXSTATSD=MTYPEE_"^"_$S($E(CURSTATE,1)="H":VAHSTA,1:ERXSTAT)
- I $G(SDERXFLG) Q ;only needed the header data for single erx view/display mode side-by-side format
- I ",RR,RE,IE,OE,CA,CN,CX,CR,"[(","_MTYPE_",") S SDERXFLG=1 ;display the single erx as is (not side-by-side format)
- 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)
- . 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)]"" D
- . S LINE=LINE+1
- . S CSCOMM=$P(CSCOMM,",",1,2)_", Refills Rem.:"_$P($P(CSCOMM,",",3),":",2)
- . D SET^VALM10(LINE,"Current Status Details: "_CSCOMM)
- . S ERXFIRST=$P($P(CSCOMM,","),":",2),ERXLAST=$P($P(CSCOMM,",",2),":",2)
- . D CNTRL^VALM10(LINE,36,$L(ERXFIRST),IOINHI,IOINORM) ;First Fill video display
- . D CNTRL^VALM10(LINE,55,$L(ERXLAST),IOINHI,IOINORM) ;Last Fill video display
- . D CNTRL^VALM10(LINE,76,7,IOINHI,IOINORM) ;Refills Remaining video display
- I $D(LERXSTAT) S LINE=LINE+1 D SET^VALM10(LINE,"Last New Rx status: "_LERXSTAT),CNTRL^VALM10(LINE,21,$L(LERXSTAT),IOINHI,IOINORM)
- I $D(LOPSTAT) S LINE=LINE+1 D SET^VALM10(LINE,"Outpatient Prescription status: "_LOPSTAT),CNTRL^VALM10(LINE,33,$L(LOPSTAT),IOINHI,IOINORM)
- I (",RR,RE,CR,"[MTYPE)!((MTYPE="CX")&$$ADMDPRLN^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI,1)) D
- . I $D(@VALMAR@(LINE)) S LINE=LINE+1
- . D SET^VALM10(LINE," MEDICATION PRESCRIBED ")
- . D CNTRL^VALM10(LINE,1,80,IOUON_IOINHI,IOUOFF_IOINORM)
- I 'ERRFLG,$L($G(PATPT)) S LINE=LINE+1 D SET^VALM10(LINE,"eRx Patient Primary Telephone: "_PATPT),CNTRL^VALM10(LINE,32,$L(PATPT),IOINHI,IOINORM)
- D ADDITEM^PSOERX1A(.LINETXT,"eRx Patient: ",$E(EPAT,1,53),1,65)
- D ADDITEM^PSOERX1A(.LINETXT,"DOB: ",EPATDOB,67,20)
- S LINE=LINE+1 D SET^VALM10(LINE,LINETXT) S LINETXT=""
- D CNTRL^VALM10(LINE,$L("eRx Patient: "),45,IOINHI,IOINORM)
- D CNTRL^VALM10(LINE,73,10,IOINHI,IOINORM) ;this is for the eRx DOB
- S LINETXT=""
- I MTYPE'="CA",MTYPE'="CN" D
- . D ADDITEM^PSOERX1A(.LINETXT,"Vista Patient"_$S(PAMANVAL:"[v]",1:"")_": ",$E(VPATNM,1,48),1,66)
- . D ADDITEM^PSOERX1A(.LINETXT,"DOB: ",VPATDOB,67,20)
- . S LINE=LINE+1 D SET^VALM10(LINE,LINETXT)
- . D CNTRL^VALM10(LINE,$S(LINETXT["[v]":19,1:16),48,IOINHI,IOINORM) ;Vista Patient video display
- . D CNTRL^VALM10(LINE,73,20,IOINHI,IOINORM) ;DOB video display
- . S LINETXT=""
- S LINE=LINE+1 D SET^VALM10(LINE,DDASH)
- I $L($G(EPRVPT)) S LINE=LINE+1 D SET^VALM10(LINE,"eRx Provider Primary Telephone: "_EPRVPT),CNTRL^VALM10(LINE,33,$L(EPRVPT),IOINHI,IOINORM)
- D ADDITEM^PSOERX1A(.LINETXT,"eRx Provider: ",$E(EPRVNM,1,34),1,52)
- D ADDITEM^PSOERX1A(.LINETXT,"DEA#: ",EPRVDEA,49,20)
- D ADDITEM^PSOERX1A(.LINETXT,"NPI: ",EPRVNPI,65,20)
- S LINE=LINE+1 D SET^VALM10(LINE,LINETXT)
- I EPRVNM'="" D CNTRL^VALM10(LINE,15,34,IOINHI,IOINORM)
- I EPRVDEA'="" D CNTRL^VALM10(LINE,56,$L(EPRVDEA),IOINHI,IOINORM) ;DEA# video display
- I EPRVNPI'="" D CNTRL^VALM10(LINE,71,$L(EPRVNPI),IOINHI,IOINORM) ;NPI video display
- S LINETXT=""
- I MTYPE'="CA",MTYPE'="CN" D
- . D ADDITEM^PSOERX1A(.LINETXT,"Vista Provider"_$S(PRMANVAL:"[v]",1:"")_": ",$E(VAPRVNM,1,34),1,55)
- . D ADDITEM^PSOERX1A(.LINETXT,"DEA#: ",VAPRVDEA,49,20)
- . D ADDITEM^PSOERX1A(.LINETXT,"NPI: ",VAPRVNPI,65,20)
- . S LINE=LINE+1 D SET^VALM10(LINE,LINETXT)
- . I VAPRVNM'="" D CNTRL^VALM10(LINE,$S(LINETXT["[v]":20,1:17),30,IOINHI,IOINORM) ;Vista Provider video display
- . I VAPRVDEA'="" D CNTRL^VALM10(LINE,$S(LINETXT["[v]":56,1:55),9,IOINHI,IOINORM) ;DEA# video display
- . I VAPRVNPI'="" D CNTRL^VALM10(LINE,$S(LINETXT["[v]":71,1:70),20,IOINHI,IOINORM) ;NPI video display
- . S LINETXT=""
- S LINE=LINE+1 D SET^VALM10(LINE,DDASH)
- I (MTYPE="CX")!(MTYPE="RE") D DSPLYDUE^PSOERSE3(PSOIEN,.LINE) S LINE=LINE+1 D SET^VALM10(LINE,DDASH) ;display the Prescriber Drug Use Evaluation.
- 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) S ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
- 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")
- 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 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")
- 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 ERXDRG1=$G(DRGARY(1))_" "_$P($$ERXDRSCH^PSOERXUT(PSOIEN),"^",2)
- S LINE=LINE+1 D SET^VALM10(LINE,"eRx Drug: "_ERXDRG1),CNTRL^VALM10(LINE,11,$L(ERXDRG1),IOINHI,IOINORM)
- S DLP=1
- F S DLP=$O(DRGARY(DLP)) Q:'DLP D
- . S LINE=LINE+1 D SET^VALM10(LINE," "_$G(DRGARY(DLP))),CNTRL^VALM10(LINE,11,$L($G(DRGARY(DLP))),IOINHI,IOINORM)
- 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)
- S LINE=LINE+1 D SET^VALM10(LINE,LINETXT) S LINETXT=""
- D CNTRL^VALM10(LINE,9,10,IOINHI,IOINORM) ;eRx Qty video display
- D CNTRL^VALM10(LINE,32,5,IOINHI,IOINORM) ;eRx Refills video display
- D CNTRL^VALM10(LINE,54,5,IOINHI,IOINORM) ;eRx Days Supply video display
- I 'S2017 D CNTRL^VALM10(LINE,68,20,IOINHI,IOINORM) ;eRx Date video display
- I S2017 D
- . D ADDITEM^PSOERX1A(.LINETXT,"eRx Written Date: ",$P(WDATE,"@"),1,35)
- . D ADDITEM^PSOERX1A(.LINETXT,"eRx Issue Date: ",ERXDT,40,70)
- . S LINE=LINE+1 D SET^VALM10(LINE,LINETXT)
- . D CNTRL^VALM10(LINE,18,13,IOINHI,IOINORM) ;eRx Days Supply video display
- . D CNTRL^VALM10(LINE,56,13,IOINHI,IOINORM) ;eRx Days Supply video display
- . S LINETXT=""
- . 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")
- . . S LINE=LINE+1 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:$J("",9))_$G(SIGARY(SGLOOP))),CNTRL^VALM10(LINE,9,$L($G(SIGARY(SGLOOP)))+1,IOINHI,IOINORM)
- I S2017,$G(MEDIEN) D
- . S ERXDSIG=""
- . S SGLOOP=0 F S SGLOOP=$O(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP)) Q:'SGLOOP S ERXDSIG=ERXDSIG_$G(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP,0))_" "
- . D TXT2ARY^PSOERXD1(.SIG311AR,$G(ERXDSIG),,70)
- . S SGLOOP=0 F S SGLOOP=$O(SIG311AR(SGLOOP)) Q:'SGLOOP D
- . . S LINE=LINE+1 D SET^VALM10(LINE,$S(SGLOOP=1:"eRx Sig: ",1:$J("",9))_SIG311AR(SGLOOP)),CNTRL^VALM10(LINE,9,$L(SIG311AR(SGLOOP))+1,IOINHI,IOINORM)
- . S LINE=LINE+1 D SET^VALM10(LINE,"eRx Provider Notes/Comments:")
- . I $D(ERXPNARY) D
- . . S PNLOOP=0 F S PNLOOP=$O(ERXPNARY(PNLOOP)) Q:'PNLOOP D
- . . . S LINE=LINE+1 D SET^VALM10(LINE,$G(ERXPNARY(PNLOOP))),CNTRL^VALM10(LINE,1,$L($G(ERXPNARY(PNLOOP)))+1,IOINHI,IOINORM)
- I (",CX,CR,"[(","_MTYPE_",")),$$QTSUMDT2^PSOERX1D(PSOIEN,MTYPE,CHGMESRI,RESPVAL,.LINE) S VALMCNT=LINE Q
- I MTYPE="RR" D S VALMCNT=LINE Q
- . I S2017 D MEDDIS^PSOERXU7(PSOIEN,.LINE)
- . 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)
- . 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)
- . 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 ;
- D DISPRX^PSOERSE3
- S VALMCNT=LINE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERSE2 15329 printed Apr 23, 2025@18:42:24 Page 2
- PSOERSE2 ;ALB/RM - PSO ERX SINGLE ERX DISPLAY INIT section ;Jan 30, 2024@12:43:34
- +1 ;;7.0;OUTPATIENT PHARMACY;**746**;DEC 16, 1997;Build 106
- +2 ;
- INIT(PSOIEN,SDERXFLG) ;Clone of PSOERX1G routine, but it will only be processed solely for the PSO ERX SINGLE ERX DISPLAY.
- +1 ;Input: PSOIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
- +2 ; (o)SDERXFLG - Single eRx View/Display Flag - 1: Single eRx View/Display SIDE-BY-SIDE Format | 0: NOT SIDE-BY-SIDE Format
- +3 NEW PATIEN,PHARMIEN,PRVIEN,PHDAT,PATDAT,SUPDAT,PRVDAT,PRVLNM,PRVMI,PRVFN,EPAT,EPATDOB,VPATIEN,HARY,HL,PROHIBIT,ERXWRDT
- +4 NEW VPATNM,VPATDOB,EPRVIEN,EPRVNM,EPRVNPI,EPRVDEA,VAPRVIEN,VAPRVNM,VAPRVNPI,VAPRVDEA,SUPIEN,ERXDRUG,ERXQTY,ERXFLS,CSCOMM,MEDIEN
- +5 NEW ERXDS,ERXDT,VADRGIEN,VADRG,LINETXT,ERXCOMM,ERXRFLS,PATIENS,VAHREA,VAQTY,VAREF,VASIG,PATDAT,CURSTATE,CURSTATI,WDATE,RRNRXIEN
- +6 NEW LHFOUND,LHMATCH,LHSTATI,VAPDEAEX,ERXCOMM,COMFRST,COMARY,SIGDATA,SIGLOOP,SFIRSPROT,SGLOOP,SIGARY,VADAYS,NRXIEN,SIG311AR
- +7 NEW SLOOP,VASIG,VASARY,FSSIG,VAHSTA,EDIRECT,VAHPER,PAMANVAL,DRMANVAL,PRMANVAL,VPATINST,VAPIARY,VLOOP,FSVPIN,S2017,NEWRXIEN
- +8 NEW DRGARY,DLP,MTYPE,MTYPEE,ERXSTAT,STATIEN,PDIAGTXT,SDIAGTXT,RELIEN,RELMTYPE,ERRIEN,LERXSTAT,LOPSTAT,OPIEN,ERXDSUB,COM,EXSTATUS,R2017,REQIEN
- +9 NEW SFIRST,PATPT,EPRVPT,CIEN,CHGMESRI,CHGMESRQ,NO311,RESPVAL,ERRFLG,PSNF,DDASH,ERXDRG1,ERXDSIG,ERXFIRST,ERXLAST,ERXPNC,ERXPNARY,PNLOOP
- +10 SET $PIECE(DDASH,"_",81)=""
- +11 SET S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
- +12 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
- +13 SET MTYPEE=$$GET1^DIQ(52.49,PSOIEN,.08,"E")
- +14 SET STATIEN=$$GET1^DIQ(52.49,PSOIEN,1,"I")
- +15 SET ERXSTAT=$$GET1^DIQ(52.45,STATIEN,.02,"E")
- +16 IF MTYPE="IE"
- Begin DoDot:1
- +17 IF ",ERROR,CANCEL RESPONSE/INBOUND ERROR,"[(","_ERXSTAT_",")
- SET ERRFLG=1
- QUIT
- +18 IF ",RXCHANGE REQUEST ERROR,RXRENEWAL REQUEST ERROR,"[(","_ERXSTAT_",")
- SET ERRFLG=1
- QUIT
- +19 IF ",INBOUND RXCHANGE ERROR ACKNOWLEDGED,INBOUND RXRENEWAL ERROR ACKNOWLEDGED,"[(","_ERXSTAT_",")
- SET ERRFLG=1
- QUIT
- +20 SET ERRFLG=0
- End DoDot:1
- +21 IF MTYPE'="IE"
- SET ERRFLG=0
- +22 SET PATIEN=$$GET1^DIQ(52.49,PSOIEN,.04,"I")
- IF 'PATIEN
- SET PATIEN=$$GETPAT^PSOERXU5(PSOIEN)
- +23 SET PATIENS=PATIEN_","
- +24 DO GETS^DIQ(52.46,PATIENS,"**","IE","PATDAT")
- +25 IF 'ERRFLG
- Begin DoDot:1
- +26 SET EPAT=$GET(PATDAT(52.46,PATIENS,.01,"E"))
- +27 SET EPATDOB=$GET(PATDAT(52.46,PATIENS,.08,"I"))
- SET EPATDOB=$$FMTE^XLFDT(EPATDOB,"2D")
- End DoDot:1
- +28 IF ERRFLG
- SET (EPAT,EPATDOB)=""
- +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 IF S2017
- SET EPRVPT=$$COMMVAL^PSOERXU5(EPRVIEN,52.48,11,"PT",1)
- +38 IF 'S2017
- Begin DoDot:1
- +39 NEW IENS,TYPE,EXT
- +40 SET EPRVPT=""
- SET CIEN=$ORDER(^PS(52.48,EPRVIEN,3,"C","TE",0))
- +41 IF CIEN
- Begin DoDot:2
- +42 SET IENS=CIEN_","_EPRVIEN_","
- +43 SET EPRVPT=$$GET1^DIQ(52.483,IENS,.01,"I")
- End DoDot:2
- +44 IF 'CIEN
- Begin DoDot:2
- +45 SET CIEN=0
- +46 FOR
- SET CIEN=$ORDER(^PS(52.48,EPRVIEN,3,CIEN))
- if CIEN'?1.N
- QUIT
- Begin DoDot:3
- +47 SET IENS=CIEN_","_EPRVIEN_","
- +48 SET EPRVPT=$$GET1^DIQ(52.483,IENS,.01,"I")
- +49 SET TYPE=$$GET1^DIQ(52.483,IENS,.02,"I")
- +50 if TYPE="EM"
- SET EPRVPT=""
- End DoDot:3
- if EPRVPT]""
- QUIT
- End DoDot:2
- +51 IF EPRVPT]""
- Begin DoDot:2
- +52 SET EXT=$$GET1^DIQ(52.483,IENS,.03,"I")
- +53 if EXT]""
- SET EPRVPT=EPRVPT_"X"_EXT
- End DoDot:2
- End DoDot:1
- +54 IF 'S2017
- SET EPRVNPI=$$GET1^DIQ(52.48,EPRVIEN,1.5,"E")
- +55 IF S2017
- SET EPRVNPI=$$GET1^DIQ(52.48,EPRVIEN,15.1,"E")
- +56 SET EPRVDEA=$$GET1^DIQ(52.48,EPRVIEN,1.6,"E")
- +57 SET VAPRVIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I")
- +58 SET ERXWRDT=$$GET1^DIQ(52.49,PSOIEN,5.9,"I")
- +59 SET VAPRVNM=$SELECT(VAPRVIEN:$$GET1^DIQ(200,VAPRVIEN,.01,"E"),1:"NOT LINKED")
- +60 SET VAPRVNPI=$SELECT(VAPRVIEN:$$GET1^DIQ(200,VAPRVIEN,41.99,"E"),1:"N/A")
- +61 SET VAPRVDEA=$SELECT(VAPRVIEN:$$DEA^XUSER(0,VAPRVIEN,ERXWRDT),1:"N/A")
- +62 DO GETS^DIQ(52.48,EPRVIEN,"**","E","PRVDAT")
- +63 SET SUPIEN=$$GET1^DIQ(52.49,PSOIEN,2.6,"I")
- +64 DO GETS^DIQ(52.48,SUPIEN,"**","E","SUPDAT")
- +65 SET PAMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.7,"I")
- +66 SET PRMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.3,"I")
- +67 SET DRMANVAL=$$GET1^DIQ(52.49,PSOIEN,1.5,"I")
- +68 SET WDATE=$$GET1^DIQ(52.49,PSOIEN,5.9,"E")
- +69 SET CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
- +70 SET CHGMESRI=$$GET1^DIQ(52.45,CHGMESRQ,.01,"I")
- +71 SET RESPVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
- +72 if 'ERRFLG
- SET PATPT=$$GETPTPH^PSOERXU7(PATIEN,S2017,"PT,HP")
- +73 SET CURSTATE=$$GET1^DIQ(52.49,PSOIEN,1,"E")
- +74 SET (VAHSTA,VAHREA)=""
- +75 IF S2017
- IF MTYPE'="RE"
- Begin DoDot:1
- +76 SET MEDIEN=$ORDER(^PS(52.49,PSOIEN,311,"C","P",0))
- +77 SET EDIRECT=$$GET1^DIQ(52.49,MEDIEN_","_PSOIEN_",",8,"E")
- +78 IF $GET(MEDIEN)
- Begin DoDot:2
- +79 ;retrieved provider notes/comments
- SET ERXPNC=$$GET1^DIQ(52.49311,MEDIEN_","_PSOIEN_",",5)
- +80 KILL ERXPNARY
- DO TXT2ARY^PSOERXD1(.ERXPNARY,$GET(ERXPNC),,80)
- End DoDot:2
- End DoDot:1
- +81 IF S2017
- IF MTYPE="RE"
- SET MEDIEN=$ORDER(^PS(52.49,PSOIEN,311,"C","MR",0))
- +82 IF 'S2017
- SET EDIRECT=$$GET1^DIQ(52.49,PSOIEN,7,"E")
- +83 IF $EXTRACT(CURSTATE,1)="H"
- Begin DoDot:1
- +84 SET CURSTATI=$$GET1^DIQ(52.49,PSOIEN,1,"I")
- +85 SET LHMATCH=999999
- SET LHFOUND=0
- FOR
- SET LHMATCH=$ORDER(^PS(52.49,PSOIEN,19,LHMATCH),-1)
- if 'LHMATCH!(LHFOUND)
- QUIT
- Begin DoDot:2
- +86 SET LHSTATI=$$GET1^DIQ(52.4919,LHMATCH_","_PSOIEN_",",.02,"I")
- IF LHSTATI=CURSTATI
- Begin DoDot:3
- +87 SET VAHREA=$$GET1^DIQ(52.4919,LHMATCH_","_PSOIEN_",",1)
- +88 SET VAHSTA=$$GET1^DIQ(52.45,LHSTATI,.01,"E")_" - "_$$GET1^DIQ(52.45,LHSTATI,.02,"E")
- +89 SET VAHPER=$$GET1^DIQ(52.4919,LHMATCH_","_PSOIEN_",",.03,"E")
- End DoDot:3
- SET LHFOUND=LHMATCH
- QUIT
- End DoDot:2
- End DoDot:1
- +90 IF (",RE,CN,"[(","_MTYPE_","))!((MTYPE="CX")&$$CHGMTYPE^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI))
- SET MTYPEE=$GET(MTYPEE)_" - "_$$GET1^DIQ(52.49,PSOIEN,52.1,"E")
- +91 SET LINETXT=""
- +92 ;controlled substance indicator
- IF $$GET1^DIQ(52.49,PSOIEN,95.1,"I")
- SET $EXTRACT(MTYPEE,63)="EPCS DEA VALIDATED"
- +93 SET ERXSTATSD=MTYPEE_"^"_$SELECT($EXTRACT(CURSTATE,1)="H":VAHSTA,1:ERXSTAT)
- +94 ;only needed the header data for single erx view/display mode side-by-side format
- IF $GET(SDERXFLG)
- QUIT
- +95 ;display the single erx as is (not side-by-side format)
- IF ",RR,RE,IE,OE,CA,CN,CX,CR,"[(","_MTYPE_",")
- SET SDERXFLG=1
- +96 IF ",CX,CR,"[(","_MTYPE_",")
- IF $$QTSUMDT1^PSOERX1D(PSOIEN,MTYPE,CHGMESRI,CHGMESRQ,RESPVAL,.LINE)
- SET VALMCNT=LINE
- QUIT
- +97 IF MTYPE="CA"
- Begin DoDot:1
- +98 SET NRXIEN=$$RESOLV^PSOERXU2(PSOIEN)
- if 'NRXIEN
- QUIT
- +99 SET LERXSTAT=$$LASTSTAT^PSOERXU5(NRXIEN)
- +100 IF '$LENGTH(LERXSTAT)
- SET LERXSTAT="N - NEW"
- +101 SET OPIEN=$$GET1^DIQ(52.49,NRXIEN,.13,"I")
- if 'OPIEN
- QUIT
- +102 SET LOPSTAT=$$GET1^DIQ(52,OPIEN,100,"E")
- +103 IF NRXIEN
- SET CSCOMM=$$CSCOMM^PSOERXU5(NRXIEN)
- End DoDot:1
- +104 IF MTYPE="CN"
- Begin DoDot:1
- +105 SET RELIEN=$$RESOLV^PSOERXU2(PSOIEN)
- if 'RELIEN
- QUIT
- +106 SET NRXIEN=$$RESOLV^PSOERXU2(RELIEN)
- +107 SET LERXSTAT=$$LASTSTAT^PSOERXU5(NRXIEN)
- +108 IF NRXIEN
- SET CSCOMM=$$CSCOMM^PSOERXU5(NRXIEN)
- +109 IF '$LENGTH(LERXSTAT)
- SET LERXSTAT="N - NEW"
- +110 SET OPIEN=$$GET1^DIQ(52.49,NRXIEN,.13,"I")
- if 'OPIEN
- QUIT
- +111 SET LOPSTAT=$$GET1^DIQ(52,OPIEN,100,"E")
- End DoDot:1
- +112 IF $GET(CSCOMM)]""
- Begin DoDot:1
- +113 SET LINE=LINE+1
- +114 SET CSCOMM=$PIECE(CSCOMM,",",1,2)_", Refills Rem.:"_$PIECE($PIECE(CSCOMM,",",3),":",2)
- +115 DO SET^VALM10(LINE,"Current Status Details: "_CSCOMM)
- +116 SET ERXFIRST=$PIECE($PIECE(CSCOMM,","),":",2)
- SET ERXLAST=$PIECE($PIECE(CSCOMM,",",2),":",2)
- +117 ;First Fill video display
- DO CNTRL^VALM10(LINE,36,$LENGTH(ERXFIRST),IOINHI,IOINORM)
- +118 ;Last Fill video display
- DO CNTRL^VALM10(LINE,55,$LENGTH(ERXLAST),IOINHI,IOINORM)
- +119 ;Refills Remaining video display
- DO CNTRL^VALM10(LINE,76,7,IOINHI,IOINORM)
- End DoDot:1
- +120 IF $DATA(LERXSTAT)
- SET LINE=LINE+1
- DO SET^VALM10(LINE,"Last New Rx status: "_LERXSTAT)
- DO CNTRL^VALM10(LINE,21,$LENGTH(LERXSTAT),IOINHI,IOINORM)
- +121 IF $DATA(LOPSTAT)
- SET LINE=LINE+1
- DO SET^VALM10(LINE,"Outpatient Prescription status: "_LOPSTAT)
- DO CNTRL^VALM10(LINE,33,$LENGTH(LOPSTAT),IOINHI,IOINORM)
- +122 IF (",RR,RE,CR,"[MTYPE)!((MTYPE="CX")&$$ADMDPRLN^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI,1))
- Begin DoDot:1
- +123 IF $DATA(@VALMAR@(LINE))
- SET LINE=LINE+1
- +124 DO SET^VALM10(LINE," MEDICATION PRESCRIBED ")
- +125 DO CNTRL^VALM10(LINE,1,80,IOUON_IOINHI,IOUOFF_IOINORM)
- End DoDot:1
- +126 IF 'ERRFLG
- IF $LENGTH($GET(PATPT))
- SET LINE=LINE+1
- DO SET^VALM10(LINE,"eRx Patient Primary Telephone: "_PATPT)
- DO CNTRL^VALM10(LINE,32,$LENGTH(PATPT),IOINHI,IOINORM)
- +127 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Patient: ",$EXTRACT(EPAT,1,53),1,65)
- +128 DO ADDITEM^PSOERX1A(.LINETXT,"DOB: ",EPATDOB,67,20)
- +129 SET LINE=LINE+1
- DO SET^VALM10(LINE,LINETXT)
- SET LINETXT=""
- +130 DO CNTRL^VALM10(LINE,$LENGTH("eRx Patient: "),45,IOINHI,IOINORM)
- +131 ;this is for the eRx DOB
- DO CNTRL^VALM10(LINE,73,10,IOINHI,IOINORM)
- +132 SET LINETXT=""
- +133 IF MTYPE'="CA"
- IF MTYPE'="CN"
- Begin DoDot:1
- +134 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Patient"_$SELECT(PAMANVAL:"[v]",1:"")_": ",$EXTRACT(VPATNM,1,48),1,66)
- +135 DO ADDITEM^PSOERX1A(.LINETXT,"DOB: ",VPATDOB,67,20)
- +136 SET LINE=LINE+1
- DO SET^VALM10(LINE,LINETXT)
- +137 ;Vista Patient video display
- DO CNTRL^VALM10(LINE,$SELECT(LINETXT["[v]":19,1:16),48,IOINHI,IOINORM)
- +138 ;DOB video display
- DO CNTRL^VALM10(LINE,73,20,IOINHI,IOINORM)
- +139 SET LINETXT=""
- End DoDot:1
- +140 SET LINE=LINE+1
- DO SET^VALM10(LINE,DDASH)
- +141 IF $LENGTH($GET(EPRVPT))
- SET LINE=LINE+1
- DO SET^VALM10(LINE,"eRx Provider Primary Telephone: "_EPRVPT)
- DO CNTRL^VALM10(LINE,33,$LENGTH(EPRVPT),IOINHI,IOINORM)
- +142 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Provider: ",$EXTRACT(EPRVNM,1,34),1,52)
- +143 DO ADDITEM^PSOERX1A(.LINETXT,"DEA#: ",EPRVDEA,49,20)
- +144 DO ADDITEM^PSOERX1A(.LINETXT,"NPI: ",EPRVNPI,65,20)
- +145 SET LINE=LINE+1
- DO SET^VALM10(LINE,LINETXT)
- +146 IF EPRVNM'=""
- DO CNTRL^VALM10(LINE,15,34,IOINHI,IOINORM)
- +147 ;DEA# video display
- IF EPRVDEA'=""
- DO CNTRL^VALM10(LINE,56,$LENGTH(EPRVDEA),IOINHI,IOINORM)
- +148 ;NPI video display
- IF EPRVNPI'=""
- DO CNTRL^VALM10(LINE,71,$LENGTH(EPRVNPI),IOINHI,IOINORM)
- +149 SET LINETXT=""
- +150 IF MTYPE'="CA"
- IF MTYPE'="CN"
- Begin DoDot:1
- +151 DO ADDITEM^PSOERX1A(.LINETXT,"Vista Provider"_$SELECT(PRMANVAL:"[v]",1:"")_": ",$EXTRACT(VAPRVNM,1,34),1,55)
- +152 DO ADDITEM^PSOERX1A(.LINETXT,"DEA#: ",VAPRVDEA,49,20)
- +153 DO ADDITEM^PSOERX1A(.LINETXT,"NPI: ",VAPRVNPI,65,20)
- +154 SET LINE=LINE+1
- DO SET^VALM10(LINE,LINETXT)
- +155 ;Vista Provider video display
- IF VAPRVNM'=""
- DO CNTRL^VALM10(LINE,$SELECT(LINETXT["[v]":20,1:17),30,IOINHI,IOINORM)
- +156 ;DEA# video display
- IF VAPRVDEA'=""
- DO CNTRL^VALM10(LINE,$SELECT(LINETXT["[v]":56,1:55),9,IOINHI,IOINORM)
- +157 ;NPI video display
- IF VAPRVNPI'=""
- DO CNTRL^VALM10(LINE,$SELECT(LINETXT["[v]":71,1:70),20,IOINHI,IOINORM)
- +158 SET LINETXT=""
- End DoDot:1
- +159 SET LINE=LINE+1
- DO SET^VALM10(LINE,DDASH)
- +160 ;display the Prescriber Drug Use Evaluation.
- IF (MTYPE="CX")!(MTYPE="RE")
- DO DSPLYDUE^PSOERSE3(PSOIEN,.LINE)
- SET LINE=LINE+1
- DO SET^VALM10(LINE,DDASH)
- +161 SET ERXDRUG=$$GET1^DIQ(52.49,PSOIEN,3.1,"E")
- IF '$LENGTH(ERXDRUG)
- SET ERXDRUG=$$GETDRUG^PSOERXU5(PSOIEN)
- +162 SET ERXQTY=$$GET1^DIQ(52.49,PSOIEN,5.1,"E")
- +163 IF $GET(S2017)
- SET ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
- +164 IF '$GET(S2017)
- Begin DoDot:1
- +165 SET ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
- +166 IF ERXRFLS=""
- SET ERXRFLS=$$GET1^DIQ(52.49,PSOIEN,5.7,"I")
- End DoDot:1
- +167 IF MTYPE="RE"
- IF ERXRFLS
- SET ERXRFLS=ERXRFLS-1
- +168 SET ERXDS=$$GET1^DIQ(52.49,PSOIEN,5.5,"E")
- +169 SET ERXDT=$$GET1^DIQ(52.49,PSOIEN,.03,"E")
- +170 IF S2017
- SET ERXDT=$SELECT(MEDIEN:$$EFFDATE^PSOERXU5(PSOIEN,MEDIEN),1:"")
- +171 SET VADRGIEN=$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
- +172 SET VADRG=$$GET1^DIQ(52.49,PSOIEN,3.2,"E")
- +173 SET VAREF=$$GET1^DIQ(52.49,PSOIEN,20.5,"E")
- +174 IF MTYPE="RE"
- IF VAREF
- IF VAREF=$$GET1^DIQ(52.49,PSOIEN,5.6,"E")
- SET VAREF=VAREF-1
- +175 SET VAQTY=$$GET1^DIQ(52.49,PSOIEN,20.1,"E")
- +176 SET VADAYS=$$GET1^DIQ(52.49,PSOIEN,20.2,"E")
- +177 IF VADRG']""
- SET VADRG="NOT LINKED"
- +178 DO TXT2ARY^PSOERXD1(.DRGARY,ERXDRUG,,70)
- +179 SET ERXDRG1=$GET(DRGARY(1))_" "_$PIECE($$ERXDRSCH^PSOERXUT(PSOIEN),"^",2)
- +180 SET LINE=LINE+1
- DO SET^VALM10(LINE,"eRx Drug: "_ERXDRG1)
- DO CNTRL^VALM10(LINE,11,$LENGTH(ERXDRG1),IOINHI,IOINORM)
- +181 SET DLP=1
- +182 FOR
- SET DLP=$ORDER(DRGARY(DLP))
- if 'DLP
- QUIT
- Begin DoDot:1
- +183 SET LINE=LINE+1
- DO SET^VALM10(LINE," "_$GET(DRGARY(DLP)))
- DO CNTRL^VALM10(LINE,11,$LENGTH($GET(DRGARY(DLP))),IOINHI,IOINORM)
- End DoDot:1
- +184 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Qty: ",ERXQTY,1,17)
- +185 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Refills: ",ERXRFLS,19,16)
- +186 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Days Supply: ",ERXDS,37,20)
- +187 IF 'S2017
- DO ADDITEM^PSOERX1A(.LINETXT,"eRx Date: ",$PIECE(ERXDT,"@"),58,22)
- +188 SET LINE=LINE+1
- DO SET^VALM10(LINE,LINETXT)
- SET LINETXT=""
- +189 ;eRx Qty video display
- DO CNTRL^VALM10(LINE,9,10,IOINHI,IOINORM)
- +190 ;eRx Refills video display
- DO CNTRL^VALM10(LINE,32,5,IOINHI,IOINORM)
- +191 ;eRx Days Supply video display
- DO CNTRL^VALM10(LINE,54,5,IOINHI,IOINORM)
- +192 ;eRx Date video display
- IF 'S2017
- DO CNTRL^VALM10(LINE,68,20,IOINHI,IOINORM)
- +193 IF S2017
- Begin DoDot:1
- +194 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Written Date: ",$PIECE(WDATE,"@"),1,35)
- +195 DO ADDITEM^PSOERX1A(.LINETXT,"eRx Issue Date: ",ERXDT,40,70)
- +196 SET LINE=LINE+1
- DO SET^VALM10(LINE,LINETXT)
- +197 ;eRx Days Supply video display
- DO CNTRL^VALM10(LINE,18,13,IOINHI,IOINORM)
- +198 ;eRx Days Supply video display
- DO CNTRL^VALM10(LINE,56,13,IOINHI,IOINORM)
- +199 SET LINETXT=""
- +200 IF MTYPE="N"!((MTYPE="CX")&$$PROHIBIT^PSOERX1D(RESPVAL,CHGMESRI))
- Begin DoDot:2
- +201 SET PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
- +202 SET PROHIBIT=$SELECT(PROHIBIT=1:"Yes",1:"No")
- +203 SET LINE=LINE+1
- DO SET^VALM10(LINE,"Prohibit Renewals: "_PROHIBIT)
- End DoDot:2
- End DoDot:1
- +204 DO TXT2ARY^PSOERXD1(.SIGARY,$GET(EDIRECT),,70)
- +205 SET SFIRST=$ORDER(SIGARY(0))
- +206 IF 'S2017
- Begin DoDot:1
- +207 SET SGLOOP=0
- FOR
- SET SGLOOP=$ORDER(SIGARY(SGLOOP))
- if 'SGLOOP
- QUIT
- Begin DoDot:2
- +208 SET LINE=LINE+1
- DO SET^VALM10(LINE,$SELECT(SGLOOP=SFIRST:"eRx Sig: ",1:$JUSTIFY("",9))_$GET(SIGARY(SGLOOP)))
- DO CNTRL^VALM10(LINE,9,$LENGTH($GET(SIGARY(SGLOOP)))+1,IOINHI,IOINORM)
- End DoDot:2
- End DoDot:1
- +209 IF S2017
- IF $GET(MEDIEN)
- Begin DoDot:1
- +210 SET ERXDSIG=""
- +211 SET SGLOOP=0
- FOR
- SET SGLOOP=$ORDER(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP))
- if 'SGLOOP
- QUIT
- SET ERXDSIG=ERXDSIG_$GET(^PS(52.49,PSOIEN,311,MEDIEN,8,SGLOOP,0))_" "
- +212 DO TXT2ARY^PSOERXD1(.SIG311AR,$GET(ERXDSIG),,70)
- +213 SET SGLOOP=0
- FOR
- SET SGLOOP=$ORDER(SIG311AR(SGLOOP))
- if 'SGLOOP
- QUIT
- Begin DoDot:2
- +214 SET LINE=LINE+1
- DO SET^VALM10(LINE,$SELECT(SGLOOP=1:"eRx Sig: ",1:$JUSTIFY("",9))_SIG311AR(SGLOOP))
- DO CNTRL^VALM10(LINE,9,$LENGTH(SIG311AR(SGLOOP))+1,IOINHI,IOINORM)
- End DoDot:2
- +215 SET LINE=LINE+1
- DO SET^VALM10(LINE,"eRx Provider Notes/Comments:")
- +216 IF $DATA(ERXPNARY)
- Begin DoDot:2
- +217 SET PNLOOP=0
- FOR
- SET PNLOOP=$ORDER(ERXPNARY(PNLOOP))
- if 'PNLOOP
- QUIT
- Begin DoDot:3
- +218 SET LINE=LINE+1
- DO SET^VALM10(LINE,$GET(ERXPNARY(PNLOOP)))
- DO CNTRL^VALM10(LINE,1,$LENGTH($GET(ERXPNARY(PNLOOP)))+1,IOINHI,IOINORM)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +219 IF (",CX,CR,"[(","_MTYPE_","))
- IF $$QTSUMDT2^PSOERX1D(PSOIEN,MTYPE,CHGMESRI,RESPVAL,.LINE)
- SET VALMCNT=LINE
- QUIT
- +220 IF MTYPE="RR"
- Begin DoDot:1
- +221 IF S2017
- DO MEDDIS^PSOERXU7(PSOIEN,.LINE)
- +222 IF 'S2017
- DO MEDDIS^PSOERXU3(PSOIEN,"D",.LINE)
- +223 DO RRRES^PSOERXU3(PSOIEN,.LINE,1)
- DO RRREQ^PSOERXU3(PSOIEN,.LINE)
- DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
- End DoDot:1
- SET VALMCNT=LINE
- QUIT
- +224 IF MTYPE="RE"
- Begin DoDot:1
- +225 SET REQIEN=$$RESOLV^PSOERXU2(PSOIEN)
- +226 SET R2017=$$GET1^DIQ(52.49,REQIEN,312.1,"I")
- +227 DO DISPRX
- DO RRRES^PSOERXU3(PSOIEN,.LINE,1)
- +228 IF S2017
- IF R2017
- DO MEDDIS^PSOERXU7(PSOIEN,.LINE)
- +229 IF 'R2017
- DO MEDDIS^PSOERXU3(REQIEN,"D",.LINE)
- +230 DO RRREQ^PSOERXU3(PSOIEN,.LINE)
- DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
- +231 IF $$GET1^DIQ(52.49,PSOIEN,1,"E")="RXF"
- DO PROCERR^PSOERXU3(PSOIEN,.LINE)
- End DoDot:1
- SET VALMCNT=LINE
- QUIT
- +232 IF MTYPE="IE"
- Begin DoDot:1
- +233 SET RELIEN=$$RESOLV^PSOERXU2(PSOIEN)
- +234 SET RELMTYPE=$$GET1^DIQ(52.49,RELIEN,.08,"I")
- +235 IF RELMTYPE="RE"
- DO ERRDISP^PSOERXU3(PSOIEN,.LINE)
- DO RRREQ^PSOERXU3(PSOIEN,.LINE)
- DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
- QUIT
- +236 IF RELMTYPE="CA"
- DO ERRDISP^PSOERXU3(PSOIEN,.LINE)
- DO CANREQ^PSOERXU5(PSOIEN,.LINE)
- DO CANRES^PSOERXU5(PSOIEN,.LINE)
- DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
- QUIT
- +237 IF RELMTYPE="CN"
- DO ERRDISP^PSOERXU3(PSOIEN,.LINE)
- DO CANRES^PSOERXU5(PSOIEN,.LINE)
- DO CANREQ^PSOERXU5(PSOIEN,.LINE)
- QUIT
- +238 DO ERRDISP^PSOERXU3(PSOIEN,.LINE)
- DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
- End DoDot:1
- SET VALMCNT=LINE
- QUIT
- +239 IF MTYPE="CA"
- Begin DoDot:1
- +240 DO CANREQ^PSOERXU5(PSOIEN,.LINE)
- DO CANRES^PSOERXU5(PSOIEN,.LINE)
- DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
- End DoDot:1
- SET VALMCNT=LINE
- QUIT
- +241 IF MTYPE="CN"
- Begin DoDot:1
- +242 IF $$GET1^DIQ(52.49,PSOIEN,1,"E")="CNE"
- Begin DoDot:2
- +243 SET ERRIEN=$$GETRESP^PSOERXU2(PSOIEN)
- +244 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
- +245 DO CANRES^PSOERXU5(PSOIEN,.LINE)
- DO CANREQ^PSOERXU5(PSOIEN,.LINE)
- DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
- End DoDot:1
- SET VALMCNT=LINE
- QUIT
- DISPRX ;
- +1 DO DISPRX^PSOERSE3
- +2 SET VALMCNT=LINE
- +3 QUIT