PSOERUT5 ;ALB/MFR - eRx & Pending Order Side-by-Side LM Display; 06/25/2023 5:14pm
;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
;
HDR(SCREEN) ; Pending Order Header (Invoked from PSO LM PENDING ORDER MENU protocol, HEADER field)
;Input: SCREEN - "P" - Main Pending Order | "A" - Accept/Renew Pending Order
N ERXIEN,ERXSTS,RESP,DFN
;PSORXIEN indicates a manual renewal from Backdoor
I $G(PSORXIEN) Q
S ERXIEN=$$ERXIEN^PSOERXUT($G(ORD)_"P") I 'ERXIEN Q
; MbM needs to identify ineligible patients for ChampVA benefits as well as RXN and RXP eRx Responses in the Pending Queue
S RESP="" I $$GET1^DIQ(59.7,1,102,"I")="MBM" D
. S DFN=$$GET1^DIQ(52.49,ERXIEN,.05,"I")
. I 'DFN S DFN=$$GET1^DIQ(52.41,+$G(ORD),1,"I")
. I DFN,'$$CHVAELIG^PSOERXU9(DFN) D
. . D INSTR^VALM1(IOBON_"PATIENT NOT ELIGIBLE"_IOBOFF,31,2)
. S ERXSTS=$$GET1^DIQ(52.49,ERXIEN,"1") I ",RXP,RXN,"[(","_ERXSTS_",") S RESP="-R"
S HDR="",$E(HDR,13)="ERX ("_$$GET1^DIQ(52.49,ERXIEN,.01)_RESP_")"
S $E(HDR,40)="|",$E(HDR,51)="VISTA PENDING ORDER"
S $E(HDR,81)="" D INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,$S(SCREEN="P":7,1:5))
Q
;
SETPEN(NMSPC,ERXIEN,ORDIEN,PENDATA,DRUGDATA,VASIG,RENEWORD) ; Set ListMan Side-By-Side Section for eRx Vs. Pending Order
;Input: NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1", "PSOPO", ...)
; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; ORDIEN - Pointer to PENDING OUTPATIENT ORDERS file (#52.41)
; PENDATA - Array containing the Pending Order data
; DRUGDATA - Array containing the Pending Order data
; VASIG - Array containgin the Current Order SIG
; RENEWORD - Renewal Pending Order? 1: YES | 0/null - NO
; Input Global Variable: LINE - Current ListMan Line # (Default)
; Output Global Variable: (Some set in $$COMPARE^PSOERUT0)
; REVLN - Array Indicating Reverse Video for Line, position and size of the string
; HIGHLN - Array Indicating Highlight for Line, position and size of the string
; UNDERLN - Array Indicating Underline for Line, position and size of the string
; BLINKLN - Array Indicating Blinking for Line, position and size of the string
;
S:'$G(LINE) LINE=1 S NMSPC=$G(NMSPC),RENEWORD=+$G(RENEWORD)
N V2017,MTYPE,RSPTYPE,ERXDM,DATA,ERXDRUG,ERXSIG,ERXNOTES,ERXQTY,ERXQTYUM,ERXQTYQ,ERXDAYS,ERXREFS,ERXWRTDT,ERXEFDT
N VAOIIEN,VADRUG,VAPATIEN,VAPATINS,VAPRCOMM,VAQTY,VADAYS,VAREFS,VAQTYUM,VADRGMSG,SIG,ESIG,VSIG,XE,XV,EQDRUG,ERXRENS
N ERXDFORM,ERXDSTRE,XEI,XVI,I,DMARR,LMLINE,MEDIEN,VDRGLEN,VAPATSTS,VMAILWIN,VACLINIC,NONFORM,ERXPRVNM,PRVIEN,ERXSUBS
N AMATCH,VADRGIEN,VALUSER,VALDTTM,MATCH,HDR,COPIES,ACCDTBY,XX,CMOPDRUG,PATSTS,EQCOMM,EXTISSDT,ARR,EARR,VARR,VAQTDMSG
N VAFILLDT
; - Resetting list to NORMAL video attributes
D RESET^PSOERUT0()
;
; - Digitally Signed Order
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
. S XX="Processing Digitally Signed eRx order"
. S XE="",$E(XE,(80-$L(XX))/2)=XX
. D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
;
; - Pending Order Flag
D PENFLAG^PSOERUT4(NMSPC,ORDIEN)
; - Patient
D SETPAT^PSOERUT0("LM",ERXIEN,$$GET1^DIQ(52.41,ORDIEN,1,"I"),NMSPC,1)
S PRVIEN=$S($G(PENDATA("PROVIDER")):PENDATA("PROVIDER"),1:$$GET1^DIQ(52.41,ORDIEN,5,"I"))
S XV="|Pharmacy Narrative: " D ADDLINE^PSOERUT0("LM",NMSPC,,XV)
I $G(DFN) D
. S X=$$GET1^DIQ(55,DFN,1,"E") I X="" Q
. K ^UTILITY($J,"W") S DIWL=1,DIWR=38,DIWF="|" D ^DIWP
. F I=1:1 Q:'$D(^UTILITY($J,"W",1,I)) D
. . S XV="| "_$$COMPARE^PSOERUT0("LM",^UTILITY($J,"W",1,I,0),^UTILITY($J,"W",1,I,0),42) D ADDLINE^PSOERUT0("LM",NMSPC,,XV)
D BLANKLN^PSOERUT0("LM")
; - Allergy
D ALLERGY^PSOERUT3("LM",NMSPC,ERXIEN,+$$GET1^DIQ(52.41,ORDIEN,1,"I"))
;
; - Provider
D SETPROV^PSOERUT1("LM",ERXIEN,PRVIEN,NMSPC,1)
; - Drug/Dosage/etc.
S V2017=+$$GET1^DIQ(52.49,ERXIEN,312.1,"I")
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
S RSPTYPE=$$GET1^DIQ(52.49,ERXIEN,52.1,"I")
I V2017 D
.I MTYPE="CX" S MEDIEN=$O(^PS(52.49,ERXIEN,311,"C","P",0))
.I MTYPE="N" S MEDIEN=$O(^PS(52.49,ERXIEN,311,0)) Q
.I MTYPE="RE",RSPTYPE="R" S MEDIEN=$O(^PS(52.49,ERXIEN,311,"C","MR",0))
; eRx Data
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
M ERXDM=DATA(52.49,ERXIEN_",")
S ERXDRUG=ERXDM(3.1,"E"),ERXSIG=$$ERXSIG^PSOERXUT(ERXIEN),ERXPRVNM=ERXDM(2.1,"E")
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")
; eRx Quantity Qualifier
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")
; Number of Refills
S ERXREFS=ERXDM(5.6,"E") I MTYPE="RE",RSPTYPE="R",ERXREFS>0 S ERXREFS=$G(ERXREFS)-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")
S ERXDFORM=ERXDM(41,"E"),ERXQTYUM=ERXDM(42,"E"),ERXDSTRE=ERXDM(43,"E")
;
N OINAME,OIFORM,I,VADRUG,VADRGMSG
S VAOIIEN=+$G(DRUGDATA("OI")),VADRGIEN=+$G(DRUGDATA("IEN")) I 'VADRGIEN S VADRGIEN=+$$GET1^DIQ(52.49,ERXIEN,3.2,"I")
S VADRUG=$G(DRUGDATA("NAME")) I VADRUG="" S VADRUG=$$GET1^DIQ(50,VADRGIEN,.01)
;
; - Drug Matching Header Line
D BLANKLN^PSOERUT0("LM")
S AMATCH=$$GET1^DIQ(52.49,ERXIEN,1.4,"I")
S VALUSER=$$GET1^DIQ(52.49,ERXIEN,1.11,"E"),VALDTTM=$$GET1^DIQ(52.49,ERXIEN,1.12,"I")
I $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE",'VALDTTM D
. S MATCH="PREVIOUSLY MATCHED/VALIDATED (RENEWAL)"
E D
. S MATCH=$S(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VADRGIEN:"MANUALLY-MATCHED",1:"")
. I VALUSER'="",MATCH'="" S MATCH=MATCH_" | VALIDATED by "_$E(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
. I MATCH="" S MATCH="NOT MATCHED"
S MATCH="DRUG "_MATCH I $L(MATCH)>78 S MATCH=$E(MATCH,1,78)
S HDR="",$E(HDR,(80-$L(MATCH))\2+1)=MATCH,$E(HDR,81)=""
S $E(MATCH,81)=""
S UNDERLN(LINE,1)=100 I HDR["/EDITED" S BLINKLN(LINE,$F(HDR,"/EDITED")-6)=6
D ADDLINE^PSOERUT0("LM",NMSPC,HDR,"")
;
; - eRx Subs/Renewals and VA Orderable Item
S XEI=0,XVI=0,LMLINE=LINE-1 K EARR,VARR
S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)="Substitution? "_$$COMPARE^PSOERUT0("LM",ERXSUBS,$S(ERXSUBS="YES":ERXSUBS,1:""),15,,LMLINE)
D DIN^PSONFI(VAOIIEN,VADRGIEN)
S XVI=XVI+1,VARR(XVI)=$S('RENEWORD:"1) ",1:"")_"Orderable Item: "_$$COMPARE^PSOERUT0("LM",$TR(NFIO," "),"",60,LMLINE)
I 'RENEWORD S UNDERLN(LMLINE,41)=2
S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)="Renewals? "_$$COMPARE^PSOERUT0("LM",ERXRENS,ERXRENS,11,,LMLINE)
S OINAME=$$GET1^DIQ(50.7,VAOIIEN,.01),OIFORM=$$GET1^DIQ(50.7,VAOIIEN,.02,"I")
I OIFORM S OINAME=OINAME_" "_$$GET1^DIQ(50.606,OIFORM,.01)
F I=1:1 Q:(OINAME="") D
. S XVI=XVI+1,VARR(XVI)=" "_$$COMPARE^PSOERUT0("LM",$E(OINAME,1,38),$E(OINAME,1,38),42,,LMLINE)
. S OINAME=$E(OINAME,39,999),LMLINE=LMLINE+1
;
F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
. D ADDLINE^PSOERUT0("LM",NMSPC,$G(EARR(I)),"|"_$G(VARR(I)))
K LMLINE D BLANKLN^PSOERUT0("LM")
;
; - eRx Drug and VA Drug
S XEI=0,XVI=0,LMLINE=LINE-1 K EARR,VARR
S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)="Drug: "
S CMOPDRUG=$D(^PSDRUG("AQ",+VADRGIEN))
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)
I 'RENEWORD S UNDERLN(LMLINE,41)=2
S EQDRUG=0 I ($$CLNSTR^PSOERUT0(ERXDRUG)[$$CLNSTR^PSOERUT0(VADRUG))!($$CLNSTR^PSOERUT0(VADRUG)[$$CLNSTR^PSOERUT0(ERXDRUG)) S EQDRUG=1
F I=1:1 Q:((VADRUG="")&(ERXDRUG="")) D
. S LMLINE=LMLINE+1
. S XEI=XEI+1,EARR(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(ERXDRUG,1,38),$S(EQDRUG:$E(ERXDRUG,1,38),1:""),2,,LMLINE)
. S XVI=XVI+1,VARR(XVI)=" "_$$COMPARE^PSOERUT0("LM",$E(VADRUG,1,38),$S(EQDRUG:$E(VADRUG,1,38),1:""),42,,LMLINE)
. S ERXDRUG=$E(ERXDRUG,39,999),VADRUG=$E(VADRUG,39,999)
; - eRx Drug Form and VA Drug Message
S VADRGMSG=$$GET1^DIQ(50,+VADRGIEN,101)
I ERXDFORM'=""!(VADRGMSG'="") D
. S LMLINE=LMLINE+1
. I ERXDFORM'="" D
. . S XEI=XEI+1,EARR(XEI)="Drug Form: "_$$COMPARE^PSOERUT0("LM",$E(ERXDFORM,1,28),$E(ERXDFORM,1,28),12,,LMLINE)
. . S ERXDFORM=$E(ERXDFORM,29,999)
. I VADRGMSG'="" D
. . S XVI=XVI+1,VARR(XVI)="Drug Message:"
. K DMARR D WRAP^PSOERUT(VADRGMSG,38,.DMARR)
. F I=1:1 Q:(ERXDFORM="")&('$D(DMARR(I))) D
. . S LMLINE=LMLINE+1
. . I ERXDFORM'="" D
. . . S XEI=XEI+1,EARR(XEI)=" "_$$COMPARE^PSOERUT0("LM",$E(ERXDFORM,1,28),$E(ERXDFORM,1,28),12,,LMLINE)
. . . S ERXDFORM=$E(ERXDFORM,29,999)
. . S XVI=XVI+1,VARR(XVI)=" "_$$COMPARE^PSOERUT0("LM",DMARR(I,0),DMARR(I,0),42,,LMLINE)
;
F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
. D ADDLINE^PSOERUT0("LM",NMSPC,$G(EARR(I)),"|"_$G(VARR(I)))
K LMLINE D BLANKLN^PSOERUT0("LM")
;
; - eRx SIG
K EARR D WRAP^PSOERUT(ERXSIG,38,.EARR)
; - VistA SIG
S SIG=""
I $O(VASIG(0)) D
. S I=0 F S I=$O(VASIG(I)) Q:'I D
. . I SIG="" S SIG=VASIG(I) Q
. . S SIG=SIG_$S($E(SIG,$L(SIG))=" ":"",1:" ")_VASIG(I)
E S SIG=$$VASIG^PSOERUT4(ORDIEN)
K VARR D WRAP^PSOERUT($G(SIG),39,.VARR)
S XE="SIG:",XV="|SIG:" D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
. S XE=" "_$$COMPARE^PSOERUT0("LM",$G(EARR(I,0)),$G(EARR(I,0)),2)
. S XV="| "_$$COMPARE^PSOERUT0("LM",$G(VARR(I,0)),$G(VARR(I,0)),42)
. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
D BLANKLN^PSOERUT0("LM")
;
; Set Dosage Information
D PODOSAGE^PSOERUT4(NMSPC,ORDIEN,.PENDATA,RENEWORD)
K LMLINE D BLANKLN^PSOERUT0("LM")
;
; - Patient Instructions
S XV="|"_$S('RENEWORD:"4) ",1:"")_"Patient Instruction:"
I 'RENEWORD S UNDERLN(LINE,41)=2
D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
S VAPATINS="" F I=1:1 Q:'$D(PENDATA("SIG",I)) S VAPATINS=VAPATINS_" "_$$UP^XLFSTR($G(PENDATA("SIG",I)))
S $E(VAPATINS)=""
I VAPATINS'="" D
. K VARR D WRAP^PSOERUT(VAPATINS,39,.VARR)
. F I=1:1 Q:'$D(VARR(I)) D
. . S XV="| "_$$COMPARE^PSOERUT0("LM",$G(VARR(I,0)),$G(VARR(I,0)),42)
. . D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
I $O(PENDATA("SINS",0)) D
. S XV="| Other Lang. Pat. Instruct: :"
. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
. S VAOTHINS="" F I=1:1 Q:'$D(PENDATA("SINS",I)) S VAOTHINS=VAOTHINS_" "_$$UP^XLFSTR($G(PENDATA("SINS",I)))
. S $E(VAOTHINS)=""
. K VARR D WRAP^PSOERUT(VAOTHINS,39,.VARR)
. F I=1:1 Q:'$D(VARR(I)) D
. . S XV="| "_$$COMPARE^PSOERUT0("LM",$G(VARR(I,0)),$G(VARR(I,0)),42)
. . D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
D BLANKLN^PSOERUT0("LM")
; - Provider Notes/Comments & Patient Instructions
K EARR D WRAP^PSOERUT(ERXNOTES,38,.EARR)
; - eRx Provider Notes/Comments
S VAPRCOMM=""
S I=0 F S I=$O(^PS(52.41,ORDIEN,3,I)) Q:'I D
. S VAPRCOMM=VAPRCOMM_" "_^PS(52.41,ORDIEN,3,I,0)
S $E(VAPRCOMM)=""
S EQCOMM=0 I $$PROVCOMM^PSOERUT4(ERXNOTES)=VAPRCOMM S EQCOMM=1
K VARR D WRAP^PSOERUT($G(VAPRCOMM),39,.VARR)
S XE="Provider Notes/Comments:",XV="|Provider Comments:"
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
. I $G(EARR(I,0))="",$G(VARR(I,0))="" Q
. S XE=" "_$$COMPARE^PSOERUT0("LM",$G(EARR(I,0)),$S(EQCOMM:$G(EARR(I,0)),1:$G(VARR(I,0))),2)
. S XV="| "_$$COMPARE^PSOERUT0("LM",$G(VARR(I,0)),$S(EQCOMM:$G(VARR(I,0)),1:$G(EARR(I,0))),42)
. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
I $G(PENDATA("IND"))'="" D
. S XE="",XV="|Indications: "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("IND"),1,26),$E(PENDATA("IND"),1,26),54)
. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
. I $L(PENDATA("IND"))>26 D
. . S XE="",XV="|"_$$COMPARE^PSOERUT0("LM",$E(PENDATA("IND"),27,99),$E(PENDATA("IND"),27,99),41)
. . D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
I $G(PENDATA("INDO"))'="",+$G(DFN),$P($G(^PS(55,+$G(DFN),"LAN")),"^"),$G(PENDATA("INDO"))'="" D
. S XE="",XV="|Other Indications: "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("INDO"),1,20),$E(PENDATA("INDO"),1,20),60)
. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
. I $L(PENDATA("INDO"))>20 D
. . S XE="",XV="|"_$$COMPARE^PSOERUT0("LM",$E(PENDATA("INDO"),21,99),$E(PENDATA("INDO"),21,99),41)
. . D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
D BLANKLN^PSOERUT0("LM")
; - Patient Status
S PATSTS=$S('RENEWORD:$$GET1^DIQ(53,+$G(PENDATA("PATIENT STATUS")),.01),1:$G(PENDATA("PATIENT STATUS")))
S XV="|"_$S('RENEWORD:"5) ",1:"")_"Pat.Status: "_$$COMPARE^PSOERUT0("LM",PATSTS,PATSTS,$S('RENEWORD:56,1:53))
I 'RENEWORD S UNDERLN(LINE,41)=2
D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
D BLANKLN^PSOERUT0("LM")
; - eRx Date Written Date & VA Issue Date
S XE="Date Written: "_$$COMPARE^PSOERUT0("LM",ERXWRTDT,ERXWRTDT,15)
S EXTISSDT=$$UP^XLFSTR($G(PENDATA("ISSUE DATE"))) I EXTISSDT="" S EXTISSDT=$$GET1^DIQ(52.41,ORDIEN,6)
; - Pending Renewals have the ISSUE DATE in FM format
I EXTISSDT?7N S EXTISSDT=$$FMTE^XLFDT(PENDATA("ISSUE DATE"))
S XV="|"_$S('RENEWORD:"6) ",1:"1) ")_"Issue Date: "_$$COMPARE^PSOERUT0("LM",EXTISSDT,EXTISSDT,56)
S UNDERLN(LINE,41)=2
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
; - eRx Effective Date & VA Fill Date
S XE="Effective Date: "_$$COMPARE^PSOERUT0("LM",ERXEFDT,ERXEFDT,17)
I $G(PENDATA("FILL DATE"))'="" D
. S VAFILLDT=PENDATA("FILL DATE")
E D
. S VAFILLDT=$$GET1^DIQ(52.41,ORDIEN,6,"I") I VAFILLDT>DT S VAFILLDT=DT
S XV="|"_$S('RENEWORD:"7) ",1:"2) ")_"Fill Date: "_$$COMPARE^PSOERUT0("LM",$$FMTE^XLFDT(VAFILLDT),$$FMTE^XLFDT(VAFILLDT),55)
S UNDERLN(LINE,41)=2
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
D BLANKLN^PSOERUT0("LM")
;
; - Days Supply
S VADAYS=$G(PENDATA("DAYS SUPPLY"))
S XE="Days Supply: "_$$COMPARE^PSOERUT0("LM",ERXDAYS,VADAYS,14)
S XV="|"_$S('RENEWORD:"8) ",1:"")_"Days Supply: "_$$COMPARE^PSOERUT0("LM",VADAYS,$S(ERXDAYS:ERXDAYS,1:VADAYS),$S('RENEWORD:57,1:54))
I 'RENEWORD S UNDERLN(LINE,41)=2
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
D BLANKLN^PSOERUT0("LM")
;
; - Quantity
S VAQTY=$G(PSONEW("QTY"))
S XE="Quantity: "_$$COMPARE^PSOERUT0("LM",ERXQTY,VAQTY,11)
S VAQTYUM=$$GET1^DIQ(50,+VADRGIEN,14.5)
S XV="|"_$S('RENEWORD:"9) ",1:"")_"QTY "_$S(VAQTYUM'="":"("_VAQTYUM_")",1:"")
S XV=XV_": "_$$COMPARE^PSOERUT0("LM",VAQTY,ERXQTY,$S('RENEWORD:50,1:47)+$S($L(VAQTYUM):$L(VAQTYUM)+2,1:0))
I 'RENEWORD S UNDERLN(LINE,41)=2
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
; - Dispense Unit
S XE="Dispense Unit: "_$$COMPARE^PSOERUT0("LM",$E(ERXQTYUM,1,24),$E(ERXQTYUM,1,24),16)
S XV="|"
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
I $L(ERXQTYUM)>24 D
. S XE=$E(ERXQTYUM,25,99),XV="|" D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
;
S XEI=0,XVI=0,LMLINE=LINE-1 K EARR,VARR
; - Quantity Qualifier
S VAQTDMSG=$$GET1^DIQ(50,+VADRGIEN,215)
I $G(ERXQTYQ)'=""!($G(VAQTDMSG)'="") D
. S LMLINE=LMLINE+1
. I $G(ERXQTYQ)'="" S XEI=XEI+1,EARR(XEI)="Qty Qualifier: "_$$COMPARE^PSOERUT0("LM",ERXQTYQ,ERXQTYQ,16,,LMLINE)
. ; - VistA Dispense Message
. I $G(VAQTDMSG)'="" D
. . S XVI=XVI+1,VARR(XVI)="QTY Dispense Message:"
. . K DMARR D WRAP^PSOERUT(VAQTDMSG,38,.DMARR)
. . F I=1:1 Q:'$D(DMARR(I)) D
. . . S XVI=XVI+1,LMLINE=LMLINE+1,VARR(XVI)=" "_DMARR(I,0),HIGUNDLN(LMLINE,42)=$L(DMARR(I,0))
;
F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
. D ADDLINE^PSOERUT0("LM",NMSPC,$G(EARR(I)),"|"_$G(VARR(I)))
K LMLINE D BLANKLN^PSOERUT0("LM")
;
; - Number of Refills
S VAREFS=$S($G(PENDATA("# OF REFILLS"))'="":PENDATA("# OF REFILLS"),1:$$GET1^DIQ(52.41,ORDIEN,13,"I"))
I RENEWORD,ERXREFS>0 S ERXREFS=ERXREFS-1
S XE="Refills: "_$$COMPARE^PSOERUT0("LM",ERXREFS,VAREFS,10)_$S(RENEWORD:" (Renewal)",1:"")
S XV="|"_$S('RENEWORD:"10) ",1:"3) ")_"Refills: "_$$COMPARE^PSOERUT0("LM",VAREFS,ERXREFS,$S('RENEWORD:54,1:53))
S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
D BLANKLN^PSOERUT0("LM")
;
; - Routing (Mail/Window)
S VMAILWIN=$S($G(PSONEW("MAIL/WINDOW"))="M":"MAIL",$G(PSONEW("MAIL/WINDOW"))="P":"PARK",1:"WINDOW")
S XV="|"_$S('RENEWORD:"11) ",1:"4) ")_"Routing: "_$$COMPARE^PSOERUT0("LM",VMAILWIN,VMAILWIN,$S('RENEWORD:54,1:53))
S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
D BLANKLN^PSOERUT0("LM")
;
; - Clinic
S VACLINIC=$S($G(PENDATA("CLINIC"))'="":$$GET1^DIQ(44,PENDATA("CLINIC"),.01),1:$$GET1^DIQ(52.41,ORDIEN,1.1))
S XV="|"_$S('RENEWORD:"12) ",1:"5) ")_"Clinic: "_$$COMPARE^PSOERUT0("LM",VACLINIC,VACLINIC,$S('RENEWORD:53,1:52))
S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
D BLANKLN^PSOERUT0("LM")
;
G EN^PSOERUT6
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERUT5 16571 printed Apr 09, 2024@21:25:31 Page 2
PSOERUT5 ;ALB/MFR - eRx & Pending Order Side-by-Side LM Display; 06/25/2023 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
+2 ;
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
+2 NEW ERXIEN,ERXSTS,RESP,DFN
+3 ;PSORXIEN indicates a manual renewal from Backdoor
+4 IF $GET(PSORXIEN)
QUIT
+5 SET ERXIEN=$$ERXIEN^PSOERXUT($GET(ORD)_"P")
IF 'ERXIEN
QUIT
+6 ; MbM needs to identify ineligible patients for ChampVA benefits as well as RXN and RXP eRx Responses in the Pending Queue
+7 SET RESP=""
IF $$GET1^DIQ(59.7,1,102,"I")="MBM"
Begin DoDot:1
+8 SET DFN=$$GET1^DIQ(52.49,ERXIEN,.05,"I")
+9 IF 'DFN
SET DFN=$$GET1^DIQ(52.41,+$GET(ORD),1,"I")
+10 IF DFN
IF '$$CHVAELIG^PSOERXU9(DFN)
Begin DoDot:2
+11 DO INSTR^VALM1(IOBON_"PATIENT NOT ELIGIBLE"_IOBOFF,31,2)
End DoDot:2
+12 SET ERXSTS=$$GET1^DIQ(52.49,ERXIEN,"1")
IF ",RXP,RXN,"[(","_ERXSTS_",")
SET RESP="-R"
End DoDot:1
+13 SET HDR=""
SET $EXTRACT(HDR,13)="ERX ("_$$GET1^DIQ(52.49,ERXIEN,.01)_RESP_")"
+14 SET $EXTRACT(HDR,40)="|"
SET $EXTRACT(HDR,51)="VISTA PENDING ORDER"
+15 SET $EXTRACT(HDR,81)=""
DO INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,$SELECT(SCREEN="P":7,1:5))
+16 QUIT
+17 ;
SETPEN(NMSPC,ERXIEN,ORDIEN,PENDATA,DRUGDATA,VASIG,RENEWORD) ; Set ListMan Side-By-Side Section for eRx Vs. Pending Order
+1 ;Input: NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1", "PSOPO", ...)
+2 ; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+3 ; ORDIEN - Pointer to PENDING OUTPATIENT ORDERS file (#52.41)
+4 ; PENDATA - Array containing the Pending Order data
+5 ; DRUGDATA - Array containing the Pending Order data
+6 ; VASIG - Array containgin the Current Order SIG
+7 ; RENEWORD - Renewal Pending Order? 1: YES | 0/null - NO
+8 ; Input Global Variable: LINE - Current ListMan Line # (Default)
+9 ; Output Global Variable: (Some set in $$COMPARE^PSOERUT0)
+10 ; REVLN - Array Indicating Reverse Video for Line, position and size of the string
+11 ; HIGHLN - Array Indicating Highlight for Line, position and size of the string
+12 ; UNDERLN - Array Indicating Underline for Line, position and size of the string
+13 ; BLINKLN - Array Indicating Blinking for Line, position and size of the string
+14 ;
+15 if '$GET(LINE)
SET LINE=1
SET NMSPC=$GET(NMSPC)
SET RENEWORD=+$GET(RENEWORD)
+16 NEW V2017,MTYPE,RSPTYPE,ERXDM,DATA,ERXDRUG,ERXSIG,ERXNOTES,ERXQTY,ERXQTYUM,ERXQTYQ,ERXDAYS,ERXREFS,ERXWRTDT,ERXEFDT
+17 NEW VAOIIEN,VADRUG,VAPATIEN,VAPATINS,VAPRCOMM,VAQTY,VADAYS,VAREFS,VAQTYUM,VADRGMSG,SIG,ESIG,VSIG,XE,XV,EQDRUG,ERXRENS
+18 NEW ERXDFORM,ERXDSTRE,XEI,XVI,I,DMARR,LMLINE,MEDIEN,VDRGLEN,VAPATSTS,VMAILWIN,VACLINIC,NONFORM,ERXPRVNM,PRVIEN,ERXSUBS
+19 NEW AMATCH,VADRGIEN,VALUSER,VALDTTM,MATCH,HDR,COPIES,ACCDTBY,XX,CMOPDRUG,PATSTS,EQCOMM,EXTISSDT,ARR,EARR,VARR,VAQTDMSG
+20 NEW VAFILLDT
+21 ; - Resetting list to NORMAL video attributes
+22 DO RESET^PSOERUT0()
+23 ;
+24 ; - Digitally Signed Order
+25 IF $$GET1^DIQ(52.49,ERXIEN,95.1,"I")
IF $$GET1^DIQ(52.49,ERXIEN,3.2,"I")
IF $$CS^PSOERXA0($$GET1^DIQ(52.49,ERXIEN,3.2,"I"))
Begin DoDot:1
+26 SET XX="Processing Digitally Signed eRx order"
+27 SET XE=""
SET $EXTRACT(XE,(80-$LENGTH(XX))/2)=XX
+28 DO ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
End DoDot:1
+29 ;
+30 ; - Pending Order Flag
+31 DO PENFLAG^PSOERUT4(NMSPC,ORDIEN)
+32 ; - Patient
+33 DO SETPAT^PSOERUT0("LM",ERXIEN,$$GET1^DIQ(52.41,ORDIEN,1,"I"),NMSPC,1)
+34 SET PRVIEN=$SELECT($GET(PENDATA("PROVIDER")):PENDATA("PROVIDER"),1:$$GET1^DIQ(52.41,ORDIEN,5,"I"))
+35 SET XV="|Pharmacy Narrative: "
DO ADDLINE^PSOERUT0("LM",NMSPC,,XV)
+36 IF $GET(DFN)
Begin DoDot:1
+37 SET X=$$GET1^DIQ(55,DFN,1,"E")
IF X=""
QUIT
+38 KILL ^UTILITY($JOB,"W")
SET DIWL=1
SET DIWR=38
SET DIWF="|"
DO ^DIWP
+39 FOR I=1:1
if '$DATA(^UTILITY($JOB,"W",1,I))
QUIT
Begin DoDot:2
+40 SET XV="| "_$$COMPARE^PSOERUT0("LM",^UTILITY($JOB,"W",1,I,0),^UTILITY($JOB,"W",1,I,0),42)
DO ADDLINE^PSOERUT0("LM",NMSPC,,XV)
End DoDot:2
End DoDot:1
+41 DO BLANKLN^PSOERUT0("LM")
+42 ; - Allergy
+43 DO ALLERGY^PSOERUT3("LM",NMSPC,ERXIEN,+$$GET1^DIQ(52.41,ORDIEN,1,"I"))
+44 ;
+45 ; - Provider
+46 DO SETPROV^PSOERUT1("LM",ERXIEN,PRVIEN,NMSPC,1)
+47 ; - Drug/Dosage/etc.
+48 SET V2017=+$$GET1^DIQ(52.49,ERXIEN,312.1,"I")
+49 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+50 SET RSPTYPE=$$GET1^DIQ(52.49,ERXIEN,52.1,"I")
+51 IF V2017
Begin DoDot:1
+52 IF MTYPE="CX"
SET MEDIEN=$ORDER(^PS(52.49,ERXIEN,311,"C","P",0))
+53 IF MTYPE="N"
SET MEDIEN=$ORDER(^PS(52.49,ERXIEN,311,0))
QUIT
+54 IF MTYPE="RE"
IF RSPTYPE="R"
SET MEDIEN=$ORDER(^PS(52.49,ERXIEN,311,"C","MR",0))
End DoDot:1
+55 ; eRx Data
+56 DO 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")
IF '$DATA(DATA)
QUIT
+57 MERGE ERXDM=DATA(52.49,ERXIEN_",")
+58 SET ERXDRUG=ERXDM(3.1,"E")
SET ERXSIG=$$ERXSIG^PSOERXUT(ERXIEN)
SET ERXPRVNM=ERXDM(2.1,"E")
+59 SET ERXNOTES=ERXDM(8,"E")
SET ERXQTY=ERXDM(5.1,"E")
SET ERXDAYS=ERXDM(5.5,"E")
SET ERXWRTDT=ERXDM(5.9,"E")
SET ERXEFDT=ERXDM(6.3,"E")
+60 ; eRx Quantity Qualifier
+61 SET ERXQTYQ=ERXDM(5.2,"E")
IF V2017
IF $GET(MEDIEN)
SET ERXQTYQ=$$GET1^DIQ(52.49311,MEDIEN_","_ERXIEN_",",2.2,"I")
SET ERXQTYQ=$$GET1^DIQ(52.45,ERXQTYQ,.02,"E")
+62 ; Number of Refills
+63 SET ERXREFS=ERXDM(5.6,"E")
IF MTYPE="RE"
IF RSPTYPE="R"
IF ERXREFS>0
SET ERXREFS=$GET(ERXREFS)-1
+64 SET ERXSUBS=$SELECT(ERXDM(5.8,"I")=1:"NO",ERXDM(5.8,"I")=0:"YES",1:"")
SET ERXRENS=$SELECT($$RENEWALS^PSOERXUT(ERXIEN):"YES",1:"NO")
+65 SET ERXDFORM=ERXDM(41,"E")
SET ERXQTYUM=ERXDM(42,"E")
SET ERXDSTRE=ERXDM(43,"E")
+66 ;
+67 NEW OINAME,OIFORM,I,VADRUG,VADRGMSG
+68 SET VAOIIEN=+$GET(DRUGDATA("OI"))
SET VADRGIEN=+$GET(DRUGDATA("IEN"))
IF 'VADRGIEN
SET VADRGIEN=+$$GET1^DIQ(52.49,ERXIEN,3.2,"I")
+69 SET VADRUG=$GET(DRUGDATA("NAME"))
IF VADRUG=""
SET VADRUG=$$GET1^DIQ(50,VADRGIEN,.01)
+70 ;
+71 ; - Drug Matching Header Line
+72 DO BLANKLN^PSOERUT0("LM")
+73 SET AMATCH=$$GET1^DIQ(52.49,ERXIEN,1.4,"I")
+74 SET VALUSER=$$GET1^DIQ(52.49,ERXIEN,1.11,"E")
SET VALDTTM=$$GET1^DIQ(52.49,ERXIEN,1.12,"I")
+75 IF $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE"
IF 'VALDTTM
Begin DoDot:1
+76 SET MATCH="PREVIOUSLY MATCHED/VALIDATED (RENEWAL)"
End DoDot:1
+77 IF '$TEST
Begin DoDot:1
+78 SET MATCH=$SELECT(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VADRGIEN:"MANUALLY-MATCHED",1:"")
+79 IF VALUSER'=""
IF MATCH'=""
SET MATCH=MATCH_" | VALIDATED by "_$EXTRACT(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
+80 IF MATCH=""
SET MATCH="NOT MATCHED"
End DoDot:1
+81 SET MATCH="DRUG "_MATCH
IF $LENGTH(MATCH)>78
SET MATCH=$EXTRACT(MATCH,1,78)
+82 SET HDR=""
SET $EXTRACT(HDR,(80-$LENGTH(MATCH))\2+1)=MATCH
SET $EXTRACT(HDR,81)=""
+83 SET $EXTRACT(MATCH,81)=""
+84 SET UNDERLN(LINE,1)=100
IF HDR["/EDITED"
SET BLINKLN(LINE,$FIND(HDR,"/EDITED")-6)=6
+85 DO ADDLINE^PSOERUT0("LM",NMSPC,HDR,"")
+86 ;
+87 ; - eRx Subs/Renewals and VA Orderable Item
+88 SET XEI=0
SET XVI=0
SET LMLINE=LINE-1
KILL EARR,VARR
+89 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET EARR(XEI)="Substitution? "_$$COMPARE^PSOERUT0("LM",ERXSUBS,$SELECT(ERXSUBS="YES":ERXSUBS,1:""),15,,LMLINE)
+90 DO DIN^PSONFI(VAOIIEN,VADRGIEN)
+91 SET XVI=XVI+1
SET VARR(XVI)=$SELECT('RENEWORD:"1) ",1:"")_"Orderable Item: "_$$COMPARE^PSOERUT0("LM",$TRANSLATE(NFIO," "),"",60,LMLINE)
+92 IF 'RENEWORD
SET UNDERLN(LMLINE,41)=2
+93 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET EARR(XEI)="Renewals? "_$$COMPARE^PSOERUT0("LM",ERXRENS,ERXRENS,11,,LMLINE)
+94 SET OINAME=$$GET1^DIQ(50.7,VAOIIEN,.01)
SET OIFORM=$$GET1^DIQ(50.7,VAOIIEN,.02,"I")
+95 IF OIFORM
SET OINAME=OINAME_" "_$$GET1^DIQ(50.606,OIFORM,.01)
+96 FOR I=1:1
if (OINAME="")
QUIT
Begin DoDot:1
+97 SET XVI=XVI+1
SET VARR(XVI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(OINAME,1,38),$EXTRACT(OINAME,1,38),42,,LMLINE)
+98 SET OINAME=$EXTRACT(OINAME,39,999)
SET LMLINE=LMLINE+1
End DoDot:1
+99 ;
+100 FOR I=1:1
if ('$DATA(EARR(I))&'$DATA(VARR(I)))
QUIT
Begin DoDot:1
+101 DO ADDLINE^PSOERUT0("LM",NMSPC,$GET(EARR(I)),"|"_$GET(VARR(I)))
End DoDot:1
+102 KILL LMLINE
DO BLANKLN^PSOERUT0("LM")
+103 ;
+104 ; - eRx Drug and VA Drug
+105 SET XEI=0
SET XVI=0
SET LMLINE=LINE-1
KILL EARR,VARR
+106 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET EARR(XEI)="Drug: "
+107 SET CMOPDRUG=$DATA(^PSDRUG("AQ",+VADRGIEN))
+108 SET XVI=XVI+1
SET VARR(XVI)=$SELECT('RENEWORD:"2) ",1:"")_$SELECT(CMOPDRUG:"CMOP ",1:"")_"Drug: "_$$COMPARE^PSOERUT0("LM",$TRANSLATE(NFID," "),"",$SELECT(CMOPDRUG:55,1:50),,LMLINE)
+109 IF 'RENEWORD
SET UNDERLN(LMLINE,41)=2
+110 SET EQDRUG=0
IF ($$CLNSTR^PSOERUT0(ERXDRUG)[$$CLNSTR^PSOERUT0(VADRUG))!($$CLNSTR^PSOERUT0(VADRUG)[$$CLNSTR^PSOERUT0(ERXDRUG))
SET EQDRUG=1
+111 FOR I=1:1
if ((VADRUG="")&(ERXDRUG=""))
QUIT
Begin DoDot:1
+112 SET LMLINE=LMLINE+1
+113 SET XEI=XEI+1
SET EARR(XEI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(ERXDRUG,1,38),$SELECT(EQDRUG:$EXTRACT(ERXDRUG,1,38),1:""),2,,LMLINE)
+114 SET XVI=XVI+1
SET VARR(XVI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(VADRUG,1,38),$SELECT(EQDRUG:$EXTRACT(VADRUG,1,38),1:""),42,,LMLINE)
+115 SET ERXDRUG=$EXTRACT(ERXDRUG,39,999)
SET VADRUG=$EXTRACT(VADRUG,39,999)
End DoDot:1
+116 ; - eRx Drug Form and VA Drug Message
+117 SET VADRGMSG=$$GET1^DIQ(50,+VADRGIEN,101)
+118 IF ERXDFORM'=""!(VADRGMSG'="")
Begin DoDot:1
+119 SET LMLINE=LMLINE+1
+120 IF ERXDFORM'=""
Begin DoDot:2
+121 SET XEI=XEI+1
SET EARR(XEI)="Drug Form: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(ERXDFORM,1,28),$EXTRACT(ERXDFORM,1,28),12,,LMLINE)
+122 SET ERXDFORM=$EXTRACT(ERXDFORM,29,999)
End DoDot:2
+123 IF VADRGMSG'=""
Begin DoDot:2
+124 SET XVI=XVI+1
SET VARR(XVI)="Drug Message:"
End DoDot:2
+125 KILL DMARR
DO WRAP^PSOERUT(VADRGMSG,38,.DMARR)
+126 FOR I=1:1
if (ERXDFORM="")&('$DATA(DMARR(I)))
QUIT
Begin DoDot:2
+127 SET LMLINE=LMLINE+1
+128 IF ERXDFORM'=""
Begin DoDot:3
+129 SET XEI=XEI+1
SET EARR(XEI)=" "_$$COMPARE^PSOERUT0("LM",$EXTRACT(ERXDFORM,1,28),$EXTRACT(ERXDFORM,1,28),12,,LMLINE)
+130 SET ERXDFORM=$EXTRACT(ERXDFORM,29,999)
End DoDot:3
+131 SET XVI=XVI+1
SET VARR(XVI)=" "_$$COMPARE^PSOERUT0("LM",DMARR(I,0),DMARR(I,0),42,,LMLINE)
End DoDot:2
End DoDot:1
+132 ;
+133 FOR I=1:1
if ('$DATA(EARR(I))&'$DATA(VARR(I)))
QUIT
Begin DoDot:1
+134 DO ADDLINE^PSOERUT0("LM",NMSPC,$GET(EARR(I)),"|"_$GET(VARR(I)))
End DoDot:1
+135 KILL LMLINE
DO BLANKLN^PSOERUT0("LM")
+136 ;
+137 ; - eRx SIG
+138 KILL EARR
DO WRAP^PSOERUT(ERXSIG,38,.EARR)
+139 ; - VistA SIG
+140 SET SIG=""
+141 IF $ORDER(VASIG(0))
Begin DoDot:1
+142 SET I=0
FOR
SET I=$ORDER(VASIG(I))
if 'I
QUIT
Begin DoDot:2
+143 IF SIG=""
SET SIG=VASIG(I)
QUIT
+144 SET SIG=SIG_$SELECT($EXTRACT(SIG,$LENGTH(SIG))=" ":"",1:" ")_VASIG(I)
End DoDot:2
End DoDot:1
+145 IF '$TEST
SET SIG=$$VASIG^PSOERUT4(ORDIEN)
+146 KILL VARR
DO WRAP^PSOERUT($GET(SIG),39,.VARR)
+147 SET XE="SIG:"
SET XV="|SIG:"
DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+148 FOR I=1:1
if ('$DATA(EARR(I))&'$DATA(VARR(I)))
QUIT
Begin DoDot:1
+149 SET XE=" "_$$COMPARE^PSOERUT0("LM",$GET(EARR(I,0)),$GET(EARR(I,0)),2)
+150 SET XV="| "_$$COMPARE^PSOERUT0("LM",$GET(VARR(I,0)),$GET(VARR(I,0)),42)
+151 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
End DoDot:1
+152 DO BLANKLN^PSOERUT0("LM")
+153 ;
+154 ; Set Dosage Information
+155 DO PODOSAGE^PSOERUT4(NMSPC,ORDIEN,.PENDATA,RENEWORD)
+156 KILL LMLINE
DO BLANKLN^PSOERUT0("LM")
+157 ;
+158 ; - Patient Instructions
+159 SET XV="|"_$SELECT('RENEWORD:"4) ",1:"")_"Patient Instruction:"
+160 IF 'RENEWORD
SET UNDERLN(LINE,41)=2
+161 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
+162 SET VAPATINS=""
FOR I=1:1
if '$DATA(PENDATA("SIG",I))
QUIT
SET VAPATINS=VAPATINS_" "_$$UP^XLFSTR($GET(PENDATA("SIG",I)))
+163 SET $EXTRACT(VAPATINS)=""
+164 IF VAPATINS'=""
Begin DoDot:1
+165 KILL VARR
DO WRAP^PSOERUT(VAPATINS,39,.VARR)
+166 FOR I=1:1
if '$DATA(VARR(I))
QUIT
Begin DoDot:2
+167 SET XV="| "_$$COMPARE^PSOERUT0("LM",$GET(VARR(I,0)),$GET(VARR(I,0)),42)
+168 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
End DoDot:2
End DoDot:1
+169 IF $ORDER(PENDATA("SINS",0))
Begin DoDot:1
+170 SET XV="| Other Lang. Pat. Instruct: :"
+171 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
+172 SET VAOTHINS=""
FOR I=1:1
if '$DATA(PENDATA("SINS",I))
QUIT
SET VAOTHINS=VAOTHINS_" "_$$UP^XLFSTR($GET(PENDATA("SINS",I)))
+173 SET $EXTRACT(VAOTHINS)=""
+174 KILL VARR
DO WRAP^PSOERUT(VAOTHINS,39,.VARR)
+175 FOR I=1:1
if '$DATA(VARR(I))
QUIT
Begin DoDot:2
+176 SET XV="| "_$$COMPARE^PSOERUT0("LM",$GET(VARR(I,0)),$GET(VARR(I,0)),42)
+177 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
End DoDot:2
End DoDot:1
+178 DO BLANKLN^PSOERUT0("LM")
+179 ; - Provider Notes/Comments & Patient Instructions
+180 KILL EARR
DO WRAP^PSOERUT(ERXNOTES,38,.EARR)
+181 ; - eRx Provider Notes/Comments
+182 SET VAPRCOMM=""
+183 SET I=0
FOR
SET I=$ORDER(^PS(52.41,ORDIEN,3,I))
if 'I
QUIT
Begin DoDot:1
+184 SET VAPRCOMM=VAPRCOMM_" "_^PS(52.41,ORDIEN,3,I,0)
End DoDot:1
+185 SET $EXTRACT(VAPRCOMM)=""
+186 SET EQCOMM=0
IF $$PROVCOMM^PSOERUT4(ERXNOTES)=VAPRCOMM
SET EQCOMM=1
+187 KILL VARR
DO WRAP^PSOERUT($GET(VAPRCOMM),39,.VARR)
+188 SET XE="Provider Notes/Comments:"
SET XV="|Provider Comments:"
+189 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+190 FOR I=1:1
if ('$DATA(EARR(I))&'$DATA(VARR(I)))
QUIT
Begin DoDot:1
+191 IF $GET(EARR(I,0))=""
IF $GET(VARR(I,0))=""
QUIT
+192 SET XE=" "_$$COMPARE^PSOERUT0("LM",$GET(EARR(I,0)),$SELECT(EQCOMM:$GET(EARR(I,0)),1:$GET(VARR(I,0))),2)
+193 SET XV="| "_$$COMPARE^PSOERUT0("LM",$GET(VARR(I,0)),$SELECT(EQCOMM:$GET(VARR(I,0)),1:$GET(EARR(I,0))),42)
+194 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
End DoDot:1
+195 IF $GET(PENDATA("IND"))'=""
Begin DoDot:1
+196 SET XE=""
SET XV="|Indications: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(PENDATA("IND"),1,26),$EXTRACT(PENDATA("IND"),1,26),54)
+197 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+198 IF $LENGTH(PENDATA("IND"))>26
Begin DoDot:2
+199 SET XE=""
SET XV="|"_$$COMPARE^PSOERUT0("LM",$EXTRACT(PENDATA("IND"),27,99),$EXTRACT(PENDATA("IND"),27,99),41)
+200 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
End DoDot:2
End DoDot:1
+201 IF $GET(PENDATA("INDO"))'=""
IF +$GET(DFN)
IF $PIECE($GET(^PS(55,+$GET(DFN),"LAN")),"^")
IF $GET(PENDATA("INDO"))'=""
Begin DoDot:1
+202 SET XE=""
SET XV="|Other Indications: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(PENDATA("INDO"),1,20),$EXTRACT(PENDATA("INDO"),1,20),60)
+203 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+204 IF $LENGTH(PENDATA("INDO"))>20
Begin DoDot:2
+205 SET XE=""
SET XV="|"_$$COMPARE^PSOERUT0("LM",$EXTRACT(PENDATA("INDO"),21,99),$EXTRACT(PENDATA("INDO"),21,99),41)
+206 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
End DoDot:2
End DoDot:1
+207 DO BLANKLN^PSOERUT0("LM")
+208 ; - Patient Status
+209 SET PATSTS=$SELECT('RENEWORD:$$GET1^DIQ(53,+$GET(PENDATA("PATIENT STATUS")),.01),1:$GET(PENDATA("PATIENT STATUS")))
+210 SET XV="|"_$SELECT('RENEWORD:"5) ",1:"")_"Pat.Status: "_$$COMPARE^PSOERUT0("LM",PATSTS,PATSTS,$SELECT('RENEWORD:56,1:53))
+211 IF 'RENEWORD
SET UNDERLN(LINE,41)=2
+212 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
+213 DO BLANKLN^PSOERUT0("LM")
+214 ; - eRx Date Written Date & VA Issue Date
+215 SET XE="Date Written: "_$$COMPARE^PSOERUT0("LM",ERXWRTDT,ERXWRTDT,15)
+216 SET EXTISSDT=$$UP^XLFSTR($GET(PENDATA("ISSUE DATE")))
IF EXTISSDT=""
SET EXTISSDT=$$GET1^DIQ(52.41,ORDIEN,6)
+217 ; - Pending Renewals have the ISSUE DATE in FM format
+218 IF EXTISSDT?7N
SET EXTISSDT=$$FMTE^XLFDT(PENDATA("ISSUE DATE"))
+219 SET XV="|"_$SELECT('RENEWORD:"6) ",1:"1) ")_"Issue Date: "_$$COMPARE^PSOERUT0("LM",EXTISSDT,EXTISSDT,56)
+220 SET UNDERLN(LINE,41)=2
+221 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+222 ; - eRx Effective Date & VA Fill Date
+223 SET XE="Effective Date: "_$$COMPARE^PSOERUT0("LM",ERXEFDT,ERXEFDT,17)
+224 IF $GET(PENDATA("FILL DATE"))'=""
Begin DoDot:1
+225 SET VAFILLDT=PENDATA("FILL DATE")
End DoDot:1
+226 IF '$TEST
Begin DoDot:1
+227 SET VAFILLDT=$$GET1^DIQ(52.41,ORDIEN,6,"I")
IF VAFILLDT>DT
SET VAFILLDT=DT
End DoDot:1
+228 SET XV="|"_$SELECT('RENEWORD:"7) ",1:"2) ")_"Fill Date: "_$$COMPARE^PSOERUT0("LM",$$FMTE^XLFDT(VAFILLDT),$$FMTE^XLFDT(VAFILLDT),55)
+229 SET UNDERLN(LINE,41)=2
+230 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+231 DO BLANKLN^PSOERUT0("LM")
+232 ;
+233 ; - Days Supply
+234 SET VADAYS=$GET(PENDATA("DAYS SUPPLY"))
+235 SET XE="Days Supply: "_$$COMPARE^PSOERUT0("LM",ERXDAYS,VADAYS,14)
+236 SET XV="|"_$SELECT('RENEWORD:"8) ",1:"")_"Days Supply: "_$$COMPARE^PSOERUT0("LM",VADAYS,$SELECT(ERXDAYS:ERXDAYS,1:VADAYS),$SELECT('RENEWORD:57,1:54))
+237 IF 'RENEWORD
SET UNDERLN(LINE,41)=2
+238 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+239 DO BLANKLN^PSOERUT0("LM")
+240 ;
+241 ; - Quantity
+242 SET VAQTY=$GET(PSONEW("QTY"))
+243 SET XE="Quantity: "_$$COMPARE^PSOERUT0("LM",ERXQTY,VAQTY,11)
+244 SET VAQTYUM=$$GET1^DIQ(50,+VADRGIEN,14.5)
+245 SET XV="|"_$SELECT('RENEWORD:"9) ",1:"")_"QTY "_$SELECT(VAQTYUM'="":"("_VAQTYUM_")",1:"")
+246 SET XV=XV_": "_$$COMPARE^PSOERUT0("LM",VAQTY,ERXQTY,$SELECT('RENEWORD:50,1:47)+$SELECT($LENGTH(VAQTYUM):$LENGTH(VAQTYUM)+2,1:0))
+247 IF 'RENEWORD
SET UNDERLN(LINE,41)=2
+248 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+249 ; - Dispense Unit
+250 SET XE="Dispense Unit: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(ERXQTYUM,1,24),$EXTRACT(ERXQTYUM,1,24),16)
+251 SET XV="|"
+252 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+253 IF $LENGTH(ERXQTYUM)>24
Begin DoDot:1
+254 SET XE=$EXTRACT(ERXQTYUM,25,99)
SET XV="|"
DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
End DoDot:1
+255 ;
+256 SET XEI=0
SET XVI=0
SET LMLINE=LINE-1
KILL EARR,VARR
+257 ; - Quantity Qualifier
+258 SET VAQTDMSG=$$GET1^DIQ(50,+VADRGIEN,215)
+259 IF $GET(ERXQTYQ)'=""!($GET(VAQTDMSG)'="")
Begin DoDot:1
+260 SET LMLINE=LMLINE+1
+261 IF $GET(ERXQTYQ)'=""
SET XEI=XEI+1
SET EARR(XEI)="Qty Qualifier: "_$$COMPARE^PSOERUT0("LM",ERXQTYQ,ERXQTYQ,16,,LMLINE)
+262 ; - VistA Dispense Message
+263 IF $GET(VAQTDMSG)'=""
Begin DoDot:2
+264 SET XVI=XVI+1
SET VARR(XVI)="QTY Dispense Message:"
+265 KILL DMARR
DO WRAP^PSOERUT(VAQTDMSG,38,.DMARR)
+266 FOR I=1:1
if '$DATA(DMARR(I))
QUIT
Begin DoDot:3
+267 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VARR(XVI)=" "_DMARR(I,0)
SET HIGUNDLN(LMLINE,42)=$LENGTH(DMARR(I,0))
End DoDot:3
End DoDot:2
End DoDot:1
+268 ;
+269 FOR I=1:1
if ('$DATA(EARR(I))&'$DATA(VARR(I)))
QUIT
Begin DoDot:1
+270 DO ADDLINE^PSOERUT0("LM",NMSPC,$GET(EARR(I)),"|"_$GET(VARR(I)))
End DoDot:1
+271 KILL LMLINE
DO BLANKLN^PSOERUT0("LM")
+272 ;
+273 ; - Number of Refills
+274 SET VAREFS=$SELECT($GET(PENDATA("# OF REFILLS"))'="":PENDATA("# OF REFILLS"),1:$$GET1^DIQ(52.41,ORDIEN,13,"I"))
+275 IF RENEWORD
IF ERXREFS>0
SET ERXREFS=ERXREFS-1
+276 SET XE="Refills: "_$$COMPARE^PSOERUT0("LM",ERXREFS,VAREFS,10)_$SELECT(RENEWORD:" (Renewal)",1:"")
+277 SET XV="|"_$SELECT('RENEWORD:"10) ",1:"3) ")_"Refills: "_$$COMPARE^PSOERUT0("LM",VAREFS,ERXREFS,$SELECT('RENEWORD:54,1:53))
+278 SET UNDERLN(LINE,41)=$SELECT('RENEWORD:3,1:2)
+279 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+280 DO BLANKLN^PSOERUT0("LM")
+281 ;
+282 ; - Routing (Mail/Window)
+283 SET VMAILWIN=$SELECT($GET(PSONEW("MAIL/WINDOW"))="M":"MAIL",$GET(PSONEW("MAIL/WINDOW"))="P":"PARK",1:"WINDOW")
+284 SET XV="|"_$SELECT('RENEWORD:"11) ",1:"4) ")_"Routing: "_$$COMPARE^PSOERUT0("LM",VMAILWIN,VMAILWIN,$SELECT('RENEWORD:54,1:53))
+285 SET UNDERLN(LINE,41)=$SELECT('RENEWORD:3,1:2)
+286 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
+287 DO BLANKLN^PSOERUT0("LM")
+288 ;
+289 ; - Clinic
+290 SET VACLINIC=$SELECT($GET(PENDATA("CLINIC"))'="":$$GET1^DIQ(44,PENDATA("CLINIC"),.01),1:$$GET1^DIQ(52.41,ORDIEN,1.1))
+291 SET XV="|"_$SELECT('RENEWORD:"12) ",1:"5) ")_"Clinic: "_$$COMPARE^PSOERUT0("LM",VACLINIC,VACLINIC,$SELECT('RENEWORD:53,1:52))
+292 SET UNDERLN(LINE,41)=$SELECT('RENEWORD:3,1:2)
+293 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
+294 DO BLANKLN^PSOERUT0("LM")
+295 ;
+296 GOTO EN^PSOERUT6
