PSOERUT6 ;ALB/MFR - eRx & Pending Order Side-by-Side LM Display - Cont'd; 06/25/2023 5:14pm
;;7.0;OUTPATIENT PHARMACY;**700,746,769,770**;DEC 1997;Build 145
;
EN ; Continuation of PSOERUT5 due to routine size limit
;
; - Provider
S XE="Provider: "_$$COMPARE^PSOERUT0("LM",$E(ERXPRVNM,1,29),PENDATA("PROVIDER NAME"),11)
S XV="|"_$S('RENEWORD:"13) ",1:"6) ")_"Provider: "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("PROVIDER NAME"),1,26),ERXPRVNM,$S('RENEWORD:55,1:54))
S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
S PRVIEN=$S($G(PENDATA("PROVIDER")):PENDATA("PROVIDER"),1:$$GET1^DIQ(52.41,ORDIEN,5,"I"))
I $G(PKI),+$G(DRUGDATA("DEA"))>1,+$G(DRUGDATA("DEA"))<6 D
. D CSPRV^PSOERUT4(PRVIEN,+VADRGIEN,$$GET1^DIQ(52.41,ORDIEN,.01,"I"))
I $$GET1^DIQ(200,PRVIEN,53.7,"I"),$$GET1^DIQ(200,PRVIEN,53.8,"I") D
. S XV="|Cos-Provider: "_$$COMPARE^PSOERUT0("LM",$$GET1^DIQ(200,PRVIEN,53.8),$$GET1^DIQ(200,PRVIEN,53.8),55)
. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
D BLANKLN^PSOERUT0("LM")
;
; - Copies
N COPIES
S COPIES=$S($G(PENDATA("COPIES")):PENDATA("COPIES"),1:1)
S XV="|"_$S('RENEWORD:"14) ",1:"7) ")_"Copies: "_$$COMPARE^PSOERUT0("LM",COPIES,COPIES,$S('RENEWORD:53,1:52))
S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
D BLANKLN^PSOERUT0("LM")
;
; - Remarks
S XV="|"_$S('RENEWORD:"15) ",1:"8) ")_"Remarks: "
S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
K VARR D WRAP^PSOERUT($G(PSONEW("REMARKS")),38,.VARR)
F I=1:1 Q:'$D(VARR(I)) D
. I $G(VARR(I,0))="" Q
. D ADDLINE^PSOERUT0("LM",NMSPC,"","| "_$$COMPARE^PSOERUT0("LM",VARR(I,0),VARR(I,0),42))
D BLANKLN^PSOERUT0("LM")
; - Diagnostics
D SETDIAGS^PSOERUT3("LM",NMSPC,ERXIEN,"PEN")
D BLANKLN^PSOERUT0("LM",0)
;
; - DEA compliance note for eRx CS prescriptions
I $$GET1^DIQ(52.49,ERXIEN,95.1,"I"),$$CS^PSOERXA0(VADRGIEN) D
. D BLANKLN^PSOERUT0("LM",1)
. S XE=" This prescription meets the requirements of the Drug Enforcement Administration"
. D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
. S XE=" (DEA) electronic prescribing for controlled substances rules (21 CFR Parts"
. D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
. S XE=" 1300, 1304, 1306, & 1311)."
. D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
. D BLANKLN^PSOERUT0("LM",1)
;
; - Entry Accepted by/date/time
S ACCDTBY=$$ACCDTBY^PSOERUT4(ERXIEN)
S XX=" eRx Received on "_$P($$FMTE^XLFDT($$GET1^DIQ(52.49,ERXIEN,.03,"I"),"2Y"),":",1,2)
S XX=XX_" | Accepted by "_$E($P(ACCDTBY,"^",2),1,17)_" on "_$P($P(ACCDTBY,"^",1),":",1,2)
S XX=$E(XX,1,80),XE="",$E(XE,(80-$L(XX))\2+1)=XX
D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
Q
;
VISTAPAT(ERXIEN) ; Returns the VistA Patient For Responses that pass through the eRx Holding Queue w/out matching/validation
; Input: ERXIEN - Pointer to the ERX HOLDING QUEUE (#52.49)
;Output: VISTAPAT - Pointer to the PATIENT file (#2) associated with the eRx
N VISTAPAT,MTYPE,REQIEN,NEWRXIEN
S VISTAPAT=+$$GET1^DIQ(52.49,ERXIEN,.05,"I")
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
I 'VISTAPAT,"RR,CA,"[MTYPE D
. S NEWRXIEN=$$RESOLV^PSOERXU2(ERXIEN)
. S VISTAPAT=+$$GET1^DIQ(52.49,NEWRXIEN,.05,"I")
I 'VISTAPAT,"RE,CN,IE,"[MTYPE D
. S REQIEN=$$RESOLV^PSOERXU2(ERXIEN) Q:'REQIEN
. S VISTAPAT=+$$GET1^DIQ(52.49,REQIEN,.05,"I") I VISTAPAT Q
. S NEWRXIEN=$$RESOLV^PSOERXU2(REQIEN)
. S VISTAPAT=+$$GET1^DIQ(52.49,NEWRXIEN,.05,"I")
Q VISTAPAT
;
CSERX(ORD) ; Check whether a Pending Order is for a CS eRx
; Input: ORD - Pointer to OUTPATIENT PENDING ORDER file (#52.41)
I $$ERXIEN^PSOERXUT(ORD_"P"),$$CSDRG(+$$GET1^DIQ(52.41,+ORD,11,"I")) D Q 1
. S VALMSG="Only the 'Routing' field can be edited (CS eRx).",VALMBCK="R" W $C(7)
Q 0
;
CSDRG(DRGIEN) ; Controlled Substance drug?
; Input: DRGIEN - Pointer to DRUG file (#50)
;Output: $$CS - 1:YES / 0:NO
N DEA
Q:'DRGIEN 0
S DEA=$$GET1^DIQ(50,DRGIEN,3)
I (DEA'["0"),(DEA'["M"),(DEA["2")!(DEA["3")!(DEA["4")!(DEA["5") Q 1
Q 0
;
VS(ERXIEN,TYPE) ; View Suggestion(s)
;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; TYPE - Type of Suggestion("PA": Patient;"PR": Provider;"DR": Drug)
N ERXPAT,ERXPRV,DRUGHASH,ERX,VPRV,VPAT,RDAT,VPRVOK,VPATOK
S VALMBCK="R",(VPRVOK,VPATOK)=0
I TYPE="PR" D
. S ERXPRV=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
. S VPRV=0 F S VPRV=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV)) Q:'VPRV D I VPRVOK Q
. . S RDAT=0 F S RDAT=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,RDAT)) Q:'RDAT D I VPRVOK Q
. . . S ERX=0 F S ERX=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,RDAT,ERX)) Q:'ERX D I VPRVOK Q
. . . . I ERX'=ERXIEN S VPRVOK=1
I TYPE="PR",'VPRVOK D Q
. S VALMSG="There are no suggestions for this Provider" W $C(7)
I TYPE="PA" D
. S ERXPAT=+$$GET1^DIQ(52.49,+$G(ERXIEN),.04,"I")
. S VPAT=0 F S VPAT=$O(^PS(52.49,"APATVPAT",ERXPAT,VPAT)) Q:'VPAT D I VPATOK Q
. . I $$DEAD^PSONVARP(VPAT) Q
. . S RDAT=0 F S RDAT=$O(^PS(52.49,"APATVPAT",ERXPAT,VPAT,RDAT)) Q:'RDAT D I VPATOK Q
. . . S ERX=0 F S ERX=$O(^PS(52.49,"APATVPAT",ERXPAT,VPAT,RDAT,ERX)) Q:'ERX D I VPATOK Q
. . . . I ERX'=ERXIEN S VPATOK=1
I TYPE="PA",'VPATOK D Q
. S VALMSG="There are no suggestions for this Patient" W $C(7)
I TYPE="DR" S DRUGHASH=$$DRUGHASH^PSOERUT(ERXIEN)
I TYPE="DR",'DRUGHASH D Q
. S VALMSG="Unable to calculate the hash value for this eRx" W $C(7)
I TYPE="DR",'$O(^PS(52.49,"ADRGVRX",DRUGHASH,0)) D Q
. S VALMSG="There are no suggestions for this Drug" W $C(7)
D FULL^VALM1
I TYPE="PA" D MATCHSUG^PSOERPT1(ERXIEN,1)
I TYPE="PR" D MATCHSUG^PSOERPV1(ERXIEN,1)
I TYPE="DR" D MATCHSUG(ERXIEN,1)
Q
;
LASTRXST(RXIEN) ; Returns the Rx Last Fill status (For Future Fill Suggestion only)
; Input: RXIEN - pointer to PRESCRIPTION file (#52)
;Output: STATUS - Last fill status ("R":Relased;"T":Transmitted;"S":Suspended)
N LASTFILL,FILLDATE,RELDATE,RXSTS
S LASTFILL=$$LSTRFL^PSOBPSU1(RXIEN)
S RELDATE=$$RXRLDT^PSOBPSUT(RXIEN,LASTFILL)\1
S RXSTS=+$$GET1^DIQ(52,RXIEN,100,"I")
S FILLDATE=$$RXFLDT^PSOBPSUT(RXIEN,LASTFILL)
; Last Fill released, Release Date + Days Supply in the future
I RELDATE,$$FMADD^XLFDT(RELDATE,$$GET1^DIQ(52,RXIEN,8))>DT Q "R"
; Last Fill is not released, is Suspended, Not Transmitted/Printed, Future Fill Date
I 'RELDATE,(RXSTS=5),FILLDATE>DT Q "S"
; Last Fill is not released, is Transmitted or Re-Transmitted to CMOP
I 'RELDATE,$$CMOPSTS^PSOERUT(RXIEN,LASTFILL)=0!($$CMOPSTS^PSOERUT(RXIEN,LASTFILL)=2) Q "T"
Q ""
;
NARRATIV(DFN,NMSPC,MODE) ;Display the Pharmacy Narrative
;Input: DFN - VistA Patient - Pointer to PATIENT file (#2)
; NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1") - Required for LM Mode only
; MODE - Display Mode: "RS": Roll & Scroll | "LM": ListMan
Q:$G(DFN)=""
N XX,I,LINETXT,NARRTIVE
K XX S XX=$$GET1^DIQ(55,DFN,1,"E")
Q:XX=""
S LINETXT="VistA Narrative: "_$E(XX,1,63)
S LINETXT=$$COMPARE^PSOERUT0(MODE,LINETXT,LINETXT,17)
D ADDLINE^PSOERUT0(MODE,NMSPC,LINETXT)
K NARRTIVE D TXT2ARY^PSOERXD1(.NARRTIVE,$E(XX,64,250),,80)
F I=1:1 Q:'$D(NARRTIVE(I)) D
. S LINETXT=" "_$$COMPARE^PSOERUT0(MODE,NARRTIVE(I),NARRTIVE(I),2)
. D ADDLINE^PSOERUT0(MODE,NMSPC,LINETXT)
Q
;
MATCHSUG(ERXIEN,VIEW) ; Match Suggestion Prompt
; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; (o)VIEW - View Only Mode (1:YES,0/null: NO)
;Output: MATCHSUG - p1: Vista Rx (Pointer to #52)
; p2: 1 - User want to copy Pat. Instr. | 0 - Do not copy | -1 - "^" (up-caret entered)
;
N MATCHSUG,DRUGHASH,MATCHCNT,CNT,VISTARX,QUIT,DIR,Y,X,VADRUG,VASIG,SUGGARR,TEMPARR,II
N VADAYS,VAREFS,VAQTY,VSRXPTINS,RXIEN,XQORNOD
I '$D(^PS(52.49,+$G(ERXIEN),0)) Q 0
; Dosage already entered
I '$G(VIEW),$D(^PS(52.49,ERXIEN,21)) Q 0
;
S DRUGHASH=$$DRUGHASH^PSOERUT(ERXIEN) I 'DRUGHASH Q 0
;
S (MATCHSUG,MATCHCNT,QUIT)=0
S VISTARX=""
F S VISTARX=$O(^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX),-1) Q:'VISTARX D I (MATCHCNT>2) Q
. S VADRUG=+$$GET1^DIQ(52,VISTARX,6,"I") I 'VADRUG Q
. ; If Drug is Inactive, forget suggestion automatically
. I $$GET1^DIQ(50,VADRUG,100,"I") D Q
. . K ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX)
. S VASIG=$E($$SUGSIG^PSOERUT3(VISTARX,ERXIEN),1,500) I VASIG="" Q
. S VAQTY=+$$GET1^DIQ(52,VISTARX,7,"I")
. S VADAYS=+$$GET1^DIQ(52,VISTARX,8,"I")
. S VAREFS=+$$GET1^DIQ(52,VISTARX,9,"I")
. I $D(TEMPARR(VADRUG,VASIG,VAQTY,VADAYS,VAREFS)) Q
. S MATCHCNT=MATCHCNT+1
. S SUGGARR(MATCHCNT)=VISTARX_"^"_DRUGHASH,TEMPARR(VADRUG,VASIG,VAQTY,VADAYS,VAREFS)=""
F CNT=1:1:MATCHCNT D I MATCHSUG!QUIT Q
. S VISTARX=+SUGGARR(CNT),DRUGHASH=$P(SUGGARR(CNT),"^",2)
. D CMPMEDS(ERXIEN,VISTARX,CNT_"^"_MATCHCNT)
. K DIR S DIR(0)="SOA^V:VIEW RX;"_$S('$G(VIEW):"A:ACCEPT;",1:"")_$S(MATCHCNT>1&(MATCHCNT'=CNT):"N:NEXT;",1:"")_"F:FORGET;E:EXIT"
. S DIR("A")="ACTION on SUGGESTION: (V)IEW RX "_$S('$G(VIEW):"(A)CCEPT ",1:"")_$S(MATCHCNT>1&(MATCHCNT'=CNT):"(N)EXT ",1:"")_"(F)ORGET (E)XIT: "
. S DIR("B")=$S(MATCHCNT>1&(MATCHCNT'=CNT):"NEXT",1:"EXIT")
. S II=0
. S II=II+1,DIR("?",II)=" VIEW RX - View VistA Rx where the suggestion is coming from"
. I '$G(VIEW) D
. . S II=II+1,DIR("?",II)=" ACCEPT - Accepts the suggested data (right column) and pre-populates the"
. . S II=II+1,DIR("?",II)=" VistA fields"
. I MATCHCNT>1&(MATCHCNT'=CNT) D
. . S II=II+1,DIR("?",II)=" NEXT - Ignores the current suggestion and view the next one"
. S II=II+1,DIR("?",II)=" FORGET - Forgets the current suggestion so that it is not presented again"
. S II=II+1,DIR("?",II)=" in the future to any user"
. S DIR("?")=" EXIT - Exits and continue to filling the VistA fields manually"
. D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y="E") S QUIT=1 Q
. I Y="V" S RXIEN=VISTARX,XQORNOD(0)="" D VIEWNOTE,VIEW^PSOSPML4 D FULL^VALM1 S CNT=CNT-1 Q
. I Y="A" S MATCHSUG=VISTARX D Q
. . ;Only prompt the Patient Instruction when Editing Drug not when Viewing suggestion
. . ;prompt the user if they want to copy the patient instruction for the suggested rx into the eRx.
. . I '$G(VIEW) S VSRXPTINS=$$PROMPTPI(ERXIEN,+MATCHSUG),MATCHSUG=VISTARX_"^"_VSRXPTINS
. I Y="N" W ! Q
. I Y="F" D
. . K DIR S DIR(0)="SA^Y:YES;N:NO",DIR("B")="NO"
. . S DIR("A")="Are you sure this suggestion match should be forgotten? "
. . S DIR("?")="This suggestion originated from a VistA Rx previously dispensed for an eRx with"
. . S DIR("?")=DIR("?")_" the exact Drug Name, NDC, SIG, Quantity, Days Supply, # of Refills"
. . S DIR("?")=DIR("?")_" and Substitution allowance. Once you forget this match it will no"
. . S DIR("?")=DIR("?")_" longer be suggested as a match for future eRx's with the same fields."
. . W ! D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y="N") S CNT=CNT-1 W ! Q
. . W !?64,"Forgetting..." K ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX) H 1 W "Ok." H .5 W ! Q
Q MATCHSUG
;
CMPMEDS(ERXIEN,VISTARX,COUNTER) ; Display the Comparison Between eRx and VistA Providers
;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; VISTARX - VistA Rx IEN (Pointer to #52)
; COUNTER - P1: Entry # | P2: Number of Entries
I '$D(^PS(52.49,+$G(ERXIEN),0))!'$D(^PSRX(+$G(VISTARX),0)) Q
N XX,LINE,X
W !?55,"|Sugg. " W $G(IOINHI)_+$G(COUNTER)_$G(IOINORM)_" of "_$G(IOINHI)_$P($G(COUNTER),"^",2)_$G(IOINORM)
W " - ",$G(IOINHI)_$$FMTE^XLFDT($$GET1^DIQ(52,VISTARX,21,"I")\1,"2Z")_$G(IOINORM),?79,"|"
W !,$G(IORVON)_"ERX MED"_$G(IORVOFF),?41,$G(IORVON)_"VISTA MED"_$G(IORVOFF)
W ?55,"|From Rx#: "_$G(IOINHI)_$$GET1^DIQ(52,VISTARX,.01)_$G(IOINORM),?79,"|"
S $P(XX,"_",81)="" W !,XX
S LINE=0 D SETDRUG^PSOERUT2("RS",,ERXIEN,1,VISTARX)
Q
;
PROMPTPI(ERXIEN,MATCHSUG) ;Once the user accept the suggested rx, prompt if user want to copy the patient instruction for that suggested rx into the eRx.
;Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; MATCHSUG - Pointer to PRESCRIPTION file (#52)
;Output: Returns 1 plus the Expanded Patient Instructions from the user's accepted suggested rx
; 0 - user did not accept the Patient Instruction from the suggested rx OR there are no PI for the Rx
; -1 - user up carret (^) in the Patient Instruction prompt from the suggested rx
;
N DTOUT,DUOUT,DIR,DIRUT,VSPATINS,PATINSARY,XX,Y,I,VARXNUM,VDRG,VAOI,PATINST,VADRGIEN,VAOIIEN,VAPATIEN
;
I $$GET1^DIQ(59.7,1,102,"I")'="MBM" Q 0 ; MbM only
I $G(ERXIEN)="" Q 0
I $G(MATCHSUG)="" Q 0
I $$GET1^DIQ(52.49,ERXIEN,27)'="" Q 0 ;eRx already has PI set
;
;check if the suggested rx has VA Pharmacy Orderable Item Patient Instructions
S VADRGIEN=+$$GET1^DIQ(52,MATCHSUG,6,"I")
S VAOIIEN=+$$GET1^DIQ(50,VADRGIEN,2.1,"I")
S VAPATIEN=+$$GET1^DIQ(52.49,ERXIEN,.05,"I")
;The software will automatically populate the PI. See SAVEDRUG^PSOERUT2
I $$VAPATINS^PSOERUT3(VAOIIEN,VAPATIEN)'="" Q 0
;
S VSRXPTINS=""
S VARXNUM=$$GET1^DIQ(52,MATCHSUG,.01)
;retrieve the Patient Instruction from File #52 field 115. Quits if none
S VSPATINS=$$VARXPI^PSOERUT(MATCHSUG)
;
I VSPATINS="" Q 0
;prompt the PATIENT INSTRUCTIONS for that suggested rx that user selected
W !!,"Rx #"_$G(IOINHI)_VARXNUM_$G(IOINORM)," PATIENT INSTRUCTIONS:"
K PATINSARY D TXT2ARY^PSOERXD1(.PATINSARY,$G(VSPATINS),,80)
F I=1:1 Q:'$D(PATINSARY(I)) W !,$G(IOINHI)_PATINSARY(I)_$G(IOINORM)
W !
S DIR("A")="Copy PATIENT INSTRUCTIONS from Rx #"_$G(IOINHI)_VARXNUM_$G(IOINORM)
S DIR("B")="NO",DIR(0)="Y"
D ^DIR K DIR I $D(DIRUT)!$D(DIROUT) Q 0
Q +$G(Y)
;
VIEWNOTE ; View Suggested Rx Notice
S $P(XX,$S($D(IOUON):" ",1:"-"),81)="",$E(XX,37,42)="NOTICE" W !,$G(IOUON),XX,$G(IOUOFF)
W !,"You will be taken to the VistA Rx#",$$GET1^DIQ(52,VISTARX,.01)," that was entered in the past for the"
W !,"same Product (NDC/SIG/Qty/Days Supply/# of Refills/Substitution) for a different"
W !,"eRx. This VistA Rx may or may not be for the same patient in this erx being"
W !,"processed."
S XX="",$P(XX,$S($D(IOUON):" ",1:"-"),81)="" W !,$G(IOUON),XX,$G(IOUOFF)
K DIR S DIR(0)="E" D ^DIR I $D(DIRUT)!$D(DIROUT) Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERUT6 14263 printed Aug 26, 2025@22:44:12 Page 2
PSOERUT6 ;ALB/MFR - eRx & Pending Order Side-by-Side LM Display - Cont'd; 06/25/2023 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**700,746,769,770**;DEC 1997;Build 145
+2 ;
EN ; Continuation of PSOERUT5 due to routine size limit
+1 ;
+2 ; - Provider
+3 SET XE="Provider: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(ERXPRVNM,1,29),PENDATA("PROVIDER NAME"),11)
+4 SET XV="|"_$SELECT('RENEWORD:"13) ",1:"6) ")_"Provider: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(PENDATA("PROVIDER NAME"),1,26),ERXPRVNM,$SELECT('RENEWORD:55,1:54))
+5 SET UNDERLN(LINE,41)=$SELECT('RENEWORD:3,1:2)
+6 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+7 SET PRVIEN=$SELECT($GET(PENDATA("PROVIDER")):PENDATA("PROVIDER"),1:$$GET1^DIQ(52.41,ORDIEN,5,"I"))
+8 IF $GET(PKI)
IF +$GET(DRUGDATA("DEA"))>1
IF +$GET(DRUGDATA("DEA"))<6
Begin DoDot:1
+9 DO CSPRV^PSOERUT4(PRVIEN,+VADRGIEN,$$GET1^DIQ(52.41,ORDIEN,.01,"I"))
End DoDot:1
+10 IF $$GET1^DIQ(200,PRVIEN,53.7,"I")
IF $$GET1^DIQ(200,PRVIEN,53.8,"I")
Begin DoDot:1
+11 SET XV="|Cos-Provider: "_$$COMPARE^PSOERUT0("LM",$$GET1^DIQ(200,PRVIEN,53.8),$$GET1^DIQ(200,PRVIEN,53.8),55)
+12 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
End DoDot:1
+13 DO BLANKLN^PSOERUT0("LM")
+14 ;
+15 ; - Copies
+16 NEW COPIES
+17 SET COPIES=$SELECT($GET(PENDATA("COPIES")):PENDATA("COPIES"),1:1)
+18 SET XV="|"_$SELECT('RENEWORD:"14) ",1:"7) ")_"Copies: "_$$COMPARE^PSOERUT0("LM",COPIES,COPIES,$SELECT('RENEWORD:53,1:52))
+19 SET UNDERLN(LINE,41)=$SELECT('RENEWORD:3,1:2)
+20 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
+21 DO BLANKLN^PSOERUT0("LM")
+22 ;
+23 ; - Remarks
+24 SET XV="|"_$SELECT('RENEWORD:"15) ",1:"8) ")_"Remarks: "
+25 SET UNDERLN(LINE,41)=$SELECT('RENEWORD:3,1:2)
+26 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
+27 KILL VARR
DO WRAP^PSOERUT($GET(PSONEW("REMARKS")),38,.VARR)
+28 FOR I=1:1
if '$DATA(VARR(I))
QUIT
Begin DoDot:1
+29 IF $GET(VARR(I,0))=""
QUIT
+30 DO ADDLINE^PSOERUT0("LM",NMSPC,"","| "_$$COMPARE^PSOERUT0("LM",VARR(I,0),VARR(I,0),42))
End DoDot:1
+31 DO BLANKLN^PSOERUT0("LM")
+32 ; - Diagnostics
+33 DO SETDIAGS^PSOERUT3("LM",NMSPC,ERXIEN,"PEN")
+34 DO BLANKLN^PSOERUT0("LM",0)
+35 ;
+36 ; - DEA compliance note for eRx CS prescriptions
+37 IF $$GET1^DIQ(52.49,ERXIEN,95.1,"I")
IF $$CS^PSOERXA0(VADRGIEN)
Begin DoDot:1
+38 DO BLANKLN^PSOERUT0("LM",1)
+39 SET XE=" This prescription meets the requirements of the Drug Enforcement Administration"
+40 DO ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
+41 SET XE=" (DEA) electronic prescribing for controlled substances rules (21 CFR Parts"
+42 DO ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
+43 SET XE=" 1300, 1304, 1306, & 1311)."
+44 DO ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
+45 DO BLANKLN^PSOERUT0("LM",1)
End DoDot:1
+46 ;
+47 ; - Entry Accepted by/date/time
+48 SET ACCDTBY=$$ACCDTBY^PSOERUT4(ERXIEN)
+49 SET XX=" eRx Received on "_$PIECE($$FMTE^XLFDT($$GET1^DIQ(52.49,ERXIEN,.03,"I"),"2Y"),":",1,2)
+50 SET XX=XX_" | Accepted by "_$EXTRACT($PIECE(ACCDTBY,"^",2),1,17)_" on "_$PIECE($PIECE(ACCDTBY,"^",1),":",1,2)
+51 SET XX=$EXTRACT(XX,1,80)
SET XE=""
SET $EXTRACT(XE,(80-$LENGTH(XX))\2+1)=XX
+52 DO ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
+53 QUIT
+54 ;
VISTAPAT(ERXIEN) ; Returns the VistA Patient For Responses that pass through the eRx Holding Queue w/out matching/validation
+1 ; Input: ERXIEN - Pointer to the ERX HOLDING QUEUE (#52.49)
+2 ;Output: VISTAPAT - Pointer to the PATIENT file (#2) associated with the eRx
+3 NEW VISTAPAT,MTYPE,REQIEN,NEWRXIEN
+4 SET VISTAPAT=+$$GET1^DIQ(52.49,ERXIEN,.05,"I")
+5 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+6 IF 'VISTAPAT
IF "RR,CA,"[MTYPE
Begin DoDot:1
+7 SET NEWRXIEN=$$RESOLV^PSOERXU2(ERXIEN)
+8 SET VISTAPAT=+$$GET1^DIQ(52.49,NEWRXIEN,.05,"I")
End DoDot:1
+9 IF 'VISTAPAT
IF "RE,CN,IE,"[MTYPE
Begin DoDot:1
+10 SET REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
if 'REQIEN
QUIT
+11 SET VISTAPAT=+$$GET1^DIQ(52.49,REQIEN,.05,"I")
IF VISTAPAT
QUIT
+12 SET NEWRXIEN=$$RESOLV^PSOERXU2(REQIEN)
+13 SET VISTAPAT=+$$GET1^DIQ(52.49,NEWRXIEN,.05,"I")
End DoDot:1
+14 QUIT VISTAPAT
+15 ;
CSERX(ORD) ; Check whether a Pending Order is for a CS eRx
+1 ; Input: ORD - Pointer to OUTPATIENT PENDING ORDER file (#52.41)
+2 IF $$ERXIEN^PSOERXUT(ORD_"P")
IF $$CSDRG(+$$GET1^DIQ(52.41,+ORD,11,"I"))
Begin DoDot:1
+3 SET VALMSG="Only the 'Routing' field can be edited (CS eRx)."
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT 1
+4 QUIT 0
+5 ;
CSDRG(DRGIEN) ; Controlled Substance drug?
+1 ; Input: DRGIEN - Pointer to DRUG file (#50)
+2 ;Output: $$CS - 1:YES / 0:NO
+3 NEW DEA
+4 if 'DRGIEN
QUIT 0
+5 SET DEA=$$GET1^DIQ(50,DRGIEN,3)
+6 IF (DEA'["0")
IF (DEA'["M")
IF (DEA["2")!(DEA["3")!(DEA["4")!(DEA["5")
QUIT 1
+7 QUIT 0
+8 ;
VS(ERXIEN,TYPE) ; View Suggestion(s)
+1 ;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ; TYPE - Type of Suggestion("PA": Patient;"PR": Provider;"DR": Drug)
+3 NEW ERXPAT,ERXPRV,DRUGHASH,ERX,VPRV,VPAT,RDAT,VPRVOK,VPATOK
+4 SET VALMBCK="R"
SET (VPRVOK,VPATOK)=0
+5 IF TYPE="PR"
Begin DoDot:1
+6 SET ERXPRV=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
+7 SET VPRV=0
FOR
SET VPRV=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV))
if 'VPRV
QUIT
Begin DoDot:2
+8 SET RDAT=0
FOR
SET RDAT=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,RDAT))
if 'RDAT
QUIT
Begin DoDot:3
+9 SET ERX=0
FOR
SET ERX=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,RDAT,ERX))
if 'ERX
QUIT
Begin DoDot:4
+10 IF ERX'=ERXIEN
SET VPRVOK=1
End DoDot:4
IF VPRVOK
QUIT
End DoDot:3
IF VPRVOK
QUIT
End DoDot:2
IF VPRVOK
QUIT
End DoDot:1
+11 IF TYPE="PR"
IF 'VPRVOK
Begin DoDot:1
+12 SET VALMSG="There are no suggestions for this Provider"
WRITE $CHAR(7)
End DoDot:1
QUIT
+13 IF TYPE="PA"
Begin DoDot:1
+14 SET ERXPAT=+$$GET1^DIQ(52.49,+$GET(ERXIEN),.04,"I")
+15 SET VPAT=0
FOR
SET VPAT=$ORDER(^PS(52.49,"APATVPAT",ERXPAT,VPAT))
if 'VPAT
QUIT
Begin DoDot:2
+16 IF $$DEAD^PSONVARP(VPAT)
QUIT
+17 SET RDAT=0
FOR
SET RDAT=$ORDER(^PS(52.49,"APATVPAT",ERXPAT,VPAT,RDAT))
if 'RDAT
QUIT
Begin DoDot:3
+18 SET ERX=0
FOR
SET ERX=$ORDER(^PS(52.49,"APATVPAT",ERXPAT,VPAT,RDAT,ERX))
if 'ERX
QUIT
Begin DoDot:4
+19 IF ERX'=ERXIEN
SET VPATOK=1
End DoDot:4
IF VPATOK
QUIT
End DoDot:3
IF VPATOK
QUIT
End DoDot:2
IF VPATOK
QUIT
End DoDot:1
+20 IF TYPE="PA"
IF 'VPATOK
Begin DoDot:1
+21 SET VALMSG="There are no suggestions for this Patient"
WRITE $CHAR(7)
End DoDot:1
QUIT
+22 IF TYPE="DR"
SET DRUGHASH=$$DRUGHASH^PSOERUT(ERXIEN)
+23 IF TYPE="DR"
IF 'DRUGHASH
Begin DoDot:1
+24 SET VALMSG="Unable to calculate the hash value for this eRx"
WRITE $CHAR(7)
End DoDot:1
QUIT
+25 IF TYPE="DR"
IF '$ORDER(^PS(52.49,"ADRGVRX",DRUGHASH,0))
Begin DoDot:1
+26 SET VALMSG="There are no suggestions for this Drug"
WRITE $CHAR(7)
End DoDot:1
QUIT
+27 DO FULL^VALM1
+28 IF TYPE="PA"
DO MATCHSUG^PSOERPT1(ERXIEN,1)
+29 IF TYPE="PR"
DO MATCHSUG^PSOERPV1(ERXIEN,1)
+30 IF TYPE="DR"
DO MATCHSUG(ERXIEN,1)
+31 QUIT
+32 ;
LASTRXST(RXIEN) ; Returns the Rx Last Fill status (For Future Fill Suggestion only)
+1 ; Input: RXIEN - pointer to PRESCRIPTION file (#52)
+2 ;Output: STATUS - Last fill status ("R":Relased;"T":Transmitted;"S":Suspended)
+3 NEW LASTFILL,FILLDATE,RELDATE,RXSTS
+4 SET LASTFILL=$$LSTRFL^PSOBPSU1(RXIEN)
+5 SET RELDATE=$$RXRLDT^PSOBPSUT(RXIEN,LASTFILL)\1
+6 SET RXSTS=+$$GET1^DIQ(52,RXIEN,100,"I")
+7 SET FILLDATE=$$RXFLDT^PSOBPSUT(RXIEN,LASTFILL)
+8 ; Last Fill released, Release Date + Days Supply in the future
+9 IF RELDATE
IF $$FMADD^XLFDT(RELDATE,$$GET1^DIQ(52,RXIEN,8))>DT
QUIT "R"
+10 ; Last Fill is not released, is Suspended, Not Transmitted/Printed, Future Fill Date
+11 IF 'RELDATE
IF (RXSTS=5)
IF FILLDATE>DT
QUIT "S"
+12 ; Last Fill is not released, is Transmitted or Re-Transmitted to CMOP
+13 IF 'RELDATE
IF $$CMOPSTS^PSOERUT(RXIEN,LASTFILL)=0!($$CMOPSTS^PSOERUT(RXIEN,LASTFILL)=2)
QUIT "T"
+14 QUIT ""
+15 ;
NARRATIV(DFN,NMSPC,MODE) ;Display the Pharmacy Narrative
+1 ;Input: DFN - VistA Patient - Pointer to PATIENT file (#2)
+2 ; NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1") - Required for LM Mode only
+3 ; MODE - Display Mode: "RS": Roll & Scroll | "LM": ListMan
+4 if $GET(DFN)=""
QUIT
+5 NEW XX,I,LINETXT,NARRTIVE
+6 KILL XX
SET XX=$$GET1^DIQ(55,DFN,1,"E")
+7 if XX=""
QUIT
+8 SET LINETXT="VistA Narrative: "_$EXTRACT(XX,1,63)
+9 SET LINETXT=$$COMPARE^PSOERUT0(MODE,LINETXT,LINETXT,17)
+10 DO ADDLINE^PSOERUT0(MODE,NMSPC,LINETXT)
+11 KILL NARRTIVE
DO TXT2ARY^PSOERXD1(.NARRTIVE,$EXTRACT(XX,64,250),,80)
+12 FOR I=1:1
if '$DATA(NARRTIVE(I))
QUIT
Begin DoDot:1
+13 SET LINETXT=" "_$$COMPARE^PSOERUT0(MODE,NARRTIVE(I),NARRTIVE(I),2)
+14 DO ADDLINE^PSOERUT0(MODE,NMSPC,LINETXT)
End DoDot:1
+15 QUIT
+16 ;
MATCHSUG(ERXIEN,VIEW) ; Match Suggestion Prompt
+1 ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ; (o)VIEW - View Only Mode (1:YES,0/null: NO)
+3 ;Output: MATCHSUG - p1: Vista Rx (Pointer to #52)
+4 ; p2: 1 - User want to copy Pat. Instr. | 0 - Do not copy | -1 - "^" (up-caret entered)
+5 ;
+6 NEW MATCHSUG,DRUGHASH,MATCHCNT,CNT,VISTARX,QUIT,DIR,Y,X,VADRUG,VASIG,SUGGARR,TEMPARR,II
+7 NEW VADAYS,VAREFS,VAQTY,VSRXPTINS,RXIEN,XQORNOD
+8 IF '$DATA(^PS(52.49,+$GET(ERXIEN),0))
QUIT 0
+9 ; Dosage already entered
+10 IF '$GET(VIEW)
IF $DATA(^PS(52.49,ERXIEN,21))
QUIT 0
+11 ;
+12 SET DRUGHASH=$$DRUGHASH^PSOERUT(ERXIEN)
IF 'DRUGHASH
QUIT 0
+13 ;
+14 SET (MATCHSUG,MATCHCNT,QUIT)=0
+15 SET VISTARX=""
+16 FOR
SET VISTARX=$ORDER(^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX),-1)
if 'VISTARX
QUIT
Begin DoDot:1
+17 SET VADRUG=+$$GET1^DIQ(52,VISTARX,6,"I")
IF 'VADRUG
QUIT
+18 ; If Drug is Inactive, forget suggestion automatically
+19 IF $$GET1^DIQ(50,VADRUG,100,"I")
Begin DoDot:2
+20 KILL ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX)
End DoDot:2
QUIT
+21 SET VASIG=$EXTRACT($$SUGSIG^PSOERUT3(VISTARX,ERXIEN),1,500)
IF VASIG=""
QUIT
+22 SET VAQTY=+$$GET1^DIQ(52,VISTARX,7,"I")
+23 SET VADAYS=+$$GET1^DIQ(52,VISTARX,8,"I")
+24 SET VAREFS=+$$GET1^DIQ(52,VISTARX,9,"I")
+25 IF $DATA(TEMPARR(VADRUG,VASIG,VAQTY,VADAYS,VAREFS))
QUIT
+26 SET MATCHCNT=MATCHCNT+1
+27 SET SUGGARR(MATCHCNT)=VISTARX_"^"_DRUGHASH
SET TEMPARR(VADRUG,VASIG,VAQTY,VADAYS,VAREFS)=""
End DoDot:1
IF (MATCHCNT>2)
QUIT
+28 FOR CNT=1:1:MATCHCNT
Begin DoDot:1
+29 SET VISTARX=+SUGGARR(CNT)
SET DRUGHASH=$PIECE(SUGGARR(CNT),"^",2)
+30 DO CMPMEDS(ERXIEN,VISTARX,CNT_"^"_MATCHCNT)
+31 KILL DIR
SET DIR(0)="SOA^V:VIEW RX;"_$SELECT('$GET(VIEW):"A:ACCEPT;",1:"")_$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"N:NEXT;",1:"")_"F:FORGET;E:EXIT"
+32 SET DIR("A")="ACTION on SUGGESTION: (V)IEW RX "_$SELECT('$GET(VIEW):"(A)CCEPT ",1:"")_$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"(N)EXT ",1:"")_"(F)ORGET (E)XIT: "
+33 SET DIR("B")=$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"NEXT",1:"EXIT")
+34 SET II=0
+35 SET II=II+1
SET DIR("?",II)=" VIEW RX - View VistA Rx where the suggestion is coming from"
+36 IF '$GET(VIEW)
Begin DoDot:2
+37 SET II=II+1
SET DIR("?",II)=" ACCEPT - Accepts the suggested data (right column) and pre-populates the"
+38 SET II=II+1
SET DIR("?",II)=" VistA fields"
End DoDot:2
+39 IF MATCHCNT>1&(MATCHCNT'=CNT)
Begin DoDot:2
+40 SET II=II+1
SET DIR("?",II)=" NEXT - Ignores the current suggestion and view the next one"
End DoDot:2
+41 SET II=II+1
SET DIR("?",II)=" FORGET - Forgets the current suggestion so that it is not presented again"
+42 SET II=II+1
SET DIR("?",II)=" in the future to any user"
+43 SET DIR("?")=" EXIT - Exits and continue to filling the VistA fields manually"
+44 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)!(Y="E")
SET QUIT=1
QUIT
+45 IF Y="V"
SET RXIEN=VISTARX
SET XQORNOD(0)=""
DO VIEWNOTE
DO VIEW^PSOSPML4
DO FULL^VALM1
SET CNT=CNT-1
QUIT
+46 IF Y="A"
SET MATCHSUG=VISTARX
Begin DoDot:2
+47 ;Only prompt the Patient Instruction when Editing Drug not when Viewing suggestion
+48 ;prompt the user if they want to copy the patient instruction for the suggested rx into the eRx.
+49 IF '$GET(VIEW)
SET VSRXPTINS=$$PROMPTPI(ERXIEN,+MATCHSUG)
SET MATCHSUG=VISTARX_"^"_VSRXPTINS
End DoDot:2
QUIT
+50 IF Y="N"
WRITE !
QUIT
+51 IF Y="F"
Begin DoDot:2
+52 KILL DIR
SET DIR(0)="SA^Y:YES;N:NO"
SET DIR("B")="NO"
+53 SET DIR("A")="Are you sure this suggestion match should be forgotten? "
+54 SET DIR("?")="This suggestion originated from a VistA Rx previously dispensed for an eRx with"
+55 SET DIR("?")=DIR("?")_" the exact Drug Name, NDC, SIG, Quantity, Days Supply, # of Refills"
+56 SET DIR("?")=DIR("?")_" and Substitution allowance. Once you forget this match it will no"
+57 SET DIR("?")=DIR("?")_" longer be suggested as a match for future eRx's with the same fields."
+58 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)!(Y="N")
SET CNT=CNT-1
WRITE !
QUIT
+59 WRITE !?64,"Forgetting..."
KILL ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX)
HANG 1
WRITE "Ok."
HANG .5
WRITE !
QUIT
End DoDot:2
End DoDot:1
IF MATCHSUG!QUIT
QUIT
+60 QUIT MATCHSUG
+61 ;
CMPMEDS(ERXIEN,VISTARX,COUNTER) ; Display the Comparison Between eRx and VistA Providers
+1 ;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ; VISTARX - VistA Rx IEN (Pointer to #52)
+3 ; COUNTER - P1: Entry # | P2: Number of Entries
+4 IF '$DATA(^PS(52.49,+$GET(ERXIEN),0))!'$DATA(^PSRX(+$GET(VISTARX),0))
QUIT
+5 NEW XX,LINE,X
+6 WRITE !?55,"|Sugg. "
WRITE $GET(IOINHI)_+$GET(COUNTER)_$GET(IOINORM)_" of "_$GET(IOINHI)_$PIECE($GET(COUNTER),"^",2)_$GET(IOINORM)
+7 WRITE " - ",$GET(IOINHI)_$$FMTE^XLFDT($$GET1^DIQ(52,VISTARX,21,"I")\1,"2Z")_$GET(IOINORM),?79,"|"
+8 WRITE !,$GET(IORVON)_"ERX MED"_$GET(IORVOFF),?41,$GET(IORVON)_"VISTA MED"_$GET(IORVOFF)
+9 WRITE ?55,"|From Rx#: "_$GET(IOINHI)_$$GET1^DIQ(52,VISTARX,.01)_$GET(IOINORM),?79,"|"
+10 SET $PIECE(XX,"_",81)=""
WRITE !,XX
+11 SET LINE=0
DO SETDRUG^PSOERUT2("RS",,ERXIEN,1,VISTARX)
+12 QUIT
+13 ;
PROMPTPI(ERXIEN,MATCHSUG) ;Once the user accept the suggested rx, prompt if user want to copy the patient instruction for that suggested rx into the eRx.
+1 ;Input : ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ; MATCHSUG - Pointer to PRESCRIPTION file (#52)
+3 ;Output: Returns 1 plus the Expanded Patient Instructions from the user's accepted suggested rx
+4 ; 0 - user did not accept the Patient Instruction from the suggested rx OR there are no PI for the Rx
+5 ; -1 - user up carret (^) in the Patient Instruction prompt from the suggested rx
+6 ;
+7 NEW DTOUT,DUOUT,DIR,DIRUT,VSPATINS,PATINSARY,XX,Y,I,VARXNUM,VDRG,VAOI,PATINST,VADRGIEN,VAOIIEN,VAPATIEN
+8 ;
+9 ; MbM only
IF $$GET1^DIQ(59.7,1,102,"I")'="MBM"
QUIT 0
+10 IF $GET(ERXIEN)=""
QUIT 0
+11 IF $GET(MATCHSUG)=""
QUIT 0
+12 ;eRx already has PI set
IF $$GET1^DIQ(52.49,ERXIEN,27)'=""
QUIT 0
+13 ;
+14 ;check if the suggested rx has VA Pharmacy Orderable Item Patient Instructions
+15 SET VADRGIEN=+$$GET1^DIQ(52,MATCHSUG,6,"I")
+16 SET VAOIIEN=+$$GET1^DIQ(50,VADRGIEN,2.1,"I")
+17 SET VAPATIEN=+$$GET1^DIQ(52.49,ERXIEN,.05,"I")
+18 ;The software will automatically populate the PI. See SAVEDRUG^PSOERUT2
+19 IF $$VAPATINS^PSOERUT3(VAOIIEN,VAPATIEN)'=""
QUIT 0
+20 ;
+21 SET VSRXPTINS=""
+22 SET VARXNUM=$$GET1^DIQ(52,MATCHSUG,.01)
+23 ;retrieve the Patient Instruction from File #52 field 115. Quits if none
+24 SET VSPATINS=$$VARXPI^PSOERUT(MATCHSUG)
+25 ;
+26 IF VSPATINS=""
QUIT 0
+27 ;prompt the PATIENT INSTRUCTIONS for that suggested rx that user selected
+28 WRITE !!,"Rx #"_$GET(IOINHI)_VARXNUM_$GET(IOINORM)," PATIENT INSTRUCTIONS:"
+29 KILL PATINSARY
DO TXT2ARY^PSOERXD1(.PATINSARY,$GET(VSPATINS),,80)
+30 FOR I=1:1
if '$DATA(PATINSARY(I))
QUIT
WRITE !,$GET(IOINHI)_PATINSARY(I)_$GET(IOINORM)
+31 WRITE !
+32 SET DIR("A")="Copy PATIENT INSTRUCTIONS from Rx #"_$GET(IOINHI)_VARXNUM_$GET(IOINORM)
+33 SET DIR("B")="NO"
SET DIR(0)="Y"
+34 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT 0
+35 QUIT +$GET(Y)
+36 ;
VIEWNOTE ; View Suggested Rx Notice
+1 SET $PIECE(XX,$SELECT($DATA(IOUON):" ",1:"-"),81)=""
SET $EXTRACT(XX,37,42)="NOTICE"
WRITE !,$GET(IOUON),XX,$GET(IOUOFF)
+2 WRITE !,"You will be taken to the VistA Rx#",$$GET1^DIQ(52,VISTARX,.01)," that was entered in the past for the"
+3 WRITE !,"same Product (NDC/SIG/Qty/Days Supply/# of Refills/Substitution) for a different"
+4 WRITE !,"eRx. This VistA Rx may or may not be for the same patient in this erx being"
+5 WRITE !,"processed."
+6 SET XX=""
SET $PIECE(XX,$SELECT($DATA(IOUON):" ",1:"-"),81)=""
WRITE !,$GET(IOUON),XX,$GET(IOUOFF)
+7 KILL DIR
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+8 QUIT
