MHVPRNA ;MHV/CFS - Prescription Renewal Check API; [02/08/2022 11:38am]
;;1.0;My HealtheVet;**74**;Aug 23 2005;Build 42
;;Per VA Directive 6402, this routine should not be modified
;
RENWCHK(PSODFN,PSORX) ;
; This API function checks if a prescription can be renewed or not.
; Input: PSODFN (required) - Patient IEN Number
; PSORX (required) - Prescription Number
; Output: 0^Message - Cannot be renewed
; 1 - Can be renewed
;
N DAT,PSDRGIEN,PSOCHKPR,PSODRG,PSODRUG0,PSOINDAT,PSOLC,PSONEWOI,PSOOCPRX,PSOOLPF
N PSOOLPD,PSONOSIG,PSOREFIL,PSOSURX,RX0,ST,X1,X2
I $G(PSODFN)="" Q "0^Patient DFN is required."
I $G(PSORX)="" Q "0^Prescription ien is required."
;Check if the Provider can be assigned to a specific Prescription
S PSOCHKPR=$$CHKRXPRV^PSOUTIL(PSORX)
I 'PSOCHKPR Q "0^"_$P(PSOCHKPR,"^",2)
;I '$D(^PSRX(PSORX,0)) Q "0^Prescription order not found."
S RX0=^PSRX(PSORX,0),DAT=$$DT^XLFDT()
I PSODFN'=$P(RX0,"^",2) Q "0^Prescription not ordered for patient."
;Check if drug is Clozapine. Cannot be renewed.
S PSDRGIEN=$$GET1^DIQ(52,PSORX,6,"I") ; drug IEN
I PSDRGIEN,$$GET1^DIQ(50,PSDRGIEN,17.5)="PSOCLO1" Q "0^Cannot renew a Clozapine order."
;Check of Titration RX.
I $$TITRX^PSOUTL(PSORX)="t" Q "0^Cannot Renew a 'Titration Rx'."
S PSOREFIL=$$LSTRFL^PSOBPSU1(PSORX) ;Get the latest refill
I $$FIND^PSOREJUT(PSORX,PSOREFIL) Q "0^NOT ALLOWED! Rx has OPEN 3rd Party Payer Reject."
;Check for X-cept conjunction. X conjunction is no longer valid but is being screened out instead of removed for historical data.
I $$CONJ^PSOUTL(PSORX) Q "0^Cannot be renewed - invalid Except conjunction."
;Check if orderable prescription has been inactivated.
S PSODRG=+$P(^PSRX(PSORX,0),"^",6),ST=+^("STA") ;PSODRG=IEN to drug file 52. ST=Status.
S PSONEWOI=+$P($G(^PSDRUG(+$G(PSODRG),2)),"^") ;Pharmacy orderable item.
S PSOINDAT=$P($G(^PS(50.7,PSONEWOI,0)),"^",4) ;Inactive date.
I PSOINDAT,DAT>PSOINDAT Q "0^This Orderable Item has been Inactivated."
I ST=5 S PSOSURX=$O(^PS(52.5,"B",PSORX,0)) I PSOSURX,$P($G(^PS(52.5,PSOSURX,0)),"^",7)="L" Q "0^Rx loading into a CMOP Transmission."
S X1=DAT,X2=-120 D C^%DTC I $P($G(^PSRX(PSORX,2)),"^",6)<X Q "0^Prescription Expired more than 120 Days."
S X1=DAT,X2=-120 D C^%DTC I $P($G(^PSRX(PSORX,3)),"^",5),$P($G(^(3)),"^",5)<X,ST=12 Q "0^Prescription Discontinued more than 120 Days."
S PSOOCPRX=PSORX D CDOSE^PSORENW0 I $G(PSOOLPF) Q "0^Non-Renewable, invalid Dosage of "_$G(PSOOLPD)
I PSONOSIG Q "0^Non-Renewable, missing signature."
I $P($G(^PSDRUG(PSODRG,2)),"^",3)'["O" Q "0^Drug is No longer used by Outpatient Pharmacy."
I $G(^PSDRUG(PSODRG,"I"))]"",DAT>$G(^("I")) Q "0^This Drug has been Inactivated."
S PSODRUG0=^PSDRUG(PSODRG,0)
I ($P(PSODRUG0,"^",3)[1)!($P(PSODRUG0,"^",3)[2)!($P(PSODRUG0,"^",3)["W") Q "0^Non-Renewable "_$S($P(PSODRUG0,"^",3)["A":"Narcotic Drug.",1:"Drug.")
I $D(^PS(53,+$P(RX0,"^",3),0)),'$P(^(0),"^",5) Q "0^Non-Renewable Prescription."
S PSOLC=$P(RX0,"^"),PSOLC=$E(PSOLC,$L(PSOLC)) I $A(PSOLC)'<90 Q "0^Max number of renewals (26) has been reached."
I ST,ST'=2,ST'=5,ST'=6,ST'=11,ST'=12,ST'=14 Q "0^Prescription is in a Non-Renewable Status."
I $P($G(^PSRX(PSORX,"OR1")),"^",4) Q "0^Duplicate Rx Renewal Request."
I $O(^PS(52.41,"AQ",PSORX,0)) Q "0^Duplicate Rx Renewal Request."
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHVPRNA 3367 printed Dec 13, 2024@02:16:05 Page 2
MHVPRNA ;MHV/CFS - Prescription Renewal Check API; [02/08/2022 11:38am]
+1 ;;1.0;My HealtheVet;**74**;Aug 23 2005;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified
+3 ;
RENWCHK(PSODFN,PSORX) ;
+1 ; This API function checks if a prescription can be renewed or not.
+2 ; Input: PSODFN (required) - Patient IEN Number
+3 ; PSORX (required) - Prescription Number
+4 ; Output: 0^Message - Cannot be renewed
+5 ; 1 - Can be renewed
+6 ;
+7 NEW DAT,PSDRGIEN,PSOCHKPR,PSODRG,PSODRUG0,PSOINDAT,PSOLC,PSONEWOI,PSOOCPRX,PSOOLPF
+8 NEW PSOOLPD,PSONOSIG,PSOREFIL,PSOSURX,RX0,ST,X1,X2
+9 IF $GET(PSODFN)=""
QUIT "0^Patient DFN is required."
+10 IF $GET(PSORX)=""
QUIT "0^Prescription ien is required."
+11 ;Check if the Provider can be assigned to a specific Prescription
+12 SET PSOCHKPR=$$CHKRXPRV^PSOUTIL(PSORX)
+13 IF 'PSOCHKPR
QUIT "0^"_$PIECE(PSOCHKPR,"^",2)
+14 ;I '$D(^PSRX(PSORX,0)) Q "0^Prescription order not found."
+15 SET RX0=^PSRX(PSORX,0)
SET DAT=$$DT^XLFDT()
+16 IF PSODFN'=$PIECE(RX0,"^",2)
QUIT "0^Prescription not ordered for patient."
+17 ;Check if drug is Clozapine. Cannot be renewed.
+18 ; drug IEN
SET PSDRGIEN=$$GET1^DIQ(52,PSORX,6,"I")
+19 IF PSDRGIEN
IF $$GET1^DIQ(50,PSDRGIEN,17.5)="PSOCLO1"
QUIT "0^Cannot renew a Clozapine order."
+20 ;Check of Titration RX.
+21 IF $$TITRX^PSOUTL(PSORX)="t"
QUIT "0^Cannot Renew a 'Titration Rx'."
+22 ;Get the latest refill
SET PSOREFIL=$$LSTRFL^PSOBPSU1(PSORX)
+23 IF $$FIND^PSOREJUT(PSORX,PSOREFIL)
QUIT "0^NOT ALLOWED! Rx has OPEN 3rd Party Payer Reject."
+24 ;Check for X-cept conjunction. X conjunction is no longer valid but is being screened out instead of removed for historical data.
+25 IF $$CONJ^PSOUTL(PSORX)
QUIT "0^Cannot be renewed - invalid Except conjunction."
+26 ;Check if orderable prescription has been inactivated.
+27 ;PSODRG=IEN to drug file 52. ST=Status.
SET PSODRG=+$PIECE(^PSRX(PSORX,0),"^",6)
SET ST=+^("STA")
+28 ;Pharmacy orderable item.
SET PSONEWOI=+$PIECE($GET(^PSDRUG(+$GET(PSODRG),2)),"^")
+29 ;Inactive date.
SET PSOINDAT=$PIECE($GET(^PS(50.7,PSONEWOI,0)),"^",4)
+30 IF PSOINDAT
IF DAT>PSOINDAT
QUIT "0^This Orderable Item has been Inactivated."
+31 IF ST=5
SET PSOSURX=$ORDER(^PS(52.5,"B",PSORX,0))
IF PSOSURX
IF $PIECE($GET(^PS(52.5,PSOSURX,0)),"^",7)="L"
QUIT "0^Rx loading into a CMOP Transmission."
+32 SET X1=DAT
SET X2=-120
DO C^%DTC
IF $PIECE($GET(^PSRX(PSORX,2)),"^",6)<X
QUIT "0^Prescription Expired more than 120 Days."
+33 SET X1=DAT
SET X2=-120
DO C^%DTC
IF $PIECE($GET(^PSRX(PSORX,3)),"^",5)
IF $PIECE($GET(^(3)),"^",5)<X
IF ST=12
QUIT "0^Prescription Discontinued more than 120 Days."
+34 SET PSOOCPRX=PSORX
DO CDOSE^PSORENW0
IF $GET(PSOOLPF)
QUIT "0^Non-Renewable, invalid Dosage of "_$GET(PSOOLPD)
+35 IF PSONOSIG
QUIT "0^Non-Renewable, missing signature."
+36 IF $PIECE($GET(^PSDRUG(PSODRG,2)),"^",3)'["O"
QUIT "0^Drug is No longer used by Outpatient Pharmacy."
+37 IF $GET(^PSDRUG(PSODRG,"I"))]""
IF DAT>$GET(^("I"))
QUIT "0^This Drug has been Inactivated."
+38 SET PSODRUG0=^PSDRUG(PSODRG,0)
+39 IF ($PIECE(PSODRUG0,"^",3)[1)!($PIECE(PSODRUG0,"^",3)[2)!($PIECE(PSODRUG0,"^",3)["W")
QUIT "0^Non-Renewable "_$SELECT($PIECE(PSODRUG0,"^",3)["A":"Narcotic Drug.",1:"Drug.")
+40 IF $DATA(^PS(53,+$PIECE(RX0,"^",3),0))
IF '$PIECE(^(0),"^",5)
QUIT "0^Non-Renewable Prescription."
+41 SET PSOLC=$PIECE(RX0,"^")
SET PSOLC=$EXTRACT(PSOLC,$LENGTH(PSOLC))
IF $ASCII(PSOLC)'<90
QUIT "0^Max number of renewals (26) has been reached."
+42 IF ST
IF ST'=2
IF ST'=5
IF ST'=6
IF ST'=11
IF ST'=12
IF ST'=14
QUIT "0^Prescription is in a Non-Renewable Status."
+43 IF $PIECE($GET(^PSRX(PSORX,"OR1")),"^",4)
QUIT "0^Duplicate Rx Renewal Request."
+44 IF $ORDER(^PS(52.41,"AQ",PSORX,0))
QUIT "0^Duplicate Rx Renewal Request."
+45 QUIT 1
