- 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 Jan 18, 2025@03:29:12 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