Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERUT6

PSOERUT6.m

Go to the documentation of this file.
  1. 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**;DEC 1997;Build 26
  1. ;
  1. EN ; Continuation of PSOERUT5 due to routine size limit
  1. ;
  1. ; - Provider
  1. S XE="Provider: "_$$COMPARE^PSOERUT0("LM",$E(ERXPRVNM,1,29),PENDATA("PROVIDER NAME"),11)
  1. S XV="|"_$S('RENEWORD:"13) ",1:"6) ")_"Provider: "_$$COMPARE^PSOERUT0("LM",$E(PENDATA("PROVIDER NAME"),1,26),ERXPRVNM,$S('RENEWORD:55,1:54))
  1. S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. S PRVIEN=$S($G(PENDATA("PROVIDER")):PENDATA("PROVIDER"),1:$$GET1^DIQ(52.41,ORDIEN,5,"I"))
  1. I $G(PKI),+$G(DRUGDATA("DEA"))>1,+$G(DRUGDATA("DEA"))<6 D
  1. . D CSPRV^PSOERUT4(PRVIEN,+VADRGIEN,$$GET1^DIQ(52.41,ORDIEN,.01,"I"))
  1. I $$GET1^DIQ(200,PRVIEN,53.7,"I"),$$GET1^DIQ(200,PRVIEN,53.8,"I") D
  1. . S XV="|Cos-Provider: "_$$COMPARE^PSOERUT0("LM",$$GET1^DIQ(200,PRVIEN,53.8),$$GET1^DIQ(200,PRVIEN,53.8),55)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; - Copies
  1. S VACLINIC=$$GET1^DIQ(52.41,ORDIEN,1.1)
  1. S COPIES=$S($G(PENDATA("COPIES")):PENDATA("COPIES"),1:1)
  1. S XV="|"_$S('RENEWORD:"14) ",1:"7) ")_"Copies: "_$$COMPARE^PSOERUT0("LM",COPIES,COPIES,$S('RENEWORD:53,1:52))
  1. S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
  1. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. D BLANKLN^PSOERUT0("LM")
  1. ;
  1. ; - Remarks
  1. S VACLINIC=$$GET1^DIQ(52.41,ORDIEN,1.1)
  1. S XV="|"_$S('RENEWORD:"15) ",1:"8) ")_"Remarks: "
  1. S UNDERLN(LINE,41)=$S('RENEWORD:3,1:2)
  1. D ADDLINE^PSOERUT0("LM",NMSPC,"",XV)
  1. K VARR D WRAP^PSOERUT($G(PSONEW("REMARKS")),38,.VARR)
  1. F I=1:1 Q:'$D(VARR(I)) D
  1. . I $G(VARR(I,0))="" Q
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,"","| "_$$COMPARE^PSOERUT0("LM",VARR(I,0),VARR(I,0),42))
  1. D BLANKLN^PSOERUT0("LM")
  1. ; - Diagnostics
  1. D SETDIAGS^PSOERUT3("LM",NMSPC,ERXIEN)
  1. ;
  1. ; - DEA compliance note for eRx CS prescriptions
  1. I $$GET1^DIQ(52.49,ERXIEN,95.1,"I"),$$CS^PSOERXA0(VADRGIEN) D
  1. . D BLANKLN^PSOERUT0("LM",1)
  1. . S XE=" This prescription meets the requirements of the Drug Enforcement Administration"
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
  1. . S XE=" (DEA) electronic prescribing for controlled substances rules (21 CFR Parts"
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
  1. . S XE=" 1300, 1304, 1306, & 1311)."
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
  1. . D BLANKLN^PSOERUT0("LM",1)
  1. ;
  1. ; - Entry Accepted by/date/time
  1. S ACCDTBY=$$ACCDTBY^PSOERUT4(ERXIEN)
  1. S XX=" eRx Received on "_$P($$FMTE^XLFDT($$GET1^DIQ(52.49,ERXIEN,.03,"I"),"2Y"),":",1,2)
  1. S XX=XX_" | Accepted by "_$E($P(ACCDTBY,"^",2),1,17)_" on "_$P($P(ACCDTBY,"^",1),":",1,2)
  1. S XX=$E(XX,1,80),XE="",$E(XE,(80-$L(XX))\2+1)=XX
  1. D ADDLINE^PSOERUT0("LM",NMSPC,$$COMPARE^PSOERUT0("LM",XE,XE,2))
  1. Q
  1. ;
  1. 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)
  1. ;Output: VISTAPAT - Pointer to the PATIENT file (#2) associated with the eRx
  1. N VISTAPAT,MTYPE,REQIEN,NEWRXIEN
  1. S VISTAPAT=+$$GET1^DIQ(52.49,ERXIEN,.05,"I")
  1. S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
  1. I 'VISTAPAT,"RR,CA,"[MTYPE D
  1. . S NEWRXIEN=$$RESOLV^PSOERXU2(ERXIEN)
  1. . S VISTAPAT=+$$GET1^DIQ(52.49,NEWRXIEN,.05,"I")
  1. I 'VISTAPAT,"RE,CN,IE,"[MTYPE D
  1. . S REQIEN=$$RESOLV^PSOERXU2(ERXIEN) Q:'REQIEN
  1. . S VISTAPAT=+$$GET1^DIQ(52.49,REQIEN,.05,"I") I VISTAPAT Q
  1. . S NEWRXIEN=$$RESOLV^PSOERXU2(REQIEN)
  1. . S VISTAPAT=+$$GET1^DIQ(52.49,NEWRXIEN,.05,"I")
  1. Q VISTAPAT
  1. ;
  1. CSERX(ORD) ; Check whether a Pending Order is for a CS eRx
  1. ; Input: ORD - Pointer to OUTPATIENT PENDING ORDER file (#52.41)
  1. I $$ERXIEN^PSOERXUT(ORD_"P"),$$CSDRG(+$$GET1^DIQ(52.41,+ORD,11,"I")) D Q 1
  1. . S VALMSG="Only the 'Routing' field can be edited (CS eRx).",VALMBCK="R" W $C(7)
  1. Q 0
  1. ;
  1. CSDRG(DRGIEN) ; Controlled Substance drug?
  1. ; Input: DRGIEN - Pointer to DRUG file (#50)
  1. ;Output: $$CS - 1:YES / 0:NO
  1. N DEA
  1. Q:'DRGIEN 0
  1. S DEA=$$GET1^DIQ(50,DRGIEN,3)
  1. I (DEA'["0"),(DEA'["M"),(DEA["2")!(DEA["3")!(DEA["4")!(DEA["5") Q 1
  1. Q 0
  1. ;
  1. VS(ERXIEN,TYPE) ; View Suggestion(s)
  1. ;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ; TYPE - Type of Suggestion("PA": Patient;"PR": Provider;"DR": Drug)
  1. N ERXPAT,ERXPRV,DRUGHASH,ERX,VPRV,VPAT,RDAT
  1. S VALMBCK="R",(VPRVOK,VPATOK)=0
  1. I TYPE="PR" D
  1. . S ERXPRV=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
  1. . S VPRV=0 F S VPRV=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV)) Q:'VPRV D I VPRVOK Q
  1. . . S RDAT=0 F S RDAT=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,RDAT)) Q:'RDAT D I VPRVOK Q
  1. . . . S ERX=0 F S ERX=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,RDAT,ERX)) Q:'ERX D I VPRVOK Q
  1. . . . . I ERX'=ERXIEN S VPRVOK=1
  1. I TYPE="PR",'VPRVOK D Q
  1. . S VALMSG="There are no suggestions for this Provider" W $C(7)
  1. I TYPE="PA" D
  1. . S ERXPAT=+$$GET1^DIQ(52.49,+$G(ERXIEN),.04,"I")
  1. . S VPAT=0 F S VPAT=$O(^PS(52.49,"APATVPAT",ERXPAT,VPAT)) Q:'VPAT D I VPATOK Q
  1. . . I $$DEAD^PSONVARP(VPAT) Q
  1. . . S RDAT=0 F S RDAT=$O(^PS(52.49,"APATVPAT",ERXPAT,VPAT,RDAT)) Q:'RDAT D I VPATOK Q
  1. . . . S ERX=0 F S ERX=$O(^PS(52.49,"APATVPAT",ERXPAT,VPAT,RDAT,ERX)) Q:'ERX D I VPATOK Q
  1. . . . . I ERX'=ERXIEN S VPATOK=1
  1. I TYPE="PA",'VPATOK D Q
  1. . S VALMSG="There are no suggestions for this Patient" W $C(7)
  1. I TYPE="DR" S DRUGHASH=$$DRUGHASH^PSOERUT(ERXIEN)
  1. I TYPE="DR",'DRUGHASH D Q
  1. . S VALMSG="Unable to calculate the hash value for this eRx" W $C(7)
  1. I TYPE="DR",'$O(^PS(52.49,"ADRGVRX",DRUGHASH,0)) D Q
  1. . S VALMSG="There are no suggestions for this Drug" W $C(7)
  1. D FULL^VALM1
  1. I TYPE="PA" D MATCHSUG^PSOERPT1(ERXIEN,1)
  1. I TYPE="PR" D MATCHSUG^PSOERPV1(ERXIEN,1)
  1. I TYPE="DR" D MATCHSUG^PSOERUT4(ERXIEN,1)
  1. Q
  1. ;
  1. LASTRXST(RXIEN) ; Returns the Rx Last Fill status (For Future Fill Suggestion only)
  1. ; Input: RXIEN - pointer to PRESCRIPTION file (#52)
  1. ;Output: STATUS - Last fill status ("R":Relased;"T":Transmitted;"S":Suspended)
  1. N LASTFILL,FILLDATE,RELDATE,RXSTS
  1. S LASTFILL=$$LSTRFL^PSOBPSU1(RXIEN)
  1. S RELDATE=$$RXRLDT^PSOBPSUT(RXIEN,LASTFILL)\1
  1. S RXSTS=+$$GET1^DIQ(52,RXIEN,100,"I")
  1. S FILLDATE=$$RXFLDT^PSOBPSUT(RXIEN,LASTFILL)
  1. ; Last Fill released, Release Date + Days Supply in the future
  1. I RELDATE,$$FMADD^XLFDT(RELDATE,$$GET1^DIQ(52,RXIEN,8))>DT Q "R"
  1. ; Last Fill is not released, is Suspended, Not Transmitted/Printed, Future Fill Date
  1. I 'RELDATE,(RXSTS=5),FILLDATE>DT Q "S"
  1. ; Last Fill is not released, is Transmitted or Re-Transmitted to CMOP
  1. I 'RELDATE,$$CMOPSTS^PSOERUT(RXIEN,LASTFILL)=0!($$CMOPSTS^PSOERUT(RXIEN,LASTFILL)=2) Q "T"
  1. Q ""