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

PSOERUT5.m

Go to the documentation of this file.
  1. PSOERUT5 ;ALB/MFR - eRx & Pending Order Side-by-Side LM Display; 06/25/2023 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
  1. ;
  1. HDR(SCREEN) ; Pending Order Header (Invoked from PSO LM PENDING ORDER MENU protocol, HEADER field)
  1. ;Input: SCREEN - "P" - Main Pending Order | "A" - Accept/Renew Pending Order
  1. N ERXIEN,ERXSTS,RESP,DFN
  1. ;PSORXIEN (Glbal variable) indicates a manual renewal from Backdoor
  1. I $G(PSORXIEN) Q
  1. S ERXIEN=$$ERXIEN^PSOERXUT($G(ORD)_"P") I 'ERXIEN Q
  1. ; MbM needs to identify ineligible patients for ChampVA benefits as well as RXN and RXP eRx Responses in the Pending Queue
  1. S RESP="" I $$GET1^DIQ(59.7,1,102,"I")="MBM" D
  1. . S DFN=$$GET1^DIQ(52.49,ERXIEN,.05,"I")
  1. . I 'DFN S DFN=$$GET1^DIQ(52.41,+$G(ORD),1,"I")
  1. . I DFN,'$$CHVAELIG^PSOERXU9(DFN) D
  1. . . D INSTR^VALM1(IOBON_"PATIENT NOT ELIGIBLE"_IOBOFF,31,2)
  1. . S ERXSTS=$$GET1^DIQ(52.49,ERXIEN,"1") I ",RXP,RXN,"[(","_ERXSTS_",") S RESP="-R"
  1. S HDR="",$E(HDR,13)="ERX ("_$$GET1^DIQ(52.49,ERXIEN,.01)_RESP_")"
  1. S $E(HDR,40)="|",$E(HDR,51)="VISTA PENDING ORDER"
  1. S $E(HDR,81)="" D INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,$S(SCREEN="P":7,1:5))
  1. Q
  1. ;
  1. SETPEN(NMSPC,ERXIEN,ORDIEN,PENDATA,DRUGDATA,VASIG,RENEWORD,LASTRX) ; Set ListMan Side-By-Side Section for eRx Vs. Pending Order
  1. ;Input: NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1", "PSOPO", ...)
  1. ; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ; ORDIEN - Pointer to PENDING OUTPATIENT ORDERS file (#52.41)
  1. ; PENDATA - Array containing the Pending Order data
  1. ; DRUGDATA - Array containing the Pending Order data
  1. ; VASIG - Array containgin the Current Order SIG
  1. ; (o)RENEWORD - Renewal Pending Order? 1: YES | 0/null - NO
  1. ; (o)LASTRX - Pointer to PRESCRIPTION (#52) - Last Prescription for exact same Drug/SIG
  1. ; Input Global Variable: LINE - Current ListMan Line # (Default)
  1. ; Output Global Variable: (Some set in $$COMPARE^PSOERUT0)
  1. ; REVLN - Array Indicating Reverse Video for Line, position and size of the string
  1. ; HIGHLN - Array Indicating Highlight for Line, position and size of the string
  1. ; UNDERLN - Array Indicating Underline for Line, position and size of the string
  1. ; BLINKLN - Array Indicating Blinking for Line, position and size of the string
  1. ;
  1. S:'$G(LINE) LINE=1 S NMSPC=$G(NMSPC),RENEWORD=+$G(RENEWORD)
  1. N V2017,MTYPE,RSPTYPE,ERXDM,DATA,ERXDRUG,ERXSIG,ERXNOTES,ERXQTY,ERXQTYUM,ERXQTYQ,ERXDAYS,ERXREFS,ERXWRTDT,ERXEFDT
  1. N VAOIIEN,VADRUG,VAPATIEN,VAPATINS,VAPRCOMM,VAQTY,VADAYS,VAREFS,VAQTYUM,VADRGMSG,SIG,ESIG,VSIG,XE,XV,EQDRUG,ERXRENS
  1. N ERXDFORM,ERXDSTRE,XEI,XVI,I,DMARR,LMLINE,MEDIEN,VDRGLEN,VAPATSTS,VMAILWIN,VACLINIC,NONFORM,ERXPRVNM,PRVIEN,ERXSUBS
  1. N AMATCH,VADRGIEN,VALUSER,VALDTTM,MATCH,HDR,COPIES,ACCDTBY,XX,CMOPDRUG,PATSTS,EQCOMM,EXTISSDT,ARR,EARR,VARR,VAQTDMSG
  1. N VAFILLDT
  1. ; - Resetting list to NORMAL video attributes
  1. D RESET^PSOERUT0()
  1. ;
  1. ; - Digitally Signed Order
  1. I $$GET1^DIQ(52.49,ERXIEN,95.1,"I"),$$GET1^DIQ(52.49,ERXIEN,3.2,"I"),$$CS^PSOERXA0($$GET1^DIQ(52.49,ERXIEN,3.2,"I")) D
  1. . S XX="Processing Digitally Signed eRx order"
  1. . S XE="",$E(XE,(80-$L(XX))/2)=XX
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
  1. ;
  1. ; - Pending Order Flag
  1. D PENFLAG^PSOERUT4(NMSPC,ORDIEN)
  1. ; - Patient
  1. D SETPAT^PSOERUT0("LM",ERXIEN,$$GET1^DIQ(52.41,ORDIEN,1,"I"),NMSPC,1)
  1. S PRVIEN=$S($G(PENDATA("PROVIDER")):PENDATA("PROVIDER"),1:$$GET1^DIQ(52.41,ORDIEN,5,"I"))
  1. ; - Pharmacy Narrative
  1. I $G(DFN) D
  1. . S X=$$GET1^DIQ(55,DFN,1,"E") I X="" Q
  1. . S XV="|Pharmacy Narrative: " D ADDLINE^PSOERUT0("LM",NMSPC,,XV)
  1. . K ^UTILITY($J,"W") S DIWL=1,DIWR=38,DIWF="|" D ^DIWP
  1. . F I=1:1 Q:'$D(^UTILITY($J,"W",1,I)) D
  1. . . S XV="| "_$$COMPARE^PSOERUT0("LM",^UTILITY($J,"W",1,I,0),^UTILITY($J,"W",1,I,0),42) D ADDLINE^PSOERUT0("LM",NMSPC,,XV)
  1. . D BLANKLN^PSOERUT0("LM")
  1. ; - Allergy
  1. D ALLERGY^PSOERUT3("LM",NMSPC,ERXIEN,+$$GET1^DIQ(52.41,ORDIEN,1,"I"))
  1. ;
  1. ; - Provider
  1. D SETPROV^PSOERUT1("LM",ERXIEN,PRVIEN,NMSPC,1)
  1. ; - Drug/Dosage/etc.
  1. S V2017=+$$GET1^DIQ(52.49,ERXIEN,312.1,"I")
  1. S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
  1. S RSPTYPE=$$GET1^DIQ(52.49,ERXIEN,52.1,"I")
  1. I V2017 D
  1. .I MTYPE="CX" S MEDIEN=$O(^PS(52.49,ERXIEN,311,"C","P",0))
  1. .I MTYPE="N" S MEDIEN=$O(^PS(52.49,ERXIEN,311,0)) Q
  1. .I MTYPE="RE",RSPTYPE="R" S MEDIEN=$O(^PS(52.49,ERXIEN,311,"C","MR",0))
  1. ; eRx Data
  1. D GETS^DIQ(52.49,ERXIEN_",",".05;2.1;2.3;3.1;3.2;4.1;4.11;4.9;5.1;5.2;5.5;5.6;5.7;5.8;5.9;6.3;8;20.1;20.2;20.4;20.6;20.5;41;42;43","EI","DATA","ERR") I '$D(DATA) Q
  1. M ERXDM=DATA(52.49,ERXIEN_",")
  1. S ERXDRUG=ERXDM(3.1,"E"),ERXSIG=$$ERXSIG^PSOERXUT(ERXIEN),ERXPRVNM=ERXDM(2.1,"E")
  1. S ERXNOTES=ERXDM(8,"E"),ERXQTY=ERXDM(5.1,"E"),ERXDAYS=ERXDM(5.5,"E"),ERXWRTDT=ERXDM(5.9,"E"),ERXEFDT=ERXDM(6.3,"E")
  1. ; eRx Quantity Qualifier
  1. S ERXQTYQ=ERXDM(5.2,"E") I V2017,$G(MEDIEN) S ERXQTYQ=$$GET1^DIQ(52.49311,MEDIEN_","_ERXIEN_",",2.2,"I"),ERXQTYQ=$$GET1^DIQ(52.45,ERXQTYQ,.02,"E")
  1. ; Number of Refills
  1. S ERXREFS=ERXDM(5.6,"E") I MTYPE="RE",RSPTYPE="R",ERXREFS>0 S ERXREFS=$G(ERXREFS)-1
  1. S ERXSUBS=$S(ERXDM(5.8,"I")=1:"NO",ERXDM(5.8,"I")=0:"YES",1:""),ERXRENS=$S($$RENEWALS^PSOERXUT(ERXIEN):"YES",1:"NO")
  1. S ERXDFORM=ERXDM(41,"E"),ERXQTYUM=ERXDM(42,"E"),ERXDSTRE=ERXDM(43,"E")
  1. ;
  1. N OINAME,OIFORM,I,VADRUG,VADRGMSG
  1. S VAOIIEN=+$G(DRUGDATA("OI")),VADRGIEN=+$G(DRUGDATA("IEN")) I 'VADRGIEN S VADRGIEN=+$$GET1^DIQ(52.49,ERXIEN,3.2,"I")
  1. S VADRUG=$G(DRUGDATA("NAME")) I VADRUG="" S VADRUG=$$GET1^DIQ(50,VADRGIEN,.01)
  1. ;
  1. ; - Drug Matching Header Line
  1. D BLANKLN^PSOERUT0("LM")
  1. S AMATCH=$$GET1^DIQ(52.49,ERXIEN,1.4,"I")
  1. S VALUSER=$$GET1^DIQ(52.49,ERXIEN,1.11,"E"),VALDTTM=$$GET1^DIQ(52.49,ERXIEN,1.12,"I")
  1. I $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE",'VALDTTM D
  1. . S MATCH="PREVIOUSLY MATCHED/VALIDATED (RENEWAL)"
  1. E D
  1. . S MATCH=$S(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VADRGIEN:"MANUALLY-MATCHED",1:"")
  1. . I VALUSER'="",MATCH'="" S MATCH=MATCH_" | VALIDATED by "_$E(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
  1. . I MATCH="" S MATCH="NOT MATCHED"
  1. S MATCH="DRUG "_MATCH I $L(MATCH)>78 S MATCH=$E(MATCH,1,78)
  1. S HDR="",$E(HDR,(80-$L(MATCH))\2+1)=MATCH,$E(HDR,81)=""
  1. S $E(MATCH,81)=""
  1. S UNDERLN(LINE,1)=100 I HDR["/EDITED" S BLINKLN(LINE,$F(HDR,"/EDITED")-6)=6
  1. D ADDLINE^PSOERUT0("LM",NMSPC,HDR,"")
  1. ;
  1. ; - eRx Subs/Renewals and VA Orderable Item
  1. S XEI=0,XVI=0,LMLINE=LINE-1 K EARR,VARR
  1. S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)="Substitution? "_$$COMPARE^PSOERUT0("LM",ERXSUBS,$S(ERXSUBS="YES":ERXSUBS,1:""),15,,LMLINE)
  1. D DIN^PSONFI(VAOIIEN,VADRGIEN)
  1. S XVI=XVI+1,VARR(XVI)=$S('RENEWORD:"1) ",1:"")_"Orderable Item: "_$$COMPARE^PSOERUT0("LM",$TR(NFIO," "),"",60,LMLINE)
  1. I 'RENEWORD S UNDERLN(LMLINE,41)=2
  1. S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)="Renewals? "_$$COMPARE^PSOERUT0("LM",ERXRENS,ERXRENS,11,,LMLINE)
  1. S OINAME=$$GET1^DIQ(50.7,VAOIIEN,.01),OIFORM=$$GET1^DIQ(50.7,VAOIIEN,.02,"I")
  1. I OIFORM S OINAME=OINAME_" "_$$GET1^DIQ(50.606,OIFORM,.01)
  1. F I=1:1 Q:(OINAME="") D
  1. . S XVI=XVI+1,VARR(XVI)=" "_$$COMPARE^PSOERUT0("LM",$E(OINAME,1,38),$E(OINAME,1,38),42,,LMLINE)
  1. . S OINAME=$E(OINAME,39,999),LMLINE=LMLINE+1
  1. ;
  1. F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,$G(EARR(I)),"|"_$G(VARR(I)))
  1. K LMLINE D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; - eRx Drug and VA Drug
  1. S XEI=0,XVI=0,LMLINE=LINE-1 K EARR,VARR
  1. S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)="Drug: "
  1. S CMOPDRUG=$D(^PSDRUG("AQ",+VADRGIEN))
  1. S XVI=XVI+1,VARR(XVI)=$S('RENEWORD:"2) ",1:"")_$S(CMOPDRUG:"CMOP ",1:"")_"Drug: "_$$COMPARE^PSOERUT0("LM",$TR(NFID," "),"",$S(CMOPDRUG:55,1:50),,LMLINE)
  1. I 'RENEWORD S UNDERLN(LMLINE,41)=2
  1. S EQDRUG=0 I ($$CLNSTR^PSOERUT0(ERXDRUG)[$$CLNSTR^PSOERUT0(VADRUG))!($$CLNSTR^PSOERUT0(VADRUG)[$$CLNSTR^PSOERUT0(ERXDRUG)) S EQDRUG=1
  1. F I=1:1 Q:((VADRUG="")&(ERXDRUG="")) D
  1. . S LMLINE=LMLINE+1
  1. . S XEI=XEI+1,EARR(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(ERXDRUG,1,38),$S(EQDRUG:$E(ERXDRUG,1,38),1:""),2,,LMLINE)
  1. . S XVI=XVI+1,VARR(XVI)=" "_$$COMPARE^PSOERUT0("LM",$E(VADRUG,1,38),$S(EQDRUG:$E(VADRUG,1,38),1:""),42,,LMLINE)
  1. . S ERXDRUG=$E(ERXDRUG,39,999),VADRUG=$E(VADRUG,39,999)
  1. ; - eRx Drug Form and VA Drug Message
  1. S VADRGMSG=$$GET1^DIQ(50,+VADRGIEN,101)
  1. I ERXDFORM'=""!(VADRGMSG'="") D
  1. . S LMLINE=LMLINE+1
  1. . I ERXDFORM'="" D
  1. . . S XEI=XEI+1,EARR(XEI)="Drug Form: "_$$COMPARE^PSOERUT0("LM",$E(ERXDFORM,1,28),$E(ERXDFORM,1,28),12,,LMLINE)
  1. . . S ERXDFORM=$E(ERXDFORM,29,999)
  1. . I VADRGMSG'="" D
  1. . . S XVI=XVI+1,VARR(XVI)="Drug Message:"
  1. . K DMARR D WRAP^PSOERUT(VADRGMSG,38,.DMARR)
  1. . F I=1:1 Q:(ERXDFORM="")&('$D(DMARR(I))) D
  1. . . S LMLINE=LMLINE+1
  1. . . I ERXDFORM'="" D
  1. . . . S XEI=XEI+1,EARR(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(ERXDFORM,1,28),$E(ERXDFORM,1,28),12,,LMLINE)
  1. . . . S ERXDFORM=$E(ERXDFORM,29,999)
  1. . . S XVI=XVI+1,VARR(XVI)=" "_$$COMPARE^PSOERUT0("LM",$G(DMARR(I,0)),$G(DMARR(I,0)),42,,LMLINE)
  1. ;
  1. F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,$G(EARR(I)),"|"_$G(VARR(I)))
  1. K LMLINE D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; - eRx SIG
  1. K EARR D WRAP^PSOERUT(ERXSIG,38,.EARR)
  1. ; - VistA SIG
  1. S SIG=""
  1. I $O(VASIG(0)) D
  1. . S I=0 F S I=$O(VASIG(I)) Q:'I D
  1. . . I SIG="" S SIG=VASIG(I) Q
  1. . . S SIG=SIG_$S($E(SIG,$L(SIG))=" ":"",1:" ")_VASIG(I)
  1. E S SIG=$$VASIG^PSOERUT4(ORDIEN)
  1. K VARR D WRAP^PSOERUT($G(SIG),39,.VARR)
  1. S XE="SIG:",XV="|SIG:" D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
  1. . S XE=" "_$$COMPARE^PSOERUT0("LM",$G(EARR(I,0)),$G(EARR(I,0)),2)
  1. . S XV="| "_$$COMPARE^PSOERUT0("LM",$G(VARR(I,0)),$G(VARR(I,0)),42)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; Set Dosage Information
  1. D PODOSAGE^PSOERUT4(NMSPC,ORDIEN,.PENDATA,RENEWORD)
  1. K LMLINE D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; - Provider Notes/Comments
  1. K EARR D WRAP^PSOERUT(ERXNOTES,38,.EARR)
  1. S VAPRCOMM=""
  1. S I=0 F S I=$O(^PS(52.41,ORDIEN,3,I)) Q:'I D
  1. . S VAPRCOMM=VAPRCOMM_" "_^PS(52.41,ORDIEN,3,I,0)
  1. S $E(VAPRCOMM)=""
  1. S EQCOMM=0 I $$PROVCOMM^PSOERUT4(ERXNOTES)=VAPRCOMM S EQCOMM=1
  1. K VARR D WRAP^PSOERUT($G(VAPRCOMM),39,.VARR)
  1. S XE="Provider Notes/Comments:",XV="|Provider Comments:"
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
  1. . I $G(EARR(I,0))="",$G(VARR(I,0))="" Q
  1. . S XE=" "_$$COMPARE^PSOERUT0("LM",$G(EARR(I,0)),$S(EQCOMM:$G(EARR(I,0)),1:$G(VARR(I,0))),2)
  1. . S XV="| "_$$COMPARE^PSOERUT0("LM",$G(VARR(I,0)),$S(EQCOMM:$G(VARR(I,0)),1:$G(EARR(I,0))),42)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. I $G(PENDATA("IND"))'="" D
  1. . S XE="",XV="|Indications: "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("IND"),1,26),$E(PENDATA("IND"),1,26),54)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. . I $L(PENDATA("IND"))>26 D
  1. . . S XE="",XV="|"_$$COMPARE^PSOERUT0("LM",$E(PENDATA("IND"),27,99),$E(PENDATA("IND"),27,99),41)
  1. . . D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. I $G(PENDATA("INDO"))'="",+$G(DFN),$P($G(^PS(55,+$G(DFN),"LAN")),"^"),$G(PENDATA("INDO"))'="" D
  1. . S XE="",XV="|Other Indications: "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("INDO"),1,20),$E(PENDATA("INDO"),1,20),60)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. . I $L(PENDATA("INDO"))>20 D
  1. . . S XE="",XV="|"_$$COMPARE^PSOERUT0("LM",$E(PENDATA("INDO"),21,99),$E(PENDATA("INDO"),21,99),41)
  1. . . D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. D BLANKLN^PSOERUT0("LM")
  1. ; - Patient Status
  1. S PATSTS=$S('RENEWORD:$$GET1^DIQ(53,+$G(PENDATA("PATIENT STATUS")),.01),1:$G(PENDATA("PATIENT STATUS")))
  1. S XV="|"_$S('RENEWORD:"5) ",1:"")_"Pat.Status: "_$$COMPARE^PSOERUT0("LM",PATSTS,PATSTS,$S('RENEWORD:56,1:53))
  1. I 'RENEWORD S UNDERLN(LINE,41)=2
  1. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. D BLANKLN^PSOERUT0("LM")
  1. ; - eRx Date Written Date & VA Issue Date
  1. S XE="Date Written: "_$$COMPARE^PSOERUT0("LM",ERXWRTDT,ERXWRTDT,15)
  1. S EXTISSDT=$$UP^XLFSTR($G(PENDATA("ISSUE DATE"))) I EXTISSDT="" S EXTISSDT=$$GET1^DIQ(52.41,ORDIEN,6)
  1. ; - Pending Renewals have the ISSUE DATE in FM format
  1. I EXTISSDT?7N S EXTISSDT=$$FMTE^XLFDT(PENDATA("ISSUE DATE"))
  1. S XV="|"_$S('RENEWORD:"6) ",1:"1) ")_"Issue Date: "_$$COMPARE^PSOERUT0("LM",EXTISSDT,EXTISSDT,56)
  1. S UNDERLN(LINE,41)=2
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. ; - eRx Effective Date & VA Fill Date
  1. S XE="Effective Date: "_$$COMPARE^PSOERUT0("LM",ERXEFDT,ERXEFDT,17)
  1. I $G(PENDATA("FILL DATE"))'="" D
  1. . S VAFILLDT=PENDATA("FILL DATE")
  1. E D
  1. . S VAFILLDT=$$SUGFLDT^PSOERUT(ORDIEN)
  1. S XV="|"_$S('RENEWORD:"7) ",1:"2) ")_"Fill Date: "_$$COMPARE^PSOERUT0("LM",$$FMTE^XLFDT(VAFILLDT),$$FMTE^XLFDT(VAFILLDT),55)
  1. S UNDERLN(LINE,41)=2
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. I $G(LASTRX) D
  1. . N PRFLDT S PRFLDT=$$RXRLDT^PSOBPSUT(LASTRX)\1 I 'PRFLDT S PRFLDT=$$RXFLDT^PSOBPSUT(LASTRX)
  1. . S X=$$GET1^DIQ(52,LASTRX,.01)_"/"_$$LASTRXST^PSOERUT6(LASTRX)_","_$$FMTE^XLFDT(PRFLDT,"2Z")_",Q:"_$$GET1^DIQ(52,LASTRX,7)_",D:"_$$GET1^DIQ(52,LASTRX,8)
  1. . S XV="|Prior: "_$$COMPARE^PSOERUT0("LM",X,X,48)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; - Days Supply
  1. S VADAYS=$G(PENDATA("DAYS SUPPLY"))
  1. S XE="Days Supply: "_$$COMPARE^PSOERUT0("LM",ERXDAYS,VADAYS,14)
  1. S XV="|"_$S('RENEWORD:"8) ",1:"")_"Days Supply: "_$$COMPARE^PSOERUT0("LM",VADAYS,$S(ERXDAYS:ERXDAYS,1:VADAYS),$S('RENEWORD:57,1:54))
  1. I 'RENEWORD S UNDERLN(LINE,41)=2
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; - Quantity
  1. S VAQTY=$G(PSONEW("QTY"))
  1. S XE="Quantity: "_$$COMPARE^PSOERUT0("LM",ERXQTY,VAQTY,11)
  1. S VAQTYUM=$$GET1^DIQ(50,+VADRGIEN,14.5)
  1. S XV="|"_$S('RENEWORD:"9) ",1:"")_"QTY "_$S(VAQTYUM'="":"("_VAQTYUM_")",1:"")
  1. S XV=XV_": "_$$COMPARE^PSOERUT0("LM",VAQTY,ERXQTY,$S('RENEWORD:50,1:47)+$S($L(VAQTYUM):$L(VAQTYUM)+2,1:0))
  1. I 'RENEWORD S UNDERLN(LINE,41)=2
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. ; - Dispense Unit
  1. S XE="Dispense Unit: "_$$COMPARE^PSOERUT0("LM",$E(ERXQTYUM,1,24),$E(ERXQTYUM,1,24),16)
  1. S XV="|"
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. I $L(ERXQTYUM)>24 D
  1. . S XE=$E(ERXQTYUM,25,99),XV="|" D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. ;
  1. S XEI=0,XVI=0,LMLINE=LINE-1 K EARR,VARR
  1. ; - Quantity Qualifier
  1. S VAQTDMSG=$$GET1^DIQ(50,+VADRGIEN,215)
  1. I $G(ERXQTYQ)'=""!($G(VAQTDMSG)'="") D
  1. . S LMLINE=LMLINE+1
  1. . I $G(ERXQTYQ)'="" S XEI=XEI+1,EARR(XEI)="Qty Qualifier: "_$$COMPARE^PSOERUT0("LM",ERXQTYQ,ERXQTYQ,16,,LMLINE)
  1. . ; - VistA Dispense Message
  1. . I $G(VAQTDMSG)'="" D
  1. . . S XVI=XVI+1,VARR(XVI)="QTY Dispense Message:"
  1. . . K DMARR D WRAP^PSOERUT(VAQTDMSG,38,.DMARR)
  1. . . F I=1:1 Q:'$D(DMARR(I)) D
  1. . . . S XVI=XVI+1,LMLINE=LMLINE+1,VARR(XVI)=" "_DMARR(I,0),HIGUNDLN(LMLINE,42)=$L(DMARR(I,0))
  1. ;
  1. F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,$G(EARR(I)),"|"_$G(VARR(I)))
  1. K LMLINE D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; - Number of Refills
  1. S VAREFS=$S($G(PENDATA("# OF REFILLS"))'="":PENDATA("# OF REFILLS"),1:$$GET1^DIQ(52.41,ORDIEN,13,"I"))
  1. I RENEWORD,ERXREFS>0 S ERXREFS=ERXREFS-1
  1. S XE="Refills: "_$$COMPARE^PSOERUT0("LM",ERXREFS,VAREFS,10)_$S(RENEWORD:" (Renewal)",1:"")
  1. S XV="|"_$S('RENEWORD:"10) ",1:"3) ")_"Refills: "_$$COMPARE^PSOERUT0("LM",VAREFS,ERXREFS,$S('RENEWORD:54,1:53))
  1. S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; - Routing (Mail/Window)
  1. S VMAILWIN=$S($G(PSONEW("MAIL/WINDOW"))="M":"MAIL",$G(PSONEW("MAIL/WINDOW"))="P":"PARK",1:"WINDOW")
  1. S XV="|"_$S('RENEWORD:"11) ",1:"4) ")_"Routing: "_$$COMPARE^PSOERUT0("LM",VMAILWIN,VMAILWIN,$S('RENEWORD:54,1:53))
  1. S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
  1. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; - Clinic
  1. S VACLINIC=$S($G(PENDATA("CLINIC"))'="":$$GET1^DIQ(44,PENDATA("CLINIC"),.01),1:$$GET1^DIQ(52.41,ORDIEN,1.1))
  1. S XV="|"_$S('RENEWORD:"12) ",1:"5) ")_"Clinic: "_$$COMPARE^PSOERUT0("LM",VACLINIC,VACLINIC,$S('RENEWORD:53,1:52))
  1. S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
  1. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; Continue to PSOERUT6 due to routine size limit
  1. G EN^PSOERUT6