PSOERUT2 ;ALB/MFR - eRx Drug on Holding Queue - Listman Utilities; 06/25/2022 5:14pm
;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
;
SETDRUG(MODE,NMSPC,ERXIEN,SUGGEST,RXIEN,SDERXFLG) ; Set ListMan Side-By-Side Section for eRx Vs. User entered data on Holding Queue
;Input: MODE - Display Mode: "RS": Roll & Scroll | "LM": ListMan
; (o)NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1") - Required for LM Mode only
; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; SUGGEST - Suggestion?: 1 - YES (Suggesting an entry - MUST pass in RX # Pointer to #52) | 0 - NO (Actual Record Data)
; (o)RXIEN - Prescription IEN - Pointer to PRESCRIPTION file (#52). SUGGEST must be passed in as 1
; (o)SDERXFLG - Single eRx View/Display Flag - 1: Single eRx View/Display Interface | 0: eRx Holding Queue Interface
; Input Global Variable: LINE - Current ListMan Line # (Default)
; Output Global Variable: (ListMan Mode Only - Set by $$COMPARE^PSOERUT0)
; REVLN - Array Indicating Reverse Video for Line, position and size of the string
; HIGLN - Array Indicating Highlight for Line, position and size of the string
;
S:'$G(LINE) LINE=1 S NMSPC=$G(NMSPC)
N V2017,MTYPE,RSPTYPE,ERXDM,DATA,ERXDRUG,ERXSIG,ERXNOTES,ERXQTY,ERXQTYUM,ERXQTYQ,ERXDAYS,ERXREFS,ERXWRTDT,ERXEFDT,ERXRENS
N VADRGIEN,VAOIIEN,VADRUG,VAPATIEN,RXPATIEN,VAPATINS,VAPRCOMM,VAQTY,VADAYS,VAREFS,VAQTYUM,VADRGMSG,ESIG,VSIG,FSIG,XE,XV
N ERXDFORM,ERXDSTRE,XEI,XVI,I,DMARR,LMLINE,MEDIEN,VDRGLEN,VAPATSTS,VMAILWIN,VACLINIC,NONFORM,PSODIR,INS1,ARR,EARR,VARR
N ERXSUBS,X,EQCOMM,EQDRUG,VAQTDMSG
;
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))
I '$G(MEDIEN) S MEDIEN=1
; eRx Data
D GETS^DIQ(52.49,ERXIEN_",",".05;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)
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 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")
; VistA Drug/Dose/Instructions Data
S (VADRUG,VASIG,VAPATIEN,VAPATINS,VAPRCOMM,VAQTY,VADAYS,VAREFS,VAQTYUM,VADRGMSG,VAQTDMSG,VAPATSTS,VMAILWIN,VACLINIC)=""
S VADRGIEN=+ERXDM(3.2,"I")
I $G(VADRGIEN) D
. S VAPATIEN=ERXDM(.05,"I"),VAPATSTS=$$GET1^DIQ(55,VAPATIEN,3,"E"),VADRUG=ERXDM(3.2,"E")
. S VASIG=$$VISTASIG^PSOERXUT(ERXIEN),VAPATINS=$$GET1^DIQ(52.49,ERXIEN,27),VAPRCOMM=$$GET1^DIQ(52.49,ERXIEN,30)
. S VAQTY=ERXDM(20.1,"E"),VADAYS=ERXDM(20.2,"E"),VMAILWIN=ERXDM(20.4,"E"),VAREFS=ERXDM(20.5,"E"),VACLINIC=ERXDM(20.6,"E")
. S VAQTYUM=$$GET1^DIQ(50,VADRGIEN,14.5),VADRGMSG=$$GET1^DIQ(50,VADRGIEN,101),VAQTDMSG=$$GET1^DIQ(50,VADRGIEN,215)
;
; Non-Formulary
S NONFORM=0 I $G(VADRGIEN),$P(^PSDRUG(VADRGIEN,0),"^",9) S NONFORM=1
;
I $G(RXIEN) D
. S RXPATIEN=+$$GET1^DIQ(52,RXIEN,2,"I"),VADRGIEN=+$$GET1^DIQ(52,RXIEN,6,"I"),VAOIIEN=+$$GET1^DIQ(50,VADRGIEN,2.1,"I")
. S VADRUG=$$GET1^DIQ(50,VADRGIEN,.01)
. ; Rx SIG (from Rx) & Qty fields
. S VASIG=$$SUGSIG^PSOERUT3(RXIEN,ERXIEN)
. S VAQTY=$$GET1^DIQ(52,RXIEN,7),VAQTYUM=$$GET1^DIQ(50,VADRGIEN,14.5)
. S VADRGMSG=$$GET1^DIQ(50,VADRGIEN,101),VAQTDMSG=$$GET1^DIQ(50,VADRGIEN,215)
. ; Days Supply and # of Refills
. S VADAYS=$$GET1^DIQ(52,RXIEN,8)
. S VAREFS=$$GET1^DIQ(52,RXIEN,9)
. ; If #of Refills > Max allowed, sets to Max allowed
. I VAREFS>$$MAXNUMRF^PSOUTIL(VADRGIEN,VADAYS) D
. . S VAREFS=+$$MAXNUMRF^PSOUTIL(VADRGIEN,VADAYS)
. I $G(SUGGEST) D
. . ; VA Provider Comments (from eRx)
. . S VAPRCOMM=$$PROVCOMM^PSOERUT4(ERXNOTES)
;
; - Drug Matching Header Line
I $G(SDERXFLG) D DRUGHDR^PSOERX1H
;
S EQDRUG=0 I ($$CLNSTR^PSOERUT0(ERXDRUG)[$$CLNSTR^PSOERUT0(VADRUG))!($$CLNSTR^PSOERUT0(VADRUG)[$$CLNSTR^PSOERUT0(ERXDRUG)) S EQDRUG=1
S XE="Drug: "_$$COMPARE^PSOERUT0(MODE,$E(ERXDRUG,1,33),$S(EQDRUG:$E(ERXDRUG,1,33),1:""),7,,,'VADRGIEN)
S VDRGLEN=$S($G(SDERXFLG):34,MODE="LM":32,1:33)
S XV="|"_$S($G(SDERXFLG):"",MODE="LM":"1)",1:"")_"Drug: "_$$COMPARE^PSOERUT0(MODE,$E(VADRUG,1,VDRGLEN),$S(EQDRUG:$E(VADRUG,1,VDRGLEN),1:""),$S('$G(SDERXFLG):81-VDRGLEN,1:47))
I MODE="LM",'$G(SDERXFLG) S UNDERLN(LINE,41)=2
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I $L(ERXDRUG)>33!($L(VADRUG)>VDRGLEN) D
. N XEDR,XVDR
. S XEDR=$E(ERXDRUG,34,999),XVDR=$E(VADRUG,VDRGLEN+1,999)
. F Q:(XEDR=""&(XVDR="")) D
. . S XE=" "_$$COMPARE^PSOERUT0(MODE,$E(XEDR,1,33),$S(EQDRUG:$E(XEDR,1,33),1:""),7,,,'VADRGIEN)
. . S XV="|"_$S($G(SDERXFLG):"",MODE="LM":" ",1:"")_" "_$$COMPARE^PSOERUT0(MODE,$E(XVDR,1,VDRGLEN),$S(EQDRUG:$E(XVDR,1,VDRGLEN),1:""),$S('$G(SDERXFLG):81-VDRGLEN,1:47))
. . D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
. . S XEDR=$E(XEDR,34,999),XVDR=$E(XVDR,VDRGLEN+1,999)
S XEI=0,XVI=0,LMLINE=LINE-1 K EARR,VARR
I ERXDFORM'="" D
. S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)="Drug Form: "_$$COMPARE^PSOERUT0(MODE,$E(ERXDFORM,1,28),$E(ERXDFORM,1,28),12,,LMLINE)
. I $L(ERXDFORM)>28 D
. . S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)=" "_$$COMPARE^PSOERUT0(MODE,$E(ERXDFORM,29,56),$E(ERXDFORM,29,56),12,,LMLINE)
. . I $L(ERXDFORM)>56 D
. . . S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)=" "_$$COMPARE^PSOERUT0(MODE,$E(ERXDFORM,57,84),$E(ERXDFORM,57,84),12,,LMLINE)
I ERXDSTRE'="",$$UP^XLFSTR(ERXDSTRE)'="UNSPECIFIED" D
. S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)="Drug Strength: "_$$COMPARE^PSOERUT0(MODE,ERXDSTRE,ERXDSTRE,16,,LMLINE)
S XEI=XEI+1,LMLINE=LMLINE+1,EARR(XEI)="Substitution? "_$$COMPARE^PSOERUT0(MODE,ERXSUBS,$S(ERXSUBS'="":ERXSUBS,1:""),15,,LMLINE)
S EARR(XEI)=EARR(XEI)_" Renewals? "_$$COMPARE^PSOERUT0(MODE,ERXRENS,ERXRENS,$S(ERXSUBS="YES":32,ERXSUBS="NO":31,1:29),,LMLINE)
I NONFORM!($G(VADRGMSG)'="") S LMLINE=LINE-1
I NONFORM D
. S XVI=XVI+1,LMLINE=LMLINE+1,VARR(XVI)=$S($G(SDERXFLG):"",MODE="LM":" ",1:"")_" "_$$COMPARE^PSOERUT0(MODE,"*** NON-FORMULARY ***","*** NON-FORMULARY ***",$S('$G(SDERXFLG):49,1:47),,LMLINE)
I $G(VADRGMSG)'="" D
. S XVI=XVI+1,LMLINE=LMLINE+1,VARR(XVI)="Drug Message:"
. K DMARR D WRAP^PSOERUT(VADRGMSG,38,.DMARR)
. F I=1:1 Q:'$D(DMARR(I)) D
. . S XVI=XVI+1,LMLINE=LMLINE+1,VARR(XVI)=" "_$$COMPARE^PSOERUT0(MODE,DMARR(I,0),DMARR(I,0),42,,LMLINE)
;
F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
. D ADDLINE^PSOERUT0(MODE,NMSPC,$G(EARR(I)),"|"_$G(VARR(I)))
I '$G(SDERXFLG) K LMLINE D BLANKLN^PSOERUT0(MODE)
;
; - eRx SIG
K EARR D WRAP^PSOERUT(ERXSIG,38,.EARR)
; - VistA SIG
K VARR D WRAP^PSOERUT($G(VASIG),39,.VARR)
S XE="SIG:",XV="|SIG:" D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
. S XE=" "_$$COMPARE^PSOERUT0(MODE,$G(EARR(I,0)),$G(EARR(I,0)),2)
. S XV="| "_$$COMPARE^PSOERUT0(MODE,$G(VARR(I,0)),$G(VARR(I,0)),42)
. D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I '$G(SDERXFLG) D BLANKLN^PSOERUT0(MODE)
;
; - Prescriber Drug Use Evaluation (DUE), Dosage and Patient Instructions information
I MODE="LM" D
. D DOSEDUE^PSOERUT7(MODE,NMSPC,ERXIEN,$G(SDERXFLG))
. I '$G(SDERXFLG) D BLANKLN^PSOERUT0(MODE)
;
; - Provider Notes/Comments
I '$G(SUGGEST)!(ERXNOTES'="")!(VAPRCOMM'="") D
. S EQCOMM=0 I $$PROVCOMM^PSOERUT4(ERXNOTES)=VAPRCOMM S EQCOMM=1
. K EARR D WRAP^PSOERUT(ERXNOTES,38,.EARR)
. K VARR D WRAP^PSOERUT($G(VAPRCOMM),38,.VARR)
. S XE="Provider Notes/Comments:",XV="|"_$S($G(SDERXFLG):"",MODE="LM":"4)",1:"")_"Provider Comments:"
. I MODE="LM",'$G(SDERXFLG) S UNDERLN(LINE,41)=2
. D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
. F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
. . S XE=" "_$$COMPARE^PSOERUT0(MODE,$G(EARR(I,0)),$S(EQCOMM:$G(EARR(I,0)),1:$G(VARR(I,0))),2)
. . S XV="| "_$$COMPARE^PSOERUT0(MODE,$G(VARR(I,0)),$S(EQCOMM:$G(VARR(I,0)),1:$G(EARR(I,0))),42)
. . D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
. I '$G(SDERXFLG) D BLANKLN^PSOERUT0(MODE)
; - Patient Status
I (MODE="LM"),'$G(SDERXFLG) D
. S XV="|"_$S($G(SDERXFLG):"",1:"5)")_"Pat. Status: "_$$COMPARE^PSOERUT0(MODE,VAPATSTS,VAPATSTS,56)
. S UNDERLN(LINE,41)=2
. D ADDLINE^PSOERUT0(MODE,NMSPC,"",XV)
. I '$G(SDERXFLG) D BLANKLN^PSOERUT0(MODE)
;
; - Quantity
S XE="Quantity: "_$$COMPARE^PSOERUT0(MODE,ERXQTY,VAQTY,11,,,'VADRGIEN)
S XV="|"_$S($G(SDERXFLG):"",MODE="LM":"6)",1:"")_"Quantity: "_$$COMPARE^PSOERUT0(MODE,VAQTY,ERXQTY,$S($G(SDERXFLG):51,MODE="LM":53,1:51))
I MODE="LM",'$G(SDERXFLG) S UNDERLN(LINE,41)=2
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
; - Dispense Unit
S XE="Dispense Unit: "_$$COMPARE^PSOERUT0(MODE,$E(ERXQTYUM,1,24),$E(ERXQTYUM,1,24),16)
S XV="|"_$S(MODE="LM":" ",1:"")_"Dispense Unit: "_$$COMPARE^PSOERUT0(MODE,$G(VAQTYUM),$G(VAQTYUM),$S(MODE="LM":58,1:56))
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I $L(ERXQTYUM)>24 D
. S XE=$E(ERXQTYUM,25,99),XV="|" D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
;
S XEI=0,XVI=0,LMLINE=LINE-1 K EARR,VARR
; - Quantity Qualifier
I $G(ERXQTYQ)'=""!($G(VAQTDMSG)'="") D
. S LMLINE=LMLINE+1
. I '$G(SUGGEST),$G(ERXQTYQ)'="" S XEI=XEI+1,EARR(XEI)="Qty Qualifier: "_$$COMPARE^PSOERUT0(MODE,ERXQTYQ,ERXQTYQ,16,,LMLINE)
. ; - VistA Dispense Message
. I $G(VAQTDMSG)'="" D
. . S XVI=XVI+1,LMLINE=LMLINE+1,VARR(XVI)="QTY Dispense Message:"
. . K DMARR D WRAP^PSOERUT(VAQTDMSG,38,.DMARR)
. . F I=1:1 Q:'$D(DMARR(I)) D
. . . I MODE="LM" S HIGUNDLN(LMLINE,42)=$L(DMARR(I,0))
. . . E S DMARR(I,0)=$G(IOINHI)_$G(IOUON)_DMARR(I,0)_$G(IOUOFF)_$G(IOINORM)
. . . S XVI=XVI+1,LMLINE=LMLINE+1,VARR(XVI)=" "_DMARR(I,0)
;
F I=1:1 Q:('$D(EARR(I))&'$D(VARR(I))) D
. D ADDLINE^PSOERUT0(MODE,NMSPC,$G(EARR(I)),"|"_$G(VARR(I)))
I '$G(SDERXFLG) K LMLINE D BLANKLN^PSOERUT0(MODE)
;
; - Days Supply & Number of Refills
S XE="Days Supply: "_$$COMPARE^PSOERUT0(MODE,ERXDAYS,VADAYS,14,,,'VADRGIEN)
S $E(XE,$S(MODE="LM"!(ERXDAYS=""):21,1:$L(XE)+6))="Refills: "_$$COMPARE^PSOERUT0(MODE,ERXREFS,VAREFS,30,,,'VADRGIEN)
S XV="|"_$S($G(SDERXFLG):"",MODE="LM":"7)",1:"")_"Days Supply: "_$J($$COMPARE^PSOERUT0(MODE,VADAYS,ERXDAYS,$S($G(SDERXFLG):54,MODE="LM":56,1:54)),$L(VADAYS))
S XV=XV_" "_$S($G(SDERXFLG):"",MODE="LM":"8)",1:"")_"Refills: "_$$COMPARE^PSOERUT0(MODE,VAREFS,ERXREFS,$S($G(SDERXFLG):68,MODE="LM":72,1:70)+$L(VADAYS))
I MODE="LM",'$G(SDERXFLG) S UNDERLN(LINE,41)=2,UNDERLN(LINE,61+$L(VADAYS))=2
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I '$G(SDERXFLG) D BLANKLN^PSOERUT0(MODE)
;
; - Routing (Mail/Window)
I MODE="LM" D
. S XV="|"_$S($G(SDERXFLG):"",1:"9)")_"Routing: "_$$COMPARE^PSOERUT0(MODE,VMAILWIN,VMAILWIN,$S($G(SDERXFLG):50,1:52))
. I '$G(SDERXFLG) S UNDERLN(LINE,41)=2
. D ADDLINE^PSOERUT0(MODE,NMSPC,"",XV)
. I '$G(SDERXFLG) D BLANKLN^PSOERUT0(MODE)
;
; - Clinic
I MODE="LM" D
. S XV="|"_$S($G(SDERXFLG):"",1:"10)")_"Clinic: "_$$COMPARE^PSOERUT0(MODE,VACLINIC,VACLINIC,$S($G(SDERXFLG):49,1:52))
. I MODE="LM",'$G(SDERXFLG) S UNDERLN(LINE,41)=3
. D ADDLINE^PSOERUT0(MODE,NMSPC,"",XV)
. I '$G(SDERXFLG) D BLANKLN^PSOERUT0(MODE)
Q
;
SAVEDRUG(ERXIEN,RXIEN) ; Save eRx Drug Information from VistA Rx (File #52) into the eRx record (File #52.49)
;Input: ERXIEN - eRx IEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; RXIEN - VistA Prescription IEN - Pointer to PRESCRIPTION file (#52)
;
I '$D(^PS(52.49,+$G(ERXIEN),0))!'$D(^PSRX(+$G(RXIEN),0)) Q
N VAPATIEN,VADRGIEN,VAOIIEN,DIE,DA,NEWVAL,MTYPE,ERXSTS,VADOSE,DOSE,UPDARR,VAPATINS,ERR,SIG,SIGARR,ERXSIG
N PSODRUG,VAQTY,VADAYS,VAREFS,I
S VADRGIEN=+$$GET1^DIQ(52,RXIEN,6,"I"),VAOIIEN=+$$GET1^DIQ(50,VADRGIEN,2.1,"I")
; - Updating eRx Audit Log
S NEWVAL(1)=$$GET1^DIQ(50,VADRGIEN,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(VADRGIEN)_")"
D AUDLOG^PSOERXUT(ERXIEN,"DRUG",DUZ,.NEWVAL)
; - Saving VistA Drug
S DIE="^PS(52.49,",DA=ERXIEN,DR="3.2///"_VADRGIEN D ^DIE
;
; - eRx Status Update
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
S ERXSTS=$$GET1^DIQ(52.49,ERXIEN,1,"E")
I ERXSTS="N" D UPDSTAT^PSOERXU1(ERXIEN,"I")
I MTYPE="RE",ERXSTS'="RXI" D UPDSTAT^PSOERXU1(ERXIEN,"RXI")
;
; - Deleting fields related to VA Dispense Drug
F FLD=1.11,1.12,1.5,20.1,20.2,20.3,20.4,20.5,27 S UPDARR(52.49,ERXIEN_",",FLD)="@"
D FILE^DIE(,"UPDARR") K UPDARR
;
; - Updating Audit Log
S NEWVAL(1)=$$PROVCOMM^PSOERUT4($$GET1^DIQ(52.49,ERXIEN,8))
I $G(NEWVAL(1))'="" D AUDLOG^PSOERXUT(ERXIEN,"PROVIDER COMMENTS",DUZ,.NEWVAL)
; - Saving Provider Comments
K UPDARR S UPDARR(52.49,ERXIEN_",",30)=$$PROVCOMM^PSOERUT4($$GET1^DIQ(52.49,ERXIEN,8))
D FILE^DIE(,"UPDARR") K UPDARR
;
; - Saving VA Orderable Item Patient Instructions and Updating Audit Log
S VAPATIEN=+$$GET1^DIQ(52.49,ERXIEN,.05,"I")
S VAPATINS=$$VAPATINS^PSOERUT3(VAOIIEN,VAPATIEN)
I VAPATINS'="" D
. ; - Updating Audit Log
. S NEWVAL(1)=VAPATINS
. D AUDLOG^PSOERXUT(ERXIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
. ; - Saving Provider Comments
. K UPDARR S UPDARR(52.49,ERXIEN_",",27)=VAPATINS
. D FILE^DIE(,"UPDARR") K UPDARR
;
; - Deleting any existing Dosage Information
K VADOSE S DOSE=0 F S DOSE=$O(^PS(52.49,ERXIEN,21,DOSE)) Q:'DOSE D
. S VADOSE(52.4921,DOSE_","_ERXIEN_",",.01)="@" D FILE^DIE(,"VADOSE","ERR") K VADOSE
;
; - Retrieving VistA Rx Dose and Saving to the eRx
K VADOSE D VARXDOSE^PSOERUT4(RXIEN,.VADOSE)
K ERXDOSE
F DOSE=1:1 Q:'$D(VADOSE("DOSE",DOSE)) D
. K ERXDOSE,ERR
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",.01)=VADOSE("DOSE",DOSE)_"&"_VADOSE("NOUN",DOSE)
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",1)=VADOSE("SCHEDULE",DOSE)
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",2)=VADOSE("DURATION",DOSE)
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",6)=$S($G(VADOSE("CONJUNCTION",DOSE))="T":"S",1:$G(VADOSE("CONJUNCTION",DOSE)))
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",7)=+DOSE
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",8)=VADOSE("DOSE",DOSE)
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",9)=VADOSE("DOSE ORDERED",DOSE)
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",10)=VADOSE("ROUTE",DOSE)
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",11)=VADOSE("UNITS",DOSE)
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",12)=VADOSE("NOUN",DOSE)
. S ERXDOSE(52.4921,"+1,"_ERXIEN_",",13)=VADOSE("VERB",DOSE)
. D UPDATE^DIE("","ERXDOSE","ERR","")
;
; - Deleting any existing SIG Information
K SIGARR
S I=0 F S I=$O(^PS(52.49,ERXIEN,"SIG",I)) Q:'I D
. S SIGARR(52.4926,I_","_ERXIEN_",",.01)="@"
I $D(SIGARR) D FILE^DIE(,"SIGARR") K SIGARR
; - Retrieving VistA Rx SIG and Saving to the eRx
S PSODRUG("IEN")=VADRGIEN,PSODRUG("OI")=VAOIIEN
K SIG D EN^PSOFSIG(.VADOSE)
;Saving the eRx Audit Log for the SIG
D AUDLOG^PSOERXUT(+PSOIEN,"SIG",DUZ,.SIG)
K SIGARR
S I=0 F S I=$O(SIG(I)) Q:'I D
. I $G(SIG(I))'="" D
. . S SIGARR(52.4926,"+1,"_ERXIEN_",",.01)=SIG(I)
. . D UPDATE^DIE(,"SIGARR",,"SERR") K SIGARR
;
; - Qty/Days Supply/Route(Mail/Window)/# of Refills/Clinic (Auditing & Saving)
S (VAQTY,NEWVAL(1))=+$$GET1^DIQ(52,RXIEN,7) D AUDLOG^PSOERXUT(ERXIEN,"QTY",DUZ,.NEWVAL)
S (VADAYS,NEWVAL(1))=+$$GET1^DIQ(52,RXIEN,8) D AUDLOG^PSOERXUT(ERXIEN,"DAYS SUPPLY",DUZ,.NEWVAL)
S (VAREFS,NEWVAL(1))=+$$GET1^DIQ(52,RXIEN,9) D AUDLOG^PSOERXUT(ERXIEN,"# OF REFILLS",DUZ,.NEWVAL)
K UPDARR
S UPDARR(52.49,ERXIEN_",",20.1)=+$$GET1^DIQ(52,RXIEN,7)
S UPDARR(52.49,ERXIEN_",",20.2)=$$GET1^DIQ(52,RXIEN,8)
S UPDARR(52.49,ERXIEN_",",20.4)="M"
; If #of Refills > Max allowed, sets to Max allowed
I VAREFS>$$MAXNUMRF^PSOUTIL(VADRGIEN,VADAYS) D
. S VAREFS=+$$MAXNUMRF^PSOUTIL(VADRGIEN,VADAYS)
S UPDARR(52.49,ERXIEN_",",20.5)=VAREFS
I $G(PSOCLNC) D
. S UPDARR(52.49,ERXIEN_",",20.6)=PSOCLNC
E D
. S UPDARR(52.49,ERXIEN_",",20.6)=$$GET1^DIQ(59,PSOSITE,10,"I")
D FILE^DIE(,"UPDARR") K UPDARR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERUT2 16347 printed Dec 13, 2024@02:28:03 Page 2
PSOERUT2 ;ALB/MFR - eRx Drug on Holding Queue - Listman Utilities; 06/25/2022 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
+2 ;
SETDRUG(MODE,NMSPC,ERXIEN,SUGGEST,RXIEN,SDERXFLG) ; Set ListMan Side-By-Side Section for eRx Vs. User entered data on Holding Queue
+1 ;Input: MODE - Display Mode: "RS": Roll & Scroll | "LM": ListMan
+2 ; (o)NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1") - Required for LM Mode only
+3 ; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+4 ; SUGGEST - Suggestion?: 1 - YES (Suggesting an entry - MUST pass in RX # Pointer to #52) | 0 - NO (Actual Record Data)
+5 ; (o)RXIEN - Prescription IEN - Pointer to PRESCRIPTION file (#52). SUGGEST must be passed in as 1
+6 ; (o)SDERXFLG - Single eRx View/Display Flag - 1: Single eRx View/Display Interface | 0: eRx Holding Queue Interface
+7 ; Input Global Variable: LINE - Current ListMan Line # (Default)
+8 ; Output Global Variable: (ListMan Mode Only - Set by $$COMPARE^PSOERUT0)
+9 ; REVLN - Array Indicating Reverse Video for Line, position and size of the string
+10 ; HIGLN - Array Indicating Highlight for Line, position and size of the string
+11 ;
+12 if '$GET(LINE)
SET LINE=1
SET NMSPC=$GET(NMSPC)
+13 NEW V2017,MTYPE,RSPTYPE,ERXDM,DATA,ERXDRUG,ERXSIG,ERXNOTES,ERXQTY,ERXQTYUM,ERXQTYQ,ERXDAYS,ERXREFS,ERXWRTDT,ERXEFDT,ERXRENS
+14 NEW VADRGIEN,VAOIIEN,VADRUG,VAPATIEN,RXPATIEN,VAPATINS,VAPRCOMM,VAQTY,VADAYS,VAREFS,VAQTYUM,VADRGMSG,ESIG,VSIG,FSIG,XE,XV
+15 NEW ERXDFORM,ERXDSTRE,XEI,XVI,I,DMARR,LMLINE,MEDIEN,VDRGLEN,VAPATSTS,VMAILWIN,VACLINIC,NONFORM,PSODIR,INS1,ARR,EARR,VARR
+16 NEW ERXSUBS,X,EQCOMM,EQDRUG,VAQTDMSG
+17 ;
+18 SET V2017=+$$GET1^DIQ(52.49,ERXIEN,312.1,"I")
+19 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+20 SET RSPTYPE=$$GET1^DIQ(52.49,ERXIEN,52.1,"I")
+21 IF V2017
Begin DoDot:1
+22 IF MTYPE="CX"
SET MEDIEN=$ORDER(^PS(52.49,ERXIEN,311,"C","P",0))
+23 IF MTYPE="N"
SET MEDIEN=$ORDER(^PS(52.49,ERXIEN,311,0))
QUIT
+24 IF MTYPE="RE"
IF RSPTYPE="R"
SET MEDIEN=$ORDER(^PS(52.49,ERXIEN,311,"C","MR",0))
End DoDot:1
+25 IF '$GET(MEDIEN)
SET MEDIEN=1
+26 ; eRx Data
+27 DO GETS^DIQ(52.49,ERXIEN_",",".05;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
+28 MERGE ERXDM=DATA(52.49,ERXIEN_",")
+29 SET ERXDRUG=ERXDM(3.1,"E")
SET ERXSIG=$$ERXSIG^PSOERXUT(ERXIEN)
+30 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")
+31 ; eRx Quantity Qualifier
+32 SET ERXQTYQ=ERXDM(5.2,"E")
IF V2017
SET ERXQTYQ=$$GET1^DIQ(52.49311,MEDIEN_","_ERXIEN_",",2.2,"I")
SET ERXQTYQ=$$GET1^DIQ(52.45,ERXQTYQ,.02,"E")
+33 ; Number of Refills
+34 SET ERXREFS=ERXDM(5.6,"E")
IF MTYPE="RE"
IF RSPTYPE="R"
IF ERXREFS>0
SET ERXREFS=$GET(ERXREFS)-1
+35 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")
+36 SET ERXDFORM=ERXDM(41,"E")
SET ERXQTYUM=ERXDM(42,"E")
SET ERXDSTRE=ERXDM(43,"E")
+37 ; VistA Drug/Dose/Instructions Data
+38 SET (VADRUG,VASIG,VAPATIEN,VAPATINS,VAPRCOMM,VAQTY,VADAYS,VAREFS,VAQTYUM,VADRGMSG,VAQTDMSG,VAPATSTS,VMAILWIN,VACLINIC)=""
+39 SET VADRGIEN=+ERXDM(3.2,"I")
+40 IF $GET(VADRGIEN)
Begin DoDot:1
+41 SET VAPATIEN=ERXDM(.05,"I")
SET VAPATSTS=$$GET1^DIQ(55,VAPATIEN,3,"E")
SET VADRUG=ERXDM(3.2,"E")
+42 SET VASIG=$$VISTASIG^PSOERXUT(ERXIEN)
SET VAPATINS=$$GET1^DIQ(52.49,ERXIEN,27)
SET VAPRCOMM=$$GET1^DIQ(52.49,ERXIEN,30)
+43 SET VAQTY=ERXDM(20.1,"E")
SET VADAYS=ERXDM(20.2,"E")
SET VMAILWIN=ERXDM(20.4,"E")
SET VAREFS=ERXDM(20.5,"E")
SET VACLINIC=ERXDM(20.6,"E")
+44 SET VAQTYUM=$$GET1^DIQ(50,VADRGIEN,14.5)
SET VADRGMSG=$$GET1^DIQ(50,VADRGIEN,101)
SET VAQTDMSG=$$GET1^DIQ(50,VADRGIEN,215)
End DoDot:1
+45 ;
+46 ; Non-Formulary
+47 SET NONFORM=0
IF $GET(VADRGIEN)
IF $PIECE(^PSDRUG(VADRGIEN,0),"^",9)
SET NONFORM=1
+48 ;
+49 IF $GET(RXIEN)
Begin DoDot:1
+50 SET RXPATIEN=+$$GET1^DIQ(52,RXIEN,2,"I")
SET VADRGIEN=+$$GET1^DIQ(52,RXIEN,6,"I")
SET VAOIIEN=+$$GET1^DIQ(50,VADRGIEN,2.1,"I")
+51 SET VADRUG=$$GET1^DIQ(50,VADRGIEN,.01)
+52 ; Rx SIG (from Rx) & Qty fields
+53 SET VASIG=$$SUGSIG^PSOERUT3(RXIEN,ERXIEN)
+54 SET VAQTY=$$GET1^DIQ(52,RXIEN,7)
SET VAQTYUM=$$GET1^DIQ(50,VADRGIEN,14.5)
+55 SET VADRGMSG=$$GET1^DIQ(50,VADRGIEN,101)
SET VAQTDMSG=$$GET1^DIQ(50,VADRGIEN,215)
+56 ; Days Supply and # of Refills
+57 SET VADAYS=$$GET1^DIQ(52,RXIEN,8)
+58 SET VAREFS=$$GET1^DIQ(52,RXIEN,9)
+59 ; If #of Refills > Max allowed, sets to Max allowed
+60 IF VAREFS>$$MAXNUMRF^PSOUTIL(VADRGIEN,VADAYS)
Begin DoDot:2
+61 SET VAREFS=+$$MAXNUMRF^PSOUTIL(VADRGIEN,VADAYS)
End DoDot:2
+62 IF $GET(SUGGEST)
Begin DoDot:2
+63 ; VA Provider Comments (from eRx)
+64 SET VAPRCOMM=$$PROVCOMM^PSOERUT4(ERXNOTES)
End DoDot:2
End DoDot:1
+65 ;
+66 ; - Drug Matching Header Line
+67 IF $GET(SDERXFLG)
DO DRUGHDR^PSOERX1H
+68 ;
+69 SET EQDRUG=0
IF ($$CLNSTR^PSOERUT0(ERXDRUG)[$$CLNSTR^PSOERUT0(VADRUG))!($$CLNSTR^PSOERUT0(VADRUG)[$$CLNSTR^PSOERUT0(ERXDRUG))
SET EQDRUG=1
+70 SET XE="Drug: "_$$COMPARE^PSOERUT0(MODE,$EXTRACT(ERXDRUG,1,33),$SELECT(EQDRUG:$EXTRACT(ERXDRUG,1,33),1:""),7,,,'VADRGIEN)
+71 SET VDRGLEN=$SELECT($GET(SDERXFLG):34,MODE="LM":32,1:33)
+72 SET XV="|"_$SELECT($GET(SDERXFLG):"",MODE="LM":"1)",1:"")_"Drug: "_$$COMPARE^PSOERUT0(MODE,$EXTRACT(VADRUG,1,VDRGLEN),$SELECT(EQDRUG:$EXTRACT(VADRUG,1,VDRGLEN),1:""),$SELECT('$GET(SDERXFLG):81-VDRGLEN,1:47))
+73 IF MODE="LM"
IF '$GET(SDERXFLG)
SET UNDERLN(LINE,41)=2
+74 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+75 IF $LENGTH(ERXDRUG)>33!($LENGTH(VADRUG)>VDRGLEN)
Begin DoDot:1
+76 NEW XEDR,XVDR
+77 SET XEDR=$EXTRACT(ERXDRUG,34,999)
SET XVDR=$EXTRACT(VADRUG,VDRGLEN+1,999)
+78 FOR
if (XEDR=""&(XVDR=""))
QUIT
Begin DoDot:2
+79 SET XE=" "_$$COMPARE^PSOERUT0(MODE,$EXTRACT(XEDR,1,33),$SELECT(EQDRUG:$EXTRACT(XEDR,1,33),1:""),7,,,'VADRGIEN)
+80 SET XV="|"_$SELECT($GET(SDERXFLG):"",MODE="LM":" ",1:"")_" "_$$COMPARE^PSOERUT0(MODE,$EXTRACT(XVDR,1,VDRGLEN),$SELECT(EQDRUG:$EXTRACT(XVDR,1,VDRGLEN),1:""),$SELECT('$GET(SDERXFLG):81-VDRGLEN,1:47))
+81 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+82 SET XEDR=$EXTRACT(XEDR,34,999)
SET XVDR=$EXTRACT(XVDR,VDRGLEN+1,999)
End DoDot:2
End DoDot:1
+83 SET XEI=0
SET XVI=0
SET LMLINE=LINE-1
KILL EARR,VARR
+84 IF ERXDFORM'=""
Begin DoDot:1
+85 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET EARR(XEI)="Drug Form: "_$$COMPARE^PSOERUT0(MODE,$EXTRACT(ERXDFORM,1,28),$EXTRACT(ERXDFORM,1,28),12,,LMLINE)
+86 IF $LENGTH(ERXDFORM)>28
Begin DoDot:2
+87 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET EARR(XEI)=" "_$$COMPARE^PSOERUT0(MODE,$EXTRACT(ERXDFORM,29,56),$EXTRACT(ERXDFORM,29,56),12,,LMLINE)
+88 IF $LENGTH(ERXDFORM)>56
Begin DoDot:3
+89 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET EARR(XEI)=" "_$$COMPARE^PSOERUT0(MODE,$EXTRACT(ERXDFORM,57,84),$EXTRACT(ERXDFORM,57,84),12,,LMLINE)
End DoDot:3
End DoDot:2
End DoDot:1
+90 IF ERXDSTRE'=""
IF $$UP^XLFSTR(ERXDSTRE)'="UNSPECIFIED"
Begin DoDot:1
+91 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET EARR(XEI)="Drug Strength: "_$$COMPARE^PSOERUT0(MODE,ERXDSTRE,ERXDSTRE,16,,LMLINE)
End DoDot:1
+92 SET XEI=XEI+1
SET LMLINE=LMLINE+1
SET EARR(XEI)="Substitution? "_$$COMPARE^PSOERUT0(MODE,ERXSUBS,$SELECT(ERXSUBS'="":ERXSUBS,1:""),15,,LMLINE)
+93 SET EARR(XEI)=EARR(XEI)_" Renewals? "_$$COMPARE^PSOERUT0(MODE,ERXRENS,ERXRENS,$SELECT(ERXSUBS="YES":32,ERXSUBS="NO":31,1:29),,LMLINE)
+94 IF NONFORM!($GET(VADRGMSG)'="")
SET LMLINE=LINE-1
+95 IF NONFORM
Begin DoDot:1
+96 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VARR(XVI)=$SELECT($GET(SDERXFLG):"",MODE="LM":" ",1:"")_" "_$$COMPARE^PSOERUT0(MODE,"*** NON-FORMULARY ***","*** NON-FORMULARY ***",$SELECT('$GET(SDERXFLG):49,1:47),,LMLINE)
End DoDot:1
+97 IF $GET(VADRGMSG)'=""
Begin DoDot:1
+98 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VARR(XVI)="Drug Message:"
+99 KILL DMARR
DO WRAP^PSOERUT(VADRGMSG,38,.DMARR)
+100 FOR I=1:1
if '$DATA(DMARR(I))
QUIT
Begin DoDot:2
+101 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VARR(XVI)=" "_$$COMPARE^PSOERUT0(MODE,DMARR(I,0),DMARR(I,0),42,,LMLINE)
End DoDot:2
End DoDot:1
+102 ;
+103 FOR I=1:1
if ('$DATA(EARR(I))&'$DATA(VARR(I)))
QUIT
Begin DoDot:1
+104 DO ADDLINE^PSOERUT0(MODE,NMSPC,$GET(EARR(I)),"|"_$GET(VARR(I)))
End DoDot:1
+105 IF '$GET(SDERXFLG)
KILL LMLINE
DO BLANKLN^PSOERUT0(MODE)
+106 ;
+107 ; - eRx SIG
+108 KILL EARR
DO WRAP^PSOERUT(ERXSIG,38,.EARR)
+109 ; - VistA SIG
+110 KILL VARR
DO WRAP^PSOERUT($GET(VASIG),39,.VARR)
+111 SET XE="SIG:"
SET XV="|SIG:"
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+112 FOR I=1:1
if ('$DATA(EARR(I))&'$DATA(VARR(I)))
QUIT
Begin DoDot:1
+113 SET XE=" "_$$COMPARE^PSOERUT0(MODE,$GET(EARR(I,0)),$GET(EARR(I,0)),2)
+114 SET XV="| "_$$COMPARE^PSOERUT0(MODE,$GET(VARR(I,0)),$GET(VARR(I,0)),42)
+115 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+116 IF '$GET(SDERXFLG)
DO BLANKLN^PSOERUT0(MODE)
+117 ;
+118 ; - Prescriber Drug Use Evaluation (DUE), Dosage and Patient Instructions information
+119 IF MODE="LM"
Begin DoDot:1
+120 DO DOSEDUE^PSOERUT7(MODE,NMSPC,ERXIEN,$GET(SDERXFLG))
+121 IF '$GET(SDERXFLG)
DO BLANKLN^PSOERUT0(MODE)
End DoDot:1
+122 ;
+123 ; - Provider Notes/Comments
+124 IF '$GET(SUGGEST)!(ERXNOTES'="")!(VAPRCOMM'="")
Begin DoDot:1
+125 SET EQCOMM=0
IF $$PROVCOMM^PSOERUT4(ERXNOTES)=VAPRCOMM
SET EQCOMM=1
+126 KILL EARR
DO WRAP^PSOERUT(ERXNOTES,38,.EARR)
+127 KILL VARR
DO WRAP^PSOERUT($GET(VAPRCOMM),38,.VARR)
+128 SET XE="Provider Notes/Comments:"
SET XV="|"_$SELECT($GET(SDERXFLG):"",MODE="LM":"4)",1:"")_"Provider Comments:"
+129 IF MODE="LM"
IF '$GET(SDERXFLG)
SET UNDERLN(LINE,41)=2
+130 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+131 FOR I=1:1
if ('$DATA(EARR(I))&'$DATA(VARR(I)))
QUIT
Begin DoDot:2
+132 SET XE=" "_$$COMPARE^PSOERUT0(MODE,$GET(EARR(I,0)),$SELECT(EQCOMM:$GET(EARR(I,0)),1:$GET(VARR(I,0))),2)
+133 SET XV="| "_$$COMPARE^PSOERUT0(MODE,$GET(VARR(I,0)),$SELECT(EQCOMM:$GET(VARR(I,0)),1:$GET(EARR(I,0))),42)
+134 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:2
+135 IF '$GET(SDERXFLG)
DO BLANKLN^PSOERUT0(MODE)
End DoDot:1
+136 ; - Patient Status
+137 IF (MODE="LM")
IF '$GET(SDERXFLG)
Begin DoDot:1
+138 SET XV="|"_$SELECT($GET(SDERXFLG):"",1:"5)")_"Pat. Status: "_$$COMPARE^PSOERUT0(MODE,VAPATSTS,VAPATSTS,56)
+139 SET UNDERLN(LINE,41)=2
+140 DO ADDLINE^PSOERUT0(MODE,NMSPC,"",XV)
+141 IF '$GET(SDERXFLG)
DO BLANKLN^PSOERUT0(MODE)
End DoDot:1
+142 ;
+143 ; - Quantity
+144 SET XE="Quantity: "_$$COMPARE^PSOERUT0(MODE,ERXQTY,VAQTY,11,,,'VADRGIEN)
+145 SET XV="|"_$SELECT($GET(SDERXFLG):"",MODE="LM":"6)",1:"")_"Quantity: "_$$COMPARE^PSOERUT0(MODE,VAQTY,ERXQTY,$SELECT($GET(SDERXFLG):51,MODE="LM":53,1:51))
+146 IF MODE="LM"
IF '$GET(SDERXFLG)
SET UNDERLN(LINE,41)=2
+147 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+148 ; - Dispense Unit
+149 SET XE="Dispense Unit: "_$$COMPARE^PSOERUT0(MODE,$EXTRACT(ERXQTYUM,1,24),$EXTRACT(ERXQTYUM,1,24),16)
+150 SET XV="|"_$SELECT(MODE="LM":" ",1:"")_"Dispense Unit: "_$$COMPARE^PSOERUT0(MODE,$GET(VAQTYUM),$GET(VAQTYUM),$SELECT(MODE="LM":58,1:56))
+151 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+152 IF $LENGTH(ERXQTYUM)>24
Begin DoDot:1
+153 SET XE=$EXTRACT(ERXQTYUM,25,99)
SET XV="|"
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+154 ;
+155 SET XEI=0
SET XVI=0
SET LMLINE=LINE-1
KILL EARR,VARR
+156 ; - Quantity Qualifier
+157 IF $GET(ERXQTYQ)'=""!($GET(VAQTDMSG)'="")
Begin DoDot:1
+158 SET LMLINE=LMLINE+1
+159 IF '$GET(SUGGEST)
IF $GET(ERXQTYQ)'=""
SET XEI=XEI+1
SET EARR(XEI)="Qty Qualifier: "_$$COMPARE^PSOERUT0(MODE,ERXQTYQ,ERXQTYQ,16,,LMLINE)
+160 ; - VistA Dispense Message
+161 IF $GET(VAQTDMSG)'=""
Begin DoDot:2
+162 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VARR(XVI)="QTY Dispense Message:"
+163 KILL DMARR
DO WRAP^PSOERUT(VAQTDMSG,38,.DMARR)
+164 FOR I=1:1
if '$DATA(DMARR(I))
QUIT
Begin DoDot:3
+165 IF MODE="LM"
SET HIGUNDLN(LMLINE,42)=$LENGTH(DMARR(I,0))
+166 IF '$TEST
SET DMARR(I,0)=$GET(IOINHI)_$GET(IOUON)_DMARR(I,0)_$GET(IOUOFF)_$GET(IOINORM)
+167 SET XVI=XVI+1
SET LMLINE=LMLINE+1
SET VARR(XVI)=" "_DMARR(I,0)
End DoDot:3
End DoDot:2
End DoDot:1
+168 ;
+169 FOR I=1:1
if ('$DATA(EARR(I))&'$DATA(VARR(I)))
QUIT
Begin DoDot:1
+170 DO ADDLINE^PSOERUT0(MODE,NMSPC,$GET(EARR(I)),"|"_$GET(VARR(I)))
End DoDot:1
+171 IF '$GET(SDERXFLG)
KILL LMLINE
DO BLANKLN^PSOERUT0(MODE)
+172 ;
+173 ; - Days Supply & Number of Refills
+174 SET XE="Days Supply: "_$$COMPARE^PSOERUT0(MODE,ERXDAYS,VADAYS,14,,,'VADRGIEN)
+175 SET $EXTRACT(XE,$SELECT(MODE="LM"!(ERXDAYS=""):21,1:$LENGTH(XE)+6))="Refills: "_$$COMPARE^PSOERUT0(MODE,ERXREFS,VAREFS,30,,,'VADRGIEN)
+176 SET XV="|"_$SELECT($GET(SDERXFLG):"",MODE="LM":"7)",1:"")_"Days Supply: "_$JUSTIFY($$COMPARE^PSOERUT0(MODE,VADAYS,ERXDAYS,$SELECT($GET(SDERXFLG):54,MODE="LM":56,1:54)),$LENGTH(VADAYS))
+177 SET XV=XV_" "_$SELECT($GET(SDERXFLG):"",MODE="LM":"8)",1:"")_"Refills: "_$$COMPARE^PSOERUT0(MODE,VAREFS,ERXREFS,$SELECT($GET(SDERXFLG):68,MODE="LM":72,1:70)+$LENGTH(VADAYS))
+178 IF MODE="LM"
IF '$GET(SDERXFLG)
SET UNDERLN(LINE,41)=2
SET UNDERLN(LINE,61+$LENGTH(VADAYS))=2
+179 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+180 IF '$GET(SDERXFLG)
DO BLANKLN^PSOERUT0(MODE)
+181 ;
+182 ; - Routing (Mail/Window)
+183 IF MODE="LM"
Begin DoDot:1
+184 SET XV="|"_$SELECT($GET(SDERXFLG):"",1:"9)")_"Routing: "_$$COMPARE^PSOERUT0(MODE,VMAILWIN,VMAILWIN,$SELECT($GET(SDERXFLG):50,1:52))
+185 IF '$GET(SDERXFLG)
SET UNDERLN(LINE,41)=2
+186 DO ADDLINE^PSOERUT0(MODE,NMSPC,"",XV)
+187 IF '$GET(SDERXFLG)
DO BLANKLN^PSOERUT0(MODE)
End DoDot:1
+188 ;
+189 ; - Clinic
+190 IF MODE="LM"
Begin DoDot:1
+191 SET XV="|"_$SELECT($GET(SDERXFLG):"",1:"10)")_"Clinic: "_$$COMPARE^PSOERUT0(MODE,VACLINIC,VACLINIC,$SELECT($GET(SDERXFLG):49,1:52))
+192 IF MODE="LM"
IF '$GET(SDERXFLG)
SET UNDERLN(LINE,41)=3
+193 DO ADDLINE^PSOERUT0(MODE,NMSPC,"",XV)
+194 IF '$GET(SDERXFLG)
DO BLANKLN^PSOERUT0(MODE)
End DoDot:1
+195 QUIT
+196 ;
SAVEDRUG(ERXIEN,RXIEN) ; Save eRx Drug Information from VistA Rx (File #52) into the eRx record (File #52.49)
+1 ;Input: ERXIEN - eRx IEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ; RXIEN - VistA Prescription IEN - Pointer to PRESCRIPTION file (#52)
+3 ;
+4 IF '$DATA(^PS(52.49,+$GET(ERXIEN),0))!'$DATA(^PSRX(+$GET(RXIEN),0))
QUIT
+5 NEW VAPATIEN,VADRGIEN,VAOIIEN,DIE,DA,NEWVAL,MTYPE,ERXSTS,VADOSE,DOSE,UPDARR,VAPATINS,ERR,SIG,SIGARR,ERXSIG
+6 NEW PSODRUG,VAQTY,VADAYS,VAREFS,I
+7 SET VADRGIEN=+$$GET1^DIQ(52,RXIEN,6,"I")
SET VAOIIEN=+$$GET1^DIQ(50,VADRGIEN,2.1,"I")
+8 ; - Updating eRx Audit Log
+9 SET NEWVAL(1)=$$GET1^DIQ(50,VADRGIEN,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(VADRGIEN)_")"
+10 DO AUDLOG^PSOERXUT(ERXIEN,"DRUG",DUZ,.NEWVAL)
+11 ; - Saving VistA Drug
+12 SET DIE="^PS(52.49,"
SET DA=ERXIEN
SET DR="3.2///"_VADRGIEN
DO ^DIE
+13 ;
+14 ; - eRx Status Update
+15 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+16 SET ERXSTS=$$GET1^DIQ(52.49,ERXIEN,1,"E")
+17 IF ERXSTS="N"
DO UPDSTAT^PSOERXU1(ERXIEN,"I")
+18 IF MTYPE="RE"
IF ERXSTS'="RXI"
DO UPDSTAT^PSOERXU1(ERXIEN,"RXI")
+19 ;
+20 ; - Deleting fields related to VA Dispense Drug
+21 FOR FLD=1.11,1.12,1.5,20.1,20.2,20.3,20.4,20.5,27
SET UPDARR(52.49,ERXIEN_",",FLD)="@"
+22 DO FILE^DIE(,"UPDARR")
KILL UPDARR
+23 ;
+24 ; - Updating Audit Log
+25 SET NEWVAL(1)=$$PROVCOMM^PSOERUT4($$GET1^DIQ(52.49,ERXIEN,8))
+26 IF $GET(NEWVAL(1))'=""
DO AUDLOG^PSOERXUT(ERXIEN,"PROVIDER COMMENTS",DUZ,.NEWVAL)
+27 ; - Saving Provider Comments
+28 KILL UPDARR
SET UPDARR(52.49,ERXIEN_",",30)=$$PROVCOMM^PSOERUT4($$GET1^DIQ(52.49,ERXIEN,8))
+29 DO FILE^DIE(,"UPDARR")
KILL UPDARR
+30 ;
+31 ; - Saving VA Orderable Item Patient Instructions and Updating Audit Log
+32 SET VAPATIEN=+$$GET1^DIQ(52.49,ERXIEN,.05,"I")
+33 SET VAPATINS=$$VAPATINS^PSOERUT3(VAOIIEN,VAPATIEN)
+34 IF VAPATINS'=""
Begin DoDot:1
+35 ; - Updating Audit Log
+36 SET NEWVAL(1)=VAPATINS
+37 DO AUDLOG^PSOERXUT(ERXIEN,"PATIENT INSTRUCTIONS",DUZ,.NEWVAL)
+38 ; - Saving Provider Comments
+39 KILL UPDARR
SET UPDARR(52.49,ERXIEN_",",27)=VAPATINS
+40 DO FILE^DIE(,"UPDARR")
KILL UPDARR
End DoDot:1
+41 ;
+42 ; - Deleting any existing Dosage Information
+43 KILL VADOSE
SET DOSE=0
FOR
SET DOSE=$ORDER(^PS(52.49,ERXIEN,21,DOSE))
if 'DOSE
QUIT
Begin DoDot:1
+44 SET VADOSE(52.4921,DOSE_","_ERXIEN_",",.01)="@"
DO FILE^DIE(,"VADOSE","ERR")
KILL VADOSE
End DoDot:1
+45 ;
+46 ; - Retrieving VistA Rx Dose and Saving to the eRx
+47 KILL VADOSE
DO VARXDOSE^PSOERUT4(RXIEN,.VADOSE)
+48 KILL ERXDOSE
+49 FOR DOSE=1:1
if '$DATA(VADOSE("DOSE",DOSE))
QUIT
Begin DoDot:1
+50 KILL ERXDOSE,ERR
+51 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",.01)=VADOSE("DOSE",DOSE)_"&"_VADOSE("NOUN",DOSE)
+52 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",1)=VADOSE("SCHEDULE",DOSE)
+53 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",2)=VADOSE("DURATION",DOSE)
+54 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",6)=$SELECT($GET(VADOSE("CONJUNCTION",DOSE))="T":"S",1:$GET(VADOSE("CONJUNCTION",DOSE)))
+55 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",7)=+DOSE
+56 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",8)=VADOSE("DOSE",DOSE)
+57 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",9)=VADOSE("DOSE ORDERED",DOSE)
+58 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",10)=VADOSE("ROUTE",DOSE)
+59 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",11)=VADOSE("UNITS",DOSE)
+60 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",12)=VADOSE("NOUN",DOSE)
+61 SET ERXDOSE(52.4921,"+1,"_ERXIEN_",",13)=VADOSE("VERB",DOSE)
+62 DO UPDATE^DIE("","ERXDOSE","ERR","")
End DoDot:1
+63 ;
+64 ; - Deleting any existing SIG Information
+65 KILL SIGARR
+66 SET I=0
FOR
SET I=$ORDER(^PS(52.49,ERXIEN,"SIG",I))
if 'I
QUIT
Begin DoDot:1
+67 SET SIGARR(52.4926,I_","_ERXIEN_",",.01)="@"
End DoDot:1
+68 IF $DATA(SIGARR)
DO FILE^DIE(,"SIGARR")
KILL SIGARR
+69 ; - Retrieving VistA Rx SIG and Saving to the eRx
+70 SET PSODRUG("IEN")=VADRGIEN
SET PSODRUG("OI")=VAOIIEN
+71 KILL SIG
DO EN^PSOFSIG(.VADOSE)
+72 ;Saving the eRx Audit Log for the SIG
+73 DO AUDLOG^PSOERXUT(+PSOIEN,"SIG",DUZ,.SIG)
+74 KILL SIGARR
+75 SET I=0
FOR
SET I=$ORDER(SIG(I))
if 'I
QUIT
Begin DoDot:1
+76 IF $GET(SIG(I))'=""
Begin DoDot:2
+77 SET SIGARR(52.4926,"+1,"_ERXIEN_",",.01)=SIG(I)
+78 DO UPDATE^DIE(,"SIGARR",,"SERR")
KILL SIGARR
End DoDot:2
End DoDot:1
+79 ;
+80 ; - Qty/Days Supply/Route(Mail/Window)/# of Refills/Clinic (Auditing & Saving)
+81 SET (VAQTY,NEWVAL(1))=+$$GET1^DIQ(52,RXIEN,7)
DO AUDLOG^PSOERXUT(ERXIEN,"QTY",DUZ,.NEWVAL)
+82 SET (VADAYS,NEWVAL(1))=+$$GET1^DIQ(52,RXIEN,8)
DO AUDLOG^PSOERXUT(ERXIEN,"DAYS SUPPLY",DUZ,.NEWVAL)
+83 SET (VAREFS,NEWVAL(1))=+$$GET1^DIQ(52,RXIEN,9)
DO AUDLOG^PSOERXUT(ERXIEN,"# OF REFILLS",DUZ,.NEWVAL)
+84 KILL UPDARR
+85 SET UPDARR(52.49,ERXIEN_",",20.1)=+$$GET1^DIQ(52,RXIEN,7)
+86 SET UPDARR(52.49,ERXIEN_",",20.2)=$$GET1^DIQ(52,RXIEN,8)
+87 SET UPDARR(52.49,ERXIEN_",",20.4)="M"
+88 ; If #of Refills > Max allowed, sets to Max allowed
+89 IF VAREFS>$$MAXNUMRF^PSOUTIL(VADRGIEN,VADAYS)
Begin DoDot:1
+90 SET VAREFS=+$$MAXNUMRF^PSOUTIL(VADRGIEN,VADAYS)
End DoDot:1
+91 SET UPDARR(52.49,ERXIEN_",",20.5)=VAREFS
+92 IF $GET(PSOCLNC)
Begin DoDot:1
+93 SET UPDARR(52.49,ERXIEN_",",20.6)=PSOCLNC
End DoDot:1
+94 IF '$TEST
Begin DoDot:1
+95 SET UPDARR(52.49,ERXIEN_",",20.6)=$$GET1^DIQ(59,PSOSITE,10,"I")
End DoDot:1
+96 DO FILE^DIE(,"UPDARR")
KILL UPDARR
+97 QUIT
