Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERSE2

PSOERSE2.m

Go to the documentation of this file. 
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