- PSOERUT5 ;ALB/MFR - eRx & Pending Order Side-by-Side LM Display; 06/25/2023 5:14pm
- ;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
- ;
- 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 '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 16100 printed Feb 18, 2025@23:54:33 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,769**;DEC 1997;Build 26
- +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 '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