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

PSOOTMRX.m

Go to the documentation of this file.
  1. 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
  1. ;External reference to ULK^ORX2 supported by DBIA 867
  1. ;External reference to UL^PSSLOCK supported by DBIA 2789
  1. ;
  1. TIMTRX ; Titration/Maintenance Dose Rx Hidden Action Entry Point
  1. N PSOMTFLG,PSOTITRX,PSORXIEN,LASTDOSE,BEFLST,DOSEINFO,DEA,LAB
  1. S PSORXIEN=$P(PSOLST(ORN),"^",2)
  1. ;
  1. ; - Rx already marked Maintenance
  1. I $$TITRX^PSOUTL(PSORXIEN)="m" D Q
  1. . S VALMSG="Prescription already marked as 'Maintenance Rx'.",VALMBCK="R" W $C(7)
  1. ;
  1. ; - Rx already split into Maintenance Rx
  1. I $P($G(^PSRX(PSORXIEN,"TIT")),"^",2) D Q
  1. . S VALMSG="A Maintenance Rx already exists for this Rx ("_$$GET1^DIQ(52,$P($G(^PSRX(PSORXIEN,"TIT")),"^",2),.01)_")"
  1. . S VALMBCK="R" W $C(7)
  1. ;
  1. ; - Rx was Digitally Signed
  1. I $$GET1^DIQ(52,PSORXIEN,310,"I") D Q
  1. . S VALMSG="Rx was digitally signed and cannot be converted.",VALMBCK="R" W $C(7)
  1. ;
  1. ; - No THEN conjunction for the last dose
  1. I '$$LTHEN^PSOUTL(PSORXIEN) D Q
  1. . S VALMSG="A Titration Rx must have a THEN conjunction.",VALMBCK="R" W $C(7)
  1. ;
  1. ; - Rx is not ACTIVE
  1. I $$GET1^DIQ(52,PSORXIEN,100,"I")'=0 D Q
  1. . S VALMSG="Prescription is not ACTIVE.",VALMBCK="R" W $C(7)
  1. ;
  1. ; - Rx NOT released
  1. I '$$RXRLDT^PSOBPSUT(PSORXIEN,0) D Q
  1. . S VALMSG="Prescription must be RELEASED first.",VALMBCK="R" W $C(7)
  1. ;
  1. ; - Rx already has refills
  1. I $O(^PSRX(PSORXIEN,1,0)) D Q
  1. . S VALMSG="Prescription has previously been refilled.",VALMBCK="R" W $C(7)
  1. ;
  1. ; - Rx already has refills
  1. I '$$GET1^DIQ(52,PSORXIEN,9) D Q
  1. . S VALMSG="There are no refills available for this Rx.",VALMBCK="R" W $C(7)
  1. ;
  1. ; - Rx not been marked as Titration
  1. I '$P($G(^PSRX(PSORXIEN,"TIT")),"^",3) D Q
  1. . S VALMSG="Rx has not been marked as Titration",VALMBCK="R" W $C(7)
  1. ;
  1. ;/BLB/ PSO*7*517 - Enhanced functionality to prevent conversion of CS rx's to maintenance
  1. I $$NDF(PSORXIEN)!($$CSRX^PSOSPMUT(PSORXIEN)) D Q
  1. .S VALMSG="Rx is a controlled substance and cannot be converted.",VALMBCK="R" W $C(7)
  1. ;
  1. S PSOMTFLG=1,PSOTITRX=PSORXIEN
  1. D COPY^PSOORCPY K PSOMTFLG,PSOTITRX
  1. ;
  1. Q
  1. ;
  1. MARKTIT ; Mark Rx as 'Titration' Hidden Action Entry Point
  1. N PSORXIEN,CHECK
  1. S PSORXIEN=$P(PSOLST(ORN),"^",2)
  1. S CHECK=$$CHECK(PSORXIEN)
  1. I 'CHECK D Q
  1. . S VALMBCK="R",VALMSG=$P(CHECK,"^",2) W $C(7)
  1. ;
  1. ;I $G(PSORXIEN) D MARK(PSORXIEN,1)
  1. I $G(PSORXIEN) D
  1. .N PSOTITO,PSOTITN
  1. .S PSOTITO=$P($G(^PSRX(PSORXIEN,"TIT")),"^",3)
  1. .D MARK(PSORXIEN,1)
  1. .S PSOTITN=$P($G(^PSRX(PSORXIEN,"TIT")),"^",3) I PSOTITO=PSOTITN Q ;P441
  1. .D EN^PSOHLSN1(PSORXIEN,"XX","","Order edited")
  1. Q
  1. ;
  1. END ;
  1. Q
  1. ;
  1. MARK(PSORXIEN,REFRESH) ; Mark a non-refillable Rx as Titration
  1. N CHECK,DIR,PTLOCK,X,Y,DFN,COMM
  1. ;
  1. I '$$CHECK(PSORXIEN) Q
  1. ;
  1. D FULL^VALM1
  1. W !
  1. ;*545 - displaying notification
  1. I $$NDF(PSORXIEN)!($$CSRX^PSOSPMUT(PSORXIEN)) D
  1. .Q:($$TITRX^PSOUTL(PSORXIEN)="t")
  1. .W !,"NOTE: Marking this controlled substance Rx as a Titration prescription will"
  1. .W !,"prevent refills and renewals. You will not be able to convert the Rx to a "
  1. .W !,"maintenance prescription by the TR Hidden Action."
  1. S DIR("A")="Do you want to "_$S($$TITRX^PSOUTL(PSORXIEN)="t":"UN",1:"")_"MARK this Rx as 'Titration'? "
  1. I $$TITRX^PSOUTL(PSORXIEN)'="t" S (DIR("?"),DIR("??"))="^D TITHLP^PSOOTMRX"
  1. I $G(PSOTITRF) S DIR("B")="No" ;P441 default set for CPRS orders only
  1. S DIR(0)="YA" D ^DIR I Y'>0 D UNLK S VALMBCK="R" Q
  1. ;
  1. W !!,"Updating..."
  1. I '$P($G(^PSRX(PSORXIEN,"TIT")),"^",3) D
  1. . S $P(^PSRX(PSORXIEN,"TIT"),"^",3)=1,COMM="MARKED as Titration"
  1. E D
  1. . S $P(^PSRX(PSORXIEN,"TIT"),"^",3)="",COMM="UNMARKED as Titration"
  1. . I ($D(^PSRX(PSORXIEN,"TIT"))=1),$TR($G(^PSRX(PSORXIEN,"TIT")),"^","")="" D
  1. . . K ^PSRX(PSORXIEN,"TIT") ; Cleaning up the "TIT" subscript
  1. D RXACT^PSOBPSU2(PSORXIEN,,COMM,"E")
  1. H 1 W "OK"
  1. ;
  1. ; PSORXED is necessary to perform a REFRESH only
  1. I $G(REFRESH) N PSORXED S PSORXED=1 D ACT^PSOORNE2 S VALMBCK="R"
  1. ;
  1. Q
  1. ;
  1. UNLK ; Unlocks the Patient/Rx
  1. S X=PSODFN_";DPT(" D ULK^ORX2
  1. D UL^PSSLOCK(PSODFN)
  1. Q
  1. ;
  1. CHECK(PSORXIEN) ; Checks if Rx is eligible to be Marked as Titration/Maintenance
  1. N MSG
  1. S MSG=""
  1. ; - Rx already marked as Maintenance
  1. I $$TITRX^PSOUTL(PSORXIEN)="m" D Q ("0^"_MSG)
  1. . S MSG="Prescription already marked as 'Maintenance Rx'."
  1. ;
  1. ; - No THEN conjunction for the last dose
  1. I '$$LTHEN^PSOUTL(PSORXIEN) D Q ("0^"_MSG)
  1. . S MSG="A TITRATION Rx must have a THEN conjunction."
  1. ;
  1. ;
  1. ; - Rx is not ACTIVE or SUSPENDED
  1. I $$GET1^DIQ(52,PSORXIEN,100,"I")'=0,$$GET1^DIQ(52,PSORXIEN,100,"I")'=5 D Q ("0^"_MSG)
  1. . S MSG="Prescription must be ACTIVE or SUSPENDED."
  1. ;
  1. Q 1
  1. ;
  1. TITHLP ; Help Text for Mark Rx as Titration/Maintenance prompt
  1. W !?5,"Answer YES if this is a Titration to Maintenance prescription."
  1. W !?5,"Actions such as Renewal (including from CPRS), Refill, and Copy"
  1. W !?5,"are not allowed on prescriptions marked as Titration."
  1. W !?5,"However, you will be able to create a Maintenance Rx from this"
  1. W !?5,"Rx upon refill request (unless it is a controlled substance Rx)"
  1. W !?5,"via the TR (Convert Titration Rx) hidden action. You will not"
  1. W !?5,"be able to convert a controlled substance Rx to a maintenance"
  1. W !?5,"prescription by using the TR Hidden Action."
  1. Q
  1. NDF(PSORXIEN) ;PATCH PSO*7*505 - 1:YES 0:NO checks the cs federal schedule field of the va product file
  1. N DRGIEN
  1. S DRGIEN=$$GET1^DIQ(52,PSORXIEN,6,"I") I 'DRGIEN Q 0
  1. Q $$CSDS^PSOSIGDS(DRGIEN)