PSOOTMRX ;BIR/MFR - Titration/Maintenance Dose Prescription ;Oct 20, 2022@15:33
;;7.0;OUTPATIENT PHARMACY;**313,505,517,441,545**;DEC 1997;Build 270
;External reference to ULK^ORX2 supported by DBIA 867
;External reference to UL^PSSLOCK supported by DBIA 2789
;
TIMTRX ; Titration/Maintenance Dose Rx Hidden Action Entry Point
N PSOMTFLG,PSOTITRX,PSORXIEN,LASTDOSE,BEFLST,DOSEINFO,DEA,LAB
S PSORXIEN=$P(PSOLST(ORN),"^",2)
;
; - Rx already marked Maintenance
I $$TITRX^PSOUTL(PSORXIEN)="m" D Q
. S VALMSG="Prescription already marked as 'Maintenance Rx'.",VALMBCK="R" W $C(7)
;
; - Rx already split into Maintenance Rx
I $P($G(^PSRX(PSORXIEN,"TIT")),"^",2) D Q
. S VALMSG="A Maintenance Rx already exists for this Rx ("_$$GET1^DIQ(52,$P($G(^PSRX(PSORXIEN,"TIT")),"^",2),.01)_")"
. S VALMBCK="R" W $C(7)
;
; - Rx was Digitally Signed
I $$GET1^DIQ(52,PSORXIEN,310,"I") D Q
. S VALMSG="Rx was digitally signed and cannot be converted.",VALMBCK="R" W $C(7)
;
; - No THEN conjunction for the last dose
I '$$LTHEN^PSOUTL(PSORXIEN) D Q
. S VALMSG="A Titration Rx must have a THEN conjunction.",VALMBCK="R" W $C(7)
;
; - Rx is not ACTIVE
I $$GET1^DIQ(52,PSORXIEN,100,"I")'=0 D Q
. S VALMSG="Prescription is not ACTIVE.",VALMBCK="R" W $C(7)
;
; - Rx NOT released
I '$$RXRLDT^PSOBPSUT(PSORXIEN,0) D Q
. S VALMSG="Prescription must be RELEASED first.",VALMBCK="R" W $C(7)
;
; - Rx already has refills
I $O(^PSRX(PSORXIEN,1,0)) D Q
. S VALMSG="Prescription has previously been refilled.",VALMBCK="R" W $C(7)
;
; - Rx already has refills
I '$$GET1^DIQ(52,PSORXIEN,9) D Q
. S VALMSG="There are no refills available for this Rx.",VALMBCK="R" W $C(7)
;
; - Rx not been marked as Titration
I '$P($G(^PSRX(PSORXIEN,"TIT")),"^",3) D Q
. S VALMSG="Rx has not been marked as Titration",VALMBCK="R" W $C(7)
;
;/BLB/ PSO*7*517 - Enhanced functionality to prevent conversion of CS rx's to maintenance
I $$NDF(PSORXIEN)!($$CSRX^PSOSPMUT(PSORXIEN)) D Q
.S VALMSG="Rx is a controlled substance and cannot be converted.",VALMBCK="R" W $C(7)
;
S PSOMTFLG=1,PSOTITRX=PSORXIEN
D COPY^PSOORCPY K PSOMTFLG,PSOTITRX
;
Q
;
MARKTIT ; Mark Rx as 'Titration' Hidden Action Entry Point
N PSORXIEN,CHECK
S PSORXIEN=$P(PSOLST(ORN),"^",2)
S CHECK=$$CHECK(PSORXIEN)
I 'CHECK D Q
. S VALMBCK="R",VALMSG=$P(CHECK,"^",2) W $C(7)
;
;I $G(PSORXIEN) D MARK(PSORXIEN,1)
I $G(PSORXIEN) D
.N PSOTITO,PSOTITN
.S PSOTITO=$P($G(^PSRX(PSORXIEN,"TIT")),"^",3)
.D MARK(PSORXIEN,1)
.S PSOTITN=$P($G(^PSRX(PSORXIEN,"TIT")),"^",3) I PSOTITO=PSOTITN Q ;P441
.D EN^PSOHLSN1(PSORXIEN,"XX","","Order edited")
Q
;
END ;
Q
;
MARK(PSORXIEN,REFRESH) ; Mark a non-refillable Rx as Titration
N CHECK,DIR,PTLOCK,X,Y,DFN,COMM
;
I '$$CHECK(PSORXIEN) Q
;
D FULL^VALM1
W !
;*545 - displaying notification
I $$NDF(PSORXIEN)!($$CSRX^PSOSPMUT(PSORXIEN)) D
.Q:($$TITRX^PSOUTL(PSORXIEN)="t")
.W !,"NOTE: Marking this controlled substance Rx as a Titration prescription will"
.W !,"prevent refills and renewals. You will not be able to convert the Rx to a "
.W !,"maintenance prescription by the TR Hidden Action."
S DIR("A")="Do you want to "_$S($$TITRX^PSOUTL(PSORXIEN)="t":"UN",1:"")_"MARK this Rx as 'Titration'? "
I $$TITRX^PSOUTL(PSORXIEN)'="t" S (DIR("?"),DIR("??"))="^D TITHLP^PSOOTMRX"
I $G(PSOTITRF) S DIR("B")="No" ;P441 default set for CPRS orders only
S DIR(0)="YA" D ^DIR I Y'>0 D UNLK S VALMBCK="R" Q
;
W !!,"Updating..."
I '$P($G(^PSRX(PSORXIEN,"TIT")),"^",3) D
. S $P(^PSRX(PSORXIEN,"TIT"),"^",3)=1,COMM="MARKED as Titration"
E D
. S $P(^PSRX(PSORXIEN,"TIT"),"^",3)="",COMM="UNMARKED as Titration"
. I ($D(^PSRX(PSORXIEN,"TIT"))=1),$TR($G(^PSRX(PSORXIEN,"TIT")),"^","")="" D
. . K ^PSRX(PSORXIEN,"TIT") ; Cleaning up the "TIT" subscript
D RXACT^PSOBPSU2(PSORXIEN,,COMM,"E")
H 1 W "OK"
;
; PSORXED is necessary to perform a REFRESH only
I $G(REFRESH) N PSORXED S PSORXED=1 D ACT^PSOORNE2 S VALMBCK="R"
;
Q
;
UNLK ; Unlocks the Patient/Rx
S X=PSODFN_";DPT(" D ULK^ORX2
D UL^PSSLOCK(PSODFN)
Q
;
CHECK(PSORXIEN) ; Checks if Rx is eligible to be Marked as Titration/Maintenance
N MSG
S MSG=""
; - Rx already marked as Maintenance
I $$TITRX^PSOUTL(PSORXIEN)="m" D Q ("0^"_MSG)
. S MSG="Prescription already marked as 'Maintenance Rx'."
;
; - No THEN conjunction for the last dose
I '$$LTHEN^PSOUTL(PSORXIEN) D Q ("0^"_MSG)
. S MSG="A TITRATION Rx must have a THEN conjunction."
;
;
; - Rx is not ACTIVE or SUSPENDED
I $$GET1^DIQ(52,PSORXIEN,100,"I")'=0,$$GET1^DIQ(52,PSORXIEN,100,"I")'=5 D Q ("0^"_MSG)
. S MSG="Prescription must be ACTIVE or SUSPENDED."
;
Q 1
;
TITHLP ; Help Text for Mark Rx as Titration/Maintenance prompt
W !?5,"Answer YES if this is a Titration to Maintenance prescription."
W !?5,"Actions such as Renewal (including from CPRS), Refill, and Copy"
W !?5,"are not allowed on prescriptions marked as Titration."
W !?5,"However, you will be able to create a Maintenance Rx from this"
W !?5,"Rx upon refill request (unless it is a controlled substance Rx)"
W !?5,"via the TR (Convert Titration Rx) hidden action. You will not"
W !?5,"be able to convert a controlled substance Rx to a maintenance"
W !?5,"prescription by using the TR Hidden Action."
Q
NDF(PSORXIEN) ;PATCH PSO*7*505 - 1:YES 0:NO checks the cs federal schedule field of the va product file
N DRGIEN
S DRGIEN=$$GET1^DIQ(52,PSORXIEN,6,"I") I 'DRGIEN Q 0
Q $$CSDS^PSOSIGDS(DRGIEN)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOOTMRX 5590 printed Apr 09, 2024@21:33:26 Page 2
PSOOTMRX ;BIR/MFR - Titration/Maintenance Dose Prescription ;Oct 20, 2022@15:33
+1 ;;7.0;OUTPATIENT PHARMACY;**313,505,517,441,545**;DEC 1997;Build 270
+2 ;External reference to ULK^ORX2 supported by DBIA 867
+3 ;External reference to UL^PSSLOCK supported by DBIA 2789
+4 ;
TIMTRX ; Titration/Maintenance Dose Rx Hidden Action Entry Point
+1 NEW PSOMTFLG,PSOTITRX,PSORXIEN,LASTDOSE,BEFLST,DOSEINFO,DEA,LAB
+2 SET PSORXIEN=$PIECE(PSOLST(ORN),"^",2)
+3 ;
+4 ; - Rx already marked Maintenance
+5 IF $$TITRX^PSOUTL(PSORXIEN)="m"
Begin DoDot:1
+6 SET VALMSG="Prescription already marked as 'Maintenance Rx'."
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+7 ;
+8 ; - Rx already split into Maintenance Rx
+9 IF $PIECE($GET(^PSRX(PSORXIEN,"TIT")),"^",2)
Begin DoDot:1
+10 SET VALMSG="A Maintenance Rx already exists for this Rx ("_$$GET1^DIQ(52,$PIECE($GET(^PSRX(PSORXIEN,"TIT")),"^",2),.01)_")"
+11 SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+12 ;
+13 ; - Rx was Digitally Signed
+14 IF $$GET1^DIQ(52,PSORXIEN,310,"I")
Begin DoDot:1
+15 SET VALMSG="Rx was digitally signed and cannot be converted."
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+16 ;
+17 ; - No THEN conjunction for the last dose
+18 IF '$$LTHEN^PSOUTL(PSORXIEN)
Begin DoDot:1
+19 SET VALMSG="A Titration Rx must have a THEN conjunction."
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+20 ;
+21 ; - Rx is not ACTIVE
+22 IF $$GET1^DIQ(52,PSORXIEN,100,"I")'=0
Begin DoDot:1
+23 SET VALMSG="Prescription is not ACTIVE."
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+24 ;
+25 ; - Rx NOT released
+26 IF '$$RXRLDT^PSOBPSUT(PSORXIEN,0)
Begin DoDot:1
+27 SET VALMSG="Prescription must be RELEASED first."
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+28 ;
+29 ; - Rx already has refills
+30 IF $ORDER(^PSRX(PSORXIEN,1,0))
Begin DoDot:1
+31 SET VALMSG="Prescription has previously been refilled."
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+32 ;
+33 ; - Rx already has refills
+34 IF '$$GET1^DIQ(52,PSORXIEN,9)
Begin DoDot:1
+35 SET VALMSG="There are no refills available for this Rx."
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+36 ;
+37 ; - Rx not been marked as Titration
+38 IF '$PIECE($GET(^PSRX(PSORXIEN,"TIT")),"^",3)
Begin DoDot:1
+39 SET VALMSG="Rx has not been marked as Titration"
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+40 ;
+41 ;/BLB/ PSO*7*517 - Enhanced functionality to prevent conversion of CS rx's to maintenance
+42 IF $$NDF(PSORXIEN)!($$CSRX^PSOSPMUT(PSORXIEN))
Begin DoDot:1
+43 SET VALMSG="Rx is a controlled substance and cannot be converted."
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+44 ;
+45 SET PSOMTFLG=1
SET PSOTITRX=PSORXIEN
+46 DO COPY^PSOORCPY
KILL PSOMTFLG,PSOTITRX
+47 ;
+48 QUIT
+49 ;
MARKTIT ; Mark Rx as 'Titration' Hidden Action Entry Point
+1 NEW PSORXIEN,CHECK
+2 SET PSORXIEN=$PIECE(PSOLST(ORN),"^",2)
+3 SET CHECK=$$CHECK(PSORXIEN)
+4 IF 'CHECK
Begin DoDot:1
+5 SET VALMBCK="R"
SET VALMSG=$PIECE(CHECK,"^",2)
WRITE $CHAR(7)
End DoDot:1
QUIT
+6 ;
+7 ;I $G(PSORXIEN) D MARK(PSORXIEN,1)
+8 IF $GET(PSORXIEN)
Begin DoDot:1
+9 NEW PSOTITO,PSOTITN
+10 SET PSOTITO=$PIECE($GET(^PSRX(PSORXIEN,"TIT")),"^",3)
+11 DO MARK(PSORXIEN,1)
+12 ;P441
SET PSOTITN=$PIECE($GET(^PSRX(PSORXIEN,"TIT")),"^",3)
IF PSOTITO=PSOTITN
QUIT
+13 DO EN^PSOHLSN1(PSORXIEN,"XX","","Order edited")
End DoDot:1
+14 QUIT
+15 ;
END ;
+1 QUIT
+2 ;
MARK(PSORXIEN,REFRESH) ; Mark a non-refillable Rx as Titration
+1 NEW CHECK,DIR,PTLOCK,X,Y,DFN,COMM
+2 ;
+3 IF '$$CHECK(PSORXIEN)
QUIT
+4 ;
+5 DO FULL^VALM1
+6 WRITE !
+7 ;*545 - displaying notification
+8 IF $$NDF(PSORXIEN)!($$CSRX^PSOSPMUT(PSORXIEN))
Begin DoDot:1
+9 if ($$TITRX^PSOUTL(PSORXIEN)="t")
QUIT
+10 WRITE !,"NOTE: Marking this controlled substance Rx as a Titration prescription will"
+11 WRITE !,"prevent refills and renewals. You will not be able to convert the Rx to a "
+12 WRITE !,"maintenance prescription by the TR Hidden Action."
End DoDot:1
+13 SET DIR("A")="Do you want to "_$SELECT($$TITRX^PSOUTL(PSORXIEN)="t":"UN",1:"")_"MARK this Rx as 'Titration'? "
+14 IF $$TITRX^PSOUTL(PSORXIEN)'="t"
SET (DIR("?"),DIR("??"))="^D TITHLP^PSOOTMRX"
+15 ;P441 default set for CPRS orders only
IF $GET(PSOTITRF)
SET DIR("B")="No"
+16 SET DIR(0)="YA"
DO ^DIR
IF Y'>0
DO UNLK
SET VALMBCK="R"
QUIT
+17 ;
+18 WRITE !!,"Updating..."
+19 IF '$PIECE($GET(^PSRX(PSORXIEN,"TIT")),"^",3)
Begin DoDot:1
+20 SET $PIECE(^PSRX(PSORXIEN,"TIT"),"^",3)=1
SET COMM="MARKED as Titration"
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 SET $PIECE(^PSRX(PSORXIEN,"TIT"),"^",3)=""
SET COMM="UNMARKED as Titration"
+23 IF ($DATA(^PSRX(PSORXIEN,"TIT"))=1)
IF $TRANSLATE($GET(^PSRX(PSORXIEN,"TIT")),"^","")=""
Begin DoDot:2
+24 ; Cleaning up the "TIT" subscript
KILL ^PSRX(PSORXIEN,"TIT")
End DoDot:2
End DoDot:1
+25 DO RXACT^PSOBPSU2(PSORXIEN,,COMM,"E")
+26 HANG 1
WRITE "OK"
+27 ;
+28 ; PSORXED is necessary to perform a REFRESH only
+29 IF $GET(REFRESH)
NEW PSORXED
SET PSORXED=1
DO ACT^PSOORNE2
SET VALMBCK="R"
+30 ;
+31 QUIT
+32 ;
UNLK ; Unlocks the Patient/Rx
+1 SET X=PSODFN_";DPT("
DO ULK^ORX2
+2 DO UL^PSSLOCK(PSODFN)
+3 QUIT
+4 ;
CHECK(PSORXIEN) ; Checks if Rx is eligible to be Marked as Titration/Maintenance
+1 NEW MSG
+2 SET MSG=""
+3 ; - Rx already marked as Maintenance
+4 IF $$TITRX^PSOUTL(PSORXIEN)="m"
Begin DoDot:1
+5 SET MSG="Prescription already marked as 'Maintenance Rx'."
End DoDot:1
QUIT ("0^"_MSG)
+6 ;
+7 ; - No THEN conjunction for the last dose
+8 IF '$$LTHEN^PSOUTL(PSORXIEN)
Begin DoDot:1
+9 SET MSG="A TITRATION Rx must have a THEN conjunction."
End DoDot:1
QUIT ("0^"_MSG)
+10 ;
+11 ;
+12 ; - Rx is not ACTIVE or SUSPENDED
+13 IF $$GET1^DIQ(52,PSORXIEN,100,"I")'=0
IF $$GET1^DIQ(52,PSORXIEN,100,"I")'=5
Begin DoDot:1
+14 SET MSG="Prescription must be ACTIVE or SUSPENDED."
End DoDot:1
QUIT ("0^"_MSG)
+15 ;
+16 QUIT 1
+17 ;
TITHLP ; Help Text for Mark Rx as Titration/Maintenance prompt
+1 WRITE !?5,"Answer YES if this is a Titration to Maintenance prescription."
+2 WRITE !?5,"Actions such as Renewal (including from CPRS), Refill, and Copy"
+3 WRITE !?5,"are not allowed on prescriptions marked as Titration."
+4 WRITE !?5,"However, you will be able to create a Maintenance Rx from this"
+5 WRITE !?5,"Rx upon refill request (unless it is a controlled substance Rx)"
+6 WRITE !?5,"via the TR (Convert Titration Rx) hidden action. You will not"
+7 WRITE !?5,"be able to convert a controlled substance Rx to a maintenance"
+8 WRITE !?5,"prescription by using the TR Hidden Action."
+9 QUIT
NDF(PSORXIEN) ;PATCH PSO*7*505 - 1:YES 0:NO checks the cs federal schedule field of the va product file
+1 NEW DRGIEN
+2 SET DRGIEN=$$GET1^DIQ(52,PSORXIEN,6,"I")
IF 'DRGIEN
QUIT 0
+3 QUIT $$CSDS^PSOSIGDS(DRGIEN)
