PSOERUT6 ;ALB/MFR - eRx & Pending Order Side-by-Side LM Display - Cont'd; 06/25/2023 5:14pm
;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
;
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
S VACLINIC=$$GET1^DIQ(52.41,ORDIEN,1.1)
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 VACLINIC=$$GET1^DIQ(52.41,ORDIEN,1.1)
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)
;
; - 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERUT6 3585 printed Apr 09, 2024@21:30:29 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**;DEC 1997;Build 261
+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 SET VACLINIC=$$GET1^DIQ(52.41,ORDIEN,1.1)
+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 VACLINIC=$$GET1^DIQ(52.41,ORDIEN,1.1)
+25 SET XV="|"_$SELECT('RENEWORD:"15) ",1:"8) ")_"Remarks: "
+26 SET UNDERLN(LINE,41)=$SELECT('RENEWORD:3,1:2)
+27 DO ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
+28 KILL VARR
DO WRAP^PSOERUT($GET(PSONEW("REMARKS")),38,.VARR)
+29 FOR I=1:1
if '$DATA(VARR(I))
QUIT
Begin DoDot:1
+30 IF $GET(VARR(I,0))=""
QUIT
+31 DO ADDLINE^PSOERUT0("LM",NMSPC,"","| "_$$COMPARE^PSOERUT0("LM",VARR(I,0),VARR(I,0),42))
End DoDot:1
+32 DO BLANKLN^PSOERUT0("LM")
+33 ; - Diagnostics
+34 DO SETDIAGS^PSOERUT3("LM",NMSPC,ERXIEN)
+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
