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