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