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

PSOUTIL.m

Go to the documentation of this file.
  1. PSOUTIL ;IHS/DSD/JCM - outpatient pharmacy utility routine ;12/28/15 4:01pm
  1. ;;7.0;OUTPATIENT PHARMACY;**64,456,444,469,504,651,545,731**;DEC 1997;Build 18
  1. ;External reference $$MXDAYSUP^PSSUTIL1 supported by DBIA 6229
  1. ;External reference to ^ORDEA is supported by DBIA 5709
  1. ;
  1. Q
  1. ;
  1. NPSOSD(PSORX) ; Entry point to add newly added rx to patients PSOSD array
  1. S STA="ACTIVE^NON-VERIFIED^R^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUE^^DISCONTINUE^DISCONTINUE^HOLD"
  1. S STAT=$P(STA,"^",$P(^PSRX(PSORX("IRXN"),"STA"),"^")+1)
  1. I $D(PSOSD(STAT,PSODRUG("NAME"))),$P(PSOSD(STAT,PSODRUG("NAME")),"^",2)<10 D
  1. . S PSOSD(STAT,PSODRUG("NAME")_"^"_PSORX("IRXN"))=PSORX("IRXN")_"^"_$P($G(^PSRX(PSORX("IRXN"),"STA")),"^")_"^^^"_PSODRUG("VA CLASS")_"^"_$P(^PSRX(PSORX("IRXN"),0),"^",9)_"^"_PSODRUG("NDF")_"^"_$P(^PSRX(PSORX("IRXN"),0),"^",8)_"^1"
  1. E S PSOSD(STAT,PSODRUG("NAME"))=PSORX("IRXN")_"^"_$P($G(^PSRX(PSORX("IRXN"),"STA")),"^")_"^^^"_PSODRUG("VA CLASS")_"^"_$P(^PSRX(PSORX("IRXN"),0),"^",9)_"^"_PSODRUG("NDF")_"^"_$P(^PSRX(PSORX("IRXN"),0),"^",8)_"^1"
  1. S PSOSD=$S($G(PSOSD)]"":PSOSD+1,1:1),^TMP("PS",$J,STAT,PSODRUG("NAME"))=1
  1. Q
  1. ;
  1. RNPSOSD ;update PSOSD array for renewals
  1. S STA="ACTIVE^NON-VERIFIED^R^HOLD^NON-VERIFIED^ACTIVE^^^^^^ACTIVE^DISCONTINUE^^DISCONTINUE^DISCONTINUE^HOLD"
  1. S STAT=$P(STA,"^",$P(^PSRX(PSORENW("OIRXN"),"STA"),"^")+1)
  1. I $D(PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("OIRXN"))) D
  1. . S PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("IRXN"))=PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("OIRXN")),$P(PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("IRXN")),"^",2)=$P($G(^PSRX(PSORENW("IRXN"),"STA")),"^")
  1. . S $P(PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("IRXN")),"^",6)=$P(^PSRX(PSORENW("IRXN"),0),"^",9)
  1. . K PSOSD(STAT,PSODRUG("NAME")_"^"_PSORENW("OIRXN")) Q
  1. E D
  1. .S $P(PSOSD(STAT,PSODRUG("NAME")),"^")=PSORENW("IRXN"),$P(PSOSD(STAT,PSODRUG("NAME")),"^",2)=$P($G(^PSRX(PSORENW("IRXN"),"STA")),"^")
  1. .S $P(PSOSD(STAT,PSODRUG("NAME")),"^",6)=$P(^PSRX(PSORENW("IRXN"),0),"^",9)
  1. .S ^TMP("PS",$J,STAT,PSODRUG("NAME"))=1
  1. Q
  1. ;
  1. PROV(PSORENW) ;called from psoornew
  1. CHKPRV ;check inactive providers and cosinging providers called from PSORENW (renew rx)
  1. N OK
  1. I '$D(^VA(200,PSORENW("PROVIDER"),0)) D I 'OK G:PSORENW("DFLG") CHKPRVX
  1. .W !,$C(7),"Provider not in New Person File .. You must select a new provider"
  1. .S PSODIR("FIELD")=0 K PSORENW("PROVIDER") D PROV^PSODIR(.PSORENW)
  1. .S:$G(PSORENW("PROVIDER"))']"" PSORENW("DFLG")=1
  1. ;
  1. I '$G(^VA(200,PSORENW("PROVIDER"),"PS")) D G:PSORENW("DFLG") CHKPRVX
  1. .I $$ISSPLY(),$D(^XUSEC("ORSUPPLY",PSORENW("PROVIDER"))) S OK=1 Q
  1. .S OK=0 W !,$C(7),$P(^VA(200,PSORENW("PROVIDER"),0),"^")_" is not a Valid provider .. You must select a new provider"
  1. .S PSODIR("FIELD")=0 K PSORENW("PROVIDER") D PROV^PSODIR(.PSORENW)
  1. .S:$G(PSORENW("PROVIDER"))']"" PSORENW("DFLG")=1
  1. ;
  1. K PSOX S PSOX=$P($G(^VA(200,PSORENW("PROVIDER"),"PS")),"^",4)
  1. I PSOX,PSOX<DT D G:PSORENW("DFLG") CHKPRVX
  1. .W !,$C(7),$P(^VA(200,PSORENW("PROVIDER"),0),"^")_" is inactive as a provider .. You must select a new provider"
  1. .S PSODIR("FIELD")=0 K PSORENW("PROVIDER") D PROV^PSODIR(.PSORENW)
  1. .I $G(PSORENW("PROVIDER"))']"" S PSORENW("DFLG")=1
  1. ;
  1. I '$D(PSORENW("COSIGNING PROVIDER")),$D(PSORENW("COSIGNER")) K PSOX S PSOX=$P(^VA(200,PSORENW("COSIGNER"),"PS"),"^",4) I PSOX,PSOX<DT D
  1. .W !,$C(7),"Inactive Cosigning Provider .. You must select a new cosigner"
  1. .S PSODIR("FIELD")=0,PSODIR("PROVIDER")=$S($D(PSORENW("PROVIDER")):PSORENW("PROVIDER"),1:PSORENW("PROVIDER"))
  1. .D COSIGN^PSODIR I '$D(PSODIR("COSIGNING PROVIDER")) S PSORENW("DFLG")=1
  1. .S PSORENW("COSIGNING PROVIDER")=PSODIR("COSIGNING PROVIDER")
  1. ;
  1. CHKPRVX K PSODIR,PSOX
  1. Q
  1. ;
  1. NEXT(PSOX) ;
  1. S PSOX("RX0")=^PSRX(PSOX("IRXN"),0)
  1. S PSOX("RX2")=^PSRX(PSOX("IRXN"),2)
  1. S PSOX("RX3")=^PSRX(PSOX("IRXN"),3)
  1. S PSOX1=$P(PSOX("RX2"),"^",2)
  1. I '$O(^PSRX(PSOX("IRXN"),1,0)) D G NEXTX
  1. . S $P(PSOX("RX3"),"^")=PSOX1,X1=PSOX1
  1. . S X2=$P(PSOX("RX0"),"^",8)-10\1
  1. . D C^%DTC
  1. . S:'$P(PSOX("RX3"),"^",8) $P(PSOX("RX3"),"^",2)=X
  1. . K X Q
  1. ;
  1. S PSOY2=0
  1. F PSOY=0:0 S PSOY=$O(^PSRX(PSOX("IRXN"),1,PSOY)) Q:'PSOY S PSOY1=PSOY,PSOY2=PSOY2+1
  1. S PSOY=^PSRX(PSOX("IRXN"),1,PSOY1,0)
  1. S PSOX2=$P(PSOY,"^")
  1. S $P(PSOX("RX3"),"^")=PSOX2,X1=PSOX2
  1. S X2=$P(PSOX("RX0"),"^",8)-10\1
  1. D C^%DTC S PSOY3=X
  1. S X1=PSOX1,X2=(PSOY2+1)*$P(PSOX("RX0"),"^",8)-10\1
  1. D C^%DTC S PSOY4=X
  1. S $P(PSOX("RX3"),"^",2)=$S(PSOY3<PSOY4:PSOY4,1:PSOY3)
  1. NEXTX ;
  1. K X,PSOX1,PSOX2,PSOY,PSOY1,PSOY2,PSOY3,PSOY4
  1. Q
  1. ;
  1. SUSDATE(PSOX) ;
  1. S PSOX("OLD FILL DATE")=PSOX("FILL DATE")
  1. S PSORX("OLD FILL DATE")=PSORX("FILL DATE")
  1. S PSOX("FILL DATE")=$P(PSOX("RX3"),"^",2)
  1. I $O(^PS(52.5,"B",PSOX("IRXN"),0)),'$G(^PS(52.5,+$O(^PS(52.5,"B",PSOX("IRXN"),0)),"P")) S PSOX("FILL DATE")=$P(PSOX("RX3"),"^")
  1. S Y=PSOX("FILL DATE")
  1. X ^DD("DD") S PSORX("FILL DATE")=Y K Y
  1. Q
  1. ;
  1. SUSDATEK(PSOX) ;
  1. S PSOX("FILL DATE")=PSOX("OLD FILL DATE")
  1. I $G(PSORX("OLD FILL DATE"))="",$G(PSORENW("OLD FILL DATE")) S Y=PSORENW("OLD FILL DATE") D DD^%DT S PSORX("OLD FILL DATE")=Y K Y
  1. S PSORX("FILL DATE")=PSORX("OLD FILL DATE")
  1. K PSOX("OLD FILL DATE"),PSORX("OLD FILL DATE")
  1. Q
  1. ;
  1. STATUS(PSOREA,PSOSTAT) ;
  1. S DSMSG="Cannot "_$S($G(PSOOPT)=3:"renew",1:"refill")_" Rx. " S:$G(OR0) ACOM=DSMSG
  1. I PSOREA["A" W:$G(SPEED) ", Inactive Drug.",! D
  1. .S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Inactive Drug.",VALMBCK="R" W:'$G(POERR) !," Inactive Drug"
  1. .S:$G(OR0) ACOM=ACOM_" Inactive Drug."
  1. I PSOREA["M" W:$G(SPEED) ", Drug no longer used by Outpatient.",! D
  1. .S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Drug no longer used by Outpatient.",VALMBCK="R" W:'$G(POERR) !," Drug no longer used by Outpatient."
  1. .S:$G(OR0) ACOM=ACOM_" Drug no longer used by Outpatient."
  1. ;
  1. I PSOREA["B" W:$G(SPEED) ", Narcotic Drug." D
  1. .W:'$G(POERR) !,"Narcotic Drug" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Narcotic Drug.",VALMBCK="R"
  1. .S:$G(OR0) ACOM=ACOM_" Narcotic Drug."
  1. ;
  1. I PSOREA["C" W:$G(SPEED) ", Non-Renewable Drug." D
  1. .W:'$G(POERR) !,"Non-Renewable Drug" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Non-Renewable Drug.",VALMBCK="R"
  1. .S:$G(OR0) ACOM=ACOM_" Non-Renewable Drug."
  1. ;
  1. I PSOREA["D" W:$G(SPEED) ", Non-Renewable Patient Status." D
  1. .W:'$G(POERR) !,"Non-Renewable Patient Status" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Non-Renewable Patient Status.",VALMBCK="R"
  1. .S:$G(OR0) ACOM=ACOM_" Non-Renewable Patient Status."
  1. ;
  1. I PSOREA["E" W:$G(SPEED) ", Non-Verified Rx." D
  1. .W:'$G(POERR) !,"Non-Verified Rx" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Non-Verified Rx.",VALMBCK="R"
  1. .S:$G(OR0) ACOM=ACOM_" Non-Verified Rx."
  1. ;
  1. I PSOREA["F" W:$G(SPEED) ", Maximum of 26 Renewals." D
  1. .W:'$G(POERR) !,"Maximum of 26 Renewals" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"Maximum of 26 Renewals.",VALMBCK="R"
  1. .S:$G(OR0) ACOM=ACOM_" Maximum of 26 Renewals."
  1. ;
  1. I PSOREA["G",PSOREA'["B" W:$G(SPEED) ", No more refills left." W:'$G(POERR) !,"No more refills left" S:$G(POERR)&('$G(SPEED)) VALMSG=DSMSG_"No more refills left.",VALMBCK="R"
  1. ;
  1. I PSOREA["Z" D
  1. . S:PSOSTAT=4 PSOSTAT=1
  1. . S PSOA=";"_PSOSTAT,PSOB=$P(^DD(52,100,0),"^",3),PSOA=$F(PSOB,PSOA),PSOA=$P($E(PSOB,PSOA,999),";",1)
  1. . W:$G(SPEED) ", Rx is in "_$P(PSOA,":",2)_" status."
  1. . W:'$G(POERR)&('$G(SPEED)) !,"Rx is in "_$P(PSOA,":",2)_" status"
  1. .S:$G(POERR)&($G(VALMSG)']"")&('$G(SPEED)) VALMSG=DSMSG_"Rx is in "_$P(PSOA,":",2)_" status.",VALMBCK="R"
  1. . K PSOA,PSOB
  1. . Q
  1. I $G(SPEED) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIRUT,DUOUT,DTOUT,DIR
  1. Q
  1. ACP I $P(^PSRX(PSOX("IRXN"),0),"^",11)="W",$G(^("IB")) S ^PSRX("ACP",$P(^PSRX(PSOX("IRXN"),0),"^",2),$P(^(2),"^",2),0,PSOX("IRXN"))=""
  1. Q
  1. ;
  1. RENFDT(PSOX) ;gets the correct fill date
  1. S PSOX("OLD FILL DATE")=PSOX("FILL DATE")
  1. S PSORX("OLD FILL DATE")=PSORX("FILL DATE")
  1. S PSOX("FILL DATE")=$P(PSOX("RX3"),"^",2)
  1. N RXY,LBL,SUPN,LBP,RF,RFN,RFD
  1. S RXY=PSOX("IRXN"),RFN=0
  1. I '$O(^PSRX(RXY,1,0)) D GFDT G SDTX
  1. F RF=0:0 S RF=$O(^PSRX(RXY,1,RF)) Q:'RF S RFN=RF
  1. S RF=^PSRX(RXY,1,RFN,0) D GFDT
  1. I PSOX("FILL DATE")<DT,PSOX("FILL DATE")<PSORNW("FILL DATE") S PSOX("FILL DATE")=DT
  1. SDTX ;
  1. S Y=PSOX("FILL DATE")
  1. X ^DD("DD") S PSORX("FILL DATE")=Y K Y
  1. Q
  1. GFDT ;
  1. I 'RFN,$P(^PSRX(RXY,2),"^",13) Q
  1. I RFN,$P(RF,"^",18) Q
  1. F LBL=0:0 S LBL=$O(^PSRX(RXY,"L",LBL)) Q:'LBL I $P(^PSRX(RXY,"L",LBL,0),"^",2)=RFN S LBP=1 Q
  1. Q:$G(LBP)
  1. S SUPN=$O(^PS(52.5,"B",RXY,0))
  1. I SUPN,$P($G(^PS(52.5,SUPN,0)),"^",7)="L"!($P($G(^(0)),"^",7)="X") Q
  1. S:RFN RFD=$E($P(RF,"^"),1,7) S:'RFN RFD=$P(PSOX("RX3"),"^")
  1. I SUPN,RFD,$D(^PS(52.5,"C",RFD,SUPN)),$G(^PS(52.5,SUPN,"P"))=1 Q
  1. S PSOX("FILL DATE")=$P(PSOX("RX3"),"^")
  1. Q
  1. ;
  1. ISSPLY() ;is the drug a supply item
  1. ;assumes the existence of the PSODRUG array
  1. I $G(PSODRUG("DEA"))="" Q 0
  1. I $G(PSODRUG("VA CLASS"))="" Q 0
  1. I PSODRUG("VA CLASS")?1"XA".E!(PSODRUG("VA CLASS")?1"XX".E)!(PSODRUG("VA CLASS")="DX900"&(PSODRUG("DEA")["S")) Q 1
  1. Q 0
  1. ;
  1. DAYSUP(DRUG,RXARR,RCLQTY) ; Adjusts DAYS SUPPLY and QUANTITY based on the maximum allowed
  1. ; Input: DRUG - DRUG file (#50) IEN
  1. ; RXARR - Array containing prescription information
  1. ; RVWQTY - Re-calculate Quantity (1: YES / 0: NO)
  1. ;Output: RXARR - Array with "DAYS SUPPLY" and "QTY" values modified
  1. ;
  1. ; - Invalid Dispense Drug
  1. I '$D(^PSDRUG(+$G(DRUG),0))!'$D(RXARR) Q
  1. N MXDAYSUP,RXDAYSUP,RXQTY,NEWQTY
  1. S MXDAYSUP=$$MXDAYSUP^PSSUTIL1(DRUG)
  1. S RXDAYSUP=+$G(RXARR("DAYS SUPPLY"))
  1. I RXDAYSUP>MXDAYSUP D
  1. . W !!,"The current DAYS SUPPLY value (",RXDAYSUP,") exceeds the Maximum allowed"
  1. . W !,"for ",$$GET1^DIQ(50,DRUG,.01)," (",MXDAYSUP,") and will be reset.",$C(7)
  1. . S RXARR("DAYS SUPPLY")=MXDAYSUP
  1. . S RXQTY=+$G(RXARR("QTY"))
  1. . I $G(RCLQTY),RXQTY,RCLQTY'=RXQTY D
  1. . . S NEWQTY=((RXQTY*MXDAYSUP)/RXDAYSUP)+.5\1
  1. . . W !!,"The Quantity was changed from ",RXQTY," to ",NEWQTY,"."
  1. . . S RXARR("QTY")=NEWQTY
  1. . W !!,"Please, review the modified order before accepting it."
  1. . W ! N DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR
  1. Q
  1. ;
  1. MAXNUMRF(DRUG,DAYSUP,PTST,CLOZPAT) ; Returns the Maximum Number of Refills Allowed
  1. ; Input: DRUG - DRUG file (#50) IEN
  1. ; DAYSUP - Number of DAYS SUPPLY per fill
  1. ; PTST - RX PATIENT STATUES (#53) IEN
  1. ; CLOZPAT - Clozapine Indicator Variable (used throughout PSO)
  1. ;Output: MAXNUMRF - Maximum Number of Refills
  1. ;
  1. N MAXNUMRF,DEAHDLG,CSDRUG,MAXPTST
  1. ; - Invalid Drug or DAYS SUPPLY value
  1. I '$D(^PSDRUG(+$G(DRUG),0)),'$G(DAYSUP) Q 0
  1. ;
  1. ; - Calculating Maximum for Clozapine Drug
  1. I $D(CLOZPAT) Q $S(CLOZPAT=2&(DAYSUP=14):1,CLOZPAT=2&(DAYSUP=7):3,CLOZPAT=1&(DAYSUP=7):1,1:0)
  1. ;
  1. ; - Non-Refillable Drugs based on DEA SPECIAL HDLG field
  1. S DEAHDLG=""
  1. I $G(DRUG) S DEAHDLG=$$GET1^DIQ(50,DRUG,3) I DEAHDLG["A"&(DEAHDLG'["B")!(DEAHDLG["F")!(DEAHDLG[1)!(DEAHDLG[2) Q 0
  1. S CSDRUG=0 I (DEAHDLG[3)!(DEAHDLG[4)!(DEAHDLG[5) S CSDRUG=1
  1. ;
  1. ; - The Maximum Number of Refills Calculation is different for up to 90 Days Supply Vs. Above 90 Days Supply
  1. I $G(CSDRUG) D
  1. . I DAYSUP'>90 D
  1. . . S MAXNUMRF=$S(DAYSUP<60:5,DAYSUP'<60&(DAYSUP'>89):2,DAYSUP=90:1,1:0)
  1. . E D
  1. . . S MAXNUMRF=182\DAYSUP-1
  1. E D
  1. . I DAYSUP'>90 D
  1. . . S MAXNUMRF=$S(DAYSUP<60:11,DAYSUP'<60&(DAYSUP'>89):5,DAYSUP=90:3,1:0)
  1. . E D
  1. . . S MAXNUMRF=365\DAYSUP-1
  1. ;
  1. ; - Adjusting Maximum based Rx Patient Status
  1. I $G(PTST) S MAXPTST=$$GET1^DIQ(53,PTST,4) I MAXNUMRF>MAXPTST S MAXNUMRF=MAXPTST
  1. ;
  1. Q MAXNUMRF
  1. ;
  1. BADADDFL(RXIEN) ; Indicate whether an Rx should be flagged with a Bad Address
  1. ; Input: RXIEN - Rx IEN (#52) to be checked
  1. ;Output: BADADDFL - 1: Rx Flagged for Bad Address / 0: Rx NOT Flagged Bad Address
  1. N BADADDFL,LSTLBLSQ,LSTLBLTX
  1. S BADADDFL=0
  1. I '$G(^PSRX(+$G(RXIEN),0)) Q BADADDFL
  1. S LSTLBLSQ=$O(^PSRX(+RXIEN,"L",9999),-1)
  1. I LSTLBLSQ D
  1. . S LSTLBLTX=$G(^PSRX(+RXIEN,"L",LSTLBLSQ,0)) I LSTLBLTX["(BAD ADDRESS)" S BADADDFL=1
  1. Q BADADDFL
  1. ;
  1. PRVDETOX(PRVIEN) ; Returns the Provider DETOX#, if available and not expired
  1. ; Input: (r) PRVIEN - Provider IEN (Pointer to VA PERSON file (#200))
  1. ;Output: PRVDETOX - Provider Detox #
  1. Q "" ;P731 detox/x-waiver removal
  1. N PRVDETOX
  1. S PRVDETOX=$$DETOX^XUSER(PRVIEN) I PRVDETOX?2A7N Q PRVDETOX
  1. Q ""
  1. ;
  1. RXDEA(RXIEN,ORIEN) ; Returns the Provider DEA# associated with the Prescription/CPRS Order (At least one of RXIEN or ORIEN is required)
  1. ; Input: (o) RXIEN - Prescription IEN (Pointer to the PRESCRIPTION file (#52))
  1. ; (o) ORIEN - CPRS Order IEN (Pointer to ORDER file (#100))
  1. ;Output: RXDEA - Provider DEA# associated with the Prescription
  1. N RXDEA
  1. I $G(RXIEN) S ORIEN=+$$GET1^DIQ(52,RXIEN,39.3,"I")
  1. I $G(ORIEN) K ^TMP($J,"ORDEA") D ARCHIVE^ORDEA(ORIEN) S RXDEA=$P($G(^TMP($J,"ORDEA",ORIEN,2)),"^",1) K ^TMP($J,"ORDEA")
  1. Q $G(RXDEA)
  1. ;
  1. RXDETOX(RXIEN,ORIEN) ; Returns the Provider DETOX# associated with the Prescription/CPRS Order (At least one of RXIEN or ORIEN is required)
  1. ; Input: (o) RXIEN - Prescription IEN (Pointer to the PRESCRIPTION file (#52))
  1. ; (o) ORIEN - CPRS Order IEN (Pointer to the ORDER file (#100))
  1. ;Output: RXDETOX - Provider DETOX# associated with the Prescription
  1. N RXDETOX
  1. I $G(RXIEN) S ORIEN=+$$GET1^DIQ(52,RXIEN,39.3,"I")
  1. I $G(ORIEN) K ^TMP($J,"ORDEA") D ARCHIVE^ORDEA(ORIEN) S RXDETOX=$P($G(^TMP($J,"ORDEA",ORIEN,2)),"^",2) K ^TMP($J,"ORDEA")
  1. ;Q $G(RXDETOX) ;P731 detox/x-waiver removal
  1. Q ""
  1. ;
  1. CHKRXPRV(RXIEN,PRVIEN) ; Check if the Provider can be assigned to a specific Prescription (Used for Rx Copy, Rx Renewal, etc.)
  1. ; Input: (r) RXIEN - Prescription IEN (Pointer to the PRESCRIPTION file (#52))
  1. ; (o) PRVIEN - Provider IEN (Pointer to the NEW PERSON file (#200))
  1. ;Output: $CHKRXPRV - 1: YES / 0: NO^Short Reason (Listman)^Long Reason (Write to screen)
  1. N CHKRXPRV,DRUGIEN,CLOZDRUG,DRUGDEA,REASON
  1. I '$D(^PSRX(+$G(RXIEN),0)) Q "0^Prescription not found^Prescription not found"
  1. I '$G(PRVIEN) S PRVIEN=$$GET1^DIQ(52,RXIEN,4,"I")
  1. I '$D(^VA(200,+$G(PRVIEN),0)) Q "0^Provider not found^Provider not found"
  1. S DRUGIEN=$$GET1^DIQ(52,RXIEN,6,"I") I 'DRUGIEN Q "0^Invalid Dispense Drug^Invalid Dispense Drug"
  1. S CLOZDRUG=$S($D(^PSDRUG("ACLOZ",DRUGIEN)):1,1:0)
  1. I CLOZDRUG,'$D(^XUSEC("YSCL AUTHORIZED",PRVIEN)) Q "0^Provider does not hold YSCL AUTHORIZED key^Provider on the Rx does not hold the YSCL AUTHORIZED key required for clozapine prescriptions."
  1. S DRUGDEA=$$DRUGSCHD(DRUGIEN)
  1. I DRUGDEA'="" S REASON="" D I REASON'="" Q REASON
  1. . N PRVDEA
  1. . S PRVDEA=$P($$SDEA^XUSER(0,PRVIEN,DRUGDEA,,$$RXDEA^PSOUTIL(RXIEN)),"^") ;*545
  1. . I $L(PRVDEA)<3 D
  1. . . I PRVDEA=2 D Q
  1. . . . S REASON="0^Provider not authorized to write Federal Schedule "_DRUGDEA_" prescriptions. Please contact the provider^Provider not authorized to write Federal Schedule "_DRUGDEA_" prescriptions. Please contact the provider^2"
  1. . . S REASON="0^Provider must have a valid DEA# or VA# for this Rx^Provider does not have a valid DEA# or VA# required for this Rx^1"
  1. I $$DETOX^PSSOPKI(DRUGIEN),$$PRVDETOX^PSOUTIL(PRVIEN)="" Q "0^Provider must have a valid DETOX# for this Rx^Provider does not have a valid DETOX# required for this Rx"
  1. Q 1
  1. ;
  1. DRUGSCHD(DRUGIEN) ; Return Drug DEA Schedule or "" (blank) for non-controlled substances
  1. ; Input: (r) DRUGIEN - Dispense Drug IEN (Pointer to the DRUG file (#50))
  1. ;Output: $DRUGSCHD - DEA Schedule or "" (blank) for non-controlled substances
  1. N NDFSCHD,DRUGDEA,NDFIEN
  1. S NDFSCHD="",DRUGDEA=$$GET1^DIQ(50,DRUGIEN,3)
  1. S NDFIEN=+$$GET1^DIQ(50,DRUGIEN,22,"I") I NDFIEN S NDFSCHD=$$GET1^DIQ(50.68,NDFIEN,19,"I")
  1. I +NDFIEN>0!(DRUGDEA="") Q $S('NDFSCHD:"",1:NDFSCHD)
  1. I "^2^3^"[+DRUGDEA Q $S(DRUGDEA["A":+DRUGDEA,1:+DRUGDEA_"n")
  1. I "^4^5^"[+DRUGDEA Q +DRUGDEA
  1. Q ""