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

PSOERX1.m

Go to the documentation of this file.
PSOERX1 ;ALB/BWF - eRx Utilities/RPC's ;Aug 14, 2020@12:43:34
 ;;7.0;OUTPATIENT PHARMACY;**467,520,527,508,551,581,635**;DEC 1997;Build 19
 ;
EN(PSOIEN) ; -- main entry point for PSO ERX HOLDING QUEUE
 D EN^VALM("PSO ERX HQ DISPLAY")
 Q
 ;
HDR ; -- header code
 S VALMHDR(1)="eRx Patient: "_$$GET1^DIQ(52.49,PSOIEN,.04,"E")
 S VALMHDR(2)="eRx Reference #: "_$$GET1^DIQ(52.49,PSOIEN,.01,"E")
 S VALMHDR(3)=$$BHW^PSOERXIU(PSOIEN)
 I VALMBCK="R" K @VALMAR S VALMBCK="" D INIT
 Q
 ;
INIT ;
 Q:'$G(PSOIEN)
 N PATIEN,PHARMIEN,PRVIEN,PHDAT,PATDAT,SUPDAT,PRVDAT,LINE,PRVLNM,PRVMI,PRVFN,EPAT,EPATDOB,VPATIEN,HARY,HL,PROHIBIT
 N VPATNM,VPATDOB,EPRVIEN,EPRVNM,EPRVNPI,VAPRVIEN,VAPRVNM,VAPRVNPI,SUPIEN,ERXDRUG,ERXQTY,ERXFLS,CSCOMM,MEDIEN
 N ERXDS,ERXDT,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
 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 telephone 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 VAPRVIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"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")
 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 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 SET^VALM10(LINE,MTYPEE),CNTRL^VALM10(LINE,1,$L(MTYPEE),IORVON,IORVOFF)
 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 ADDITEM^PSOERX1A(.LINETXT,"NPI: ",EPRVNPI,57,20)
 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 ADDITEM^PSOERX1A(.LINETXT,"NPI: ",VAPRVNPI,57,20)
 .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 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)))
 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),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)
 .; 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 LINE=LINE+1 D SET^VALM10(LINE,"Vista Drug"_$S(DRMANVAL:"[v]",1:"")_": "_VADRG)
 .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)
 S VALMCNT=LINE
 Q
 ;
HELP ; -- help code
 S X="?" D DISP^XQORM1 W !!
 Q
 ;
EXIT ; -- exit code
 K @VALMAR
 ; PSO*7*527 - set VALMBCK and PSOREFSH to force refresh when returning to list view
 S VALMBCK="R",PSOREFSH=1
 Q
 ;
EXPND ; -- expand code
 Q