- 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 Feb 18, 2025@23:58:54 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)