PSODRGU0 ;BIR/MFR - Drug Swaping Utility; 06/25/2023 5:14pm
;;7.0;OUTPATIENT PHARMACY;**770**;DEC 1997;Build 145
;
SWAPDRUG(RXIEN,NEWDRUG) ; Swap the Dispense Drug in an Existing Prescription
; Input: RXIEN - Rx that will have the New Dispense Drug - Pointer to PRESCRIPTION file (#52)
; NEWDRUG - New Dispense Drug - Pointer to DRUG file (#50)
N OLDDRUG,PATIENT,LOCK,ERXIEN,DR,DIE,DA,NEWVAL,RELERX,OLDCMPID,NEWCMPID,REMARKS,OLDRMRKS
;
I '$D(^PSRX(+$G(RXIEN),0)) Q "0^Prescription not found"
I '$D(^PSDRUG(+$G(NEWDRUG),0)) Q "0^Invalid dispense drug"
;
S OLDDRUG=+$$GET1^DIQ(52,RXIEN,6,"I"),PATIENT=+$$GET1^DIQ(52,RXIEN,2,"I"),OLDRMRKS=$$GET1^DIQ(52,RXIEN,12)
S OLDCMPID=$$GET1^DIQ(50,OLDDRUG,27),NEWCMPID=$$GET1^DIQ(50,NEWDRUG,27)
I OLDDRUG=NEWDRUG Q "0^New dispense drug already in the prescription"
I $$CSDRG^PSOERUT6(OLDDRUG) Q "0^Cannot swap dispense drug for CS prescriptions"
I $$CSDRG^PSOERUT6(OLDDRUG) Q "0^Cannot swap to a CS dispense drug"
I '$$ACTIVE^PSOERXA0(NEWDRUG) Q "0^New dispense drug is inactive"
I '$$OUTPAT^PSOERXA0(NEWDRUG) Q "0^New dispense drug is not marked for outpatient use"
; TO-DO: Review this
I $$GET1^DIQ(50,NEWDRUG,2)'=$$GET1^DIQ(50,OLDDRUG,2) Q "0^New dispense drug is from a different drug class"
;
S LOCK=$$L^PSSLOCK(PATIENT,0) I '$G(LOCK) Q "0^"_$P(LOCK,"^",2)_" is editing orders for the patient on this prescription."
;
; Updating Rx with New Dispense Drug
S REMARKS="CNV "_OLDCMPID_"->"_NEWCMPID_" "_$$FMTE^XLFDT(DT,"2Y")_$S(OLDRMRKS'="":","_OLDRMRKS,1:"")
S REMARKS=$E(REMARKS,1,75) S DIE="^PSRX(",DA=RXIEN,DR="6////"_NEWDRUG_";12////"_REMARKS_";27////"_$$GETNDC^PSSNDCUT(NEWDRUG) D ^DIE
;
; Adding Entry in the Activity Log about the Swap
D RXACT^PSOBPSU2(RXIEN,0,"Dispense Drug changed from "_$$GET1^DIQ(50,OLDDRUG,.01)_" ("_OLDCMPID_") to "_$$GET1^DIQ(50,NEWDRUG,.01)_" ("_NEWCMPID_")","E",DUZ)
;
; Updating the Dispense Drug in corresponding eRx's
S ERXIEN=$$ERXIEN^PSOERXUT(RXIEN)
I ERXIEN D
. I $$GET1^DIQ(52.49,ERXIEN,3.2,"I")=OLDDRUG D
. . K NEWVAL S NEWVAL(1)=$$GET1^DIQ(50,NEWDRUG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(NEWDRUG)_")"_" - VISTA DRUG EDITED"
. . D AUDLOG^PSOERXUT(ERXIEN,"DRUG",DUZ,.NEWVAL)
. . K DIE S DIE="^PS(52.49,",DA=ERXIEN,DR="3.2////"_NEWDRUG D ^DIE
. ; Updating Related eRx's (if any)
. S RELERX=0 F S RELERX=$O(^PS(52.49,ERXIEN,201,"B",RELERX)) Q:'RELERX D
. . I $$GET1^DIQ(52.49,RELERX,3.2,"I")=OLDDRUG D
. . . K NEWVAL S NEWVAL(1)=$$GET1^DIQ(50,NEWDRUG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(NEWDRUG)_")"_" - VISTA DRUG EDITED"
. . . D AUDLOG^PSOERXUT(RELERX,"DRUG",DUZ,.NEWVAL)
. . . K DIE S DIE="^PS(52,49",DA=RELERX,DR="3.2////"_NEWDRUG D ^DIE
;
; Updating CPRS
D EN^PSOHLSN1(RXIEN,"XX","","Order edited")
;
; Unlocking Patient
D UL^PSSLOCK(PATIENT)
;
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODRGU0 2838 printed Aug 26, 2025@22:43:23 Page 2
PSODRGU0 ;BIR/MFR - Drug Swaping Utility; 06/25/2023 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**770**;DEC 1997;Build 145
+2 ;
SWAPDRUG(RXIEN,NEWDRUG) ; Swap the Dispense Drug in an Existing Prescription
+1 ; Input: RXIEN - Rx that will have the New Dispense Drug - Pointer to PRESCRIPTION file (#52)
+2 ; NEWDRUG - New Dispense Drug - Pointer to DRUG file (#50)
+3 NEW OLDDRUG,PATIENT,LOCK,ERXIEN,DR,DIE,DA,NEWVAL,RELERX,OLDCMPID,NEWCMPID,REMARKS,OLDRMRKS
+4 ;
+5 IF '$DATA(^PSRX(+$GET(RXIEN),0))
QUIT "0^Prescription not found"
+6 IF '$DATA(^PSDRUG(+$GET(NEWDRUG),0))
QUIT "0^Invalid dispense drug"
+7 ;
+8 SET OLDDRUG=+$$GET1^DIQ(52,RXIEN,6,"I")
SET PATIENT=+$$GET1^DIQ(52,RXIEN,2,"I")
SET OLDRMRKS=$$GET1^DIQ(52,RXIEN,12)
+9 SET OLDCMPID=$$GET1^DIQ(50,OLDDRUG,27)
SET NEWCMPID=$$GET1^DIQ(50,NEWDRUG,27)
+10 IF OLDDRUG=NEWDRUG
QUIT "0^New dispense drug already in the prescription"
+11 IF $$CSDRG^PSOERUT6(OLDDRUG)
QUIT "0^Cannot swap dispense drug for CS prescriptions"
+12 IF $$CSDRG^PSOERUT6(OLDDRUG)
QUIT "0^Cannot swap to a CS dispense drug"
+13 IF '$$ACTIVE^PSOERXA0(NEWDRUG)
QUIT "0^New dispense drug is inactive"
+14 IF '$$OUTPAT^PSOERXA0(NEWDRUG)
QUIT "0^New dispense drug is not marked for outpatient use"
+15 ; TO-DO: Review this
+16 IF $$GET1^DIQ(50,NEWDRUG,2)'=$$GET1^DIQ(50,OLDDRUG,2)
QUIT "0^New dispense drug is from a different drug class"
+17 ;
+18 SET LOCK=$$L^PSSLOCK(PATIENT,0)
IF '$GET(LOCK)
QUIT "0^"_$PIECE(LOCK,"^",2)_" is editing orders for the patient on this prescription."
+19 ;
+20 ; Updating Rx with New Dispense Drug
+21 SET REMARKS="CNV "_OLDCMPID_"->"_NEWCMPID_" "_$$FMTE^XLFDT(DT,"2Y")_$SELECT(OLDRMRKS'="":","_OLDRMRKS,1:"")
+22 SET REMARKS=$EXTRACT(REMARKS,1,75)
SET DIE="^PSRX("
SET DA=RXIEN
SET DR="6////"_NEWDRUG_";12////"_REMARKS_";27////"_$$GETNDC^PSSNDCUT(NEWDRUG)
DO ^DIE
+23 ;
+24 ; Adding Entry in the Activity Log about the Swap
+25 DO RXACT^PSOBPSU2(RXIEN,0,"Dispense Drug changed from "_$$GET1^DIQ(50,OLDDRUG,.01)_" ("_OLDCMPID_") to "_$$GET1^DIQ(50,NEWDRUG,.01)_" ("_NEWCMPID_")","E",DUZ)
+26 ;
+27 ; Updating the Dispense Drug in corresponding eRx's
+28 SET ERXIEN=$$ERXIEN^PSOERXUT(RXIEN)
+29 IF ERXIEN
Begin DoDot:1
+30 IF $$GET1^DIQ(52.49,ERXIEN,3.2,"I")=OLDDRUG
Begin DoDot:2
+31 KILL NEWVAL
SET NEWVAL(1)=$$GET1^DIQ(50,NEWDRUG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(NEWDRUG)_")"_" - VISTA DRUG EDITED"
+32 DO AUDLOG^PSOERXUT(ERXIEN,"DRUG",DUZ,.NEWVAL)
+33 KILL DIE
SET DIE="^PS(52.49,"
SET DA=ERXIEN
SET DR="3.2////"_NEWDRUG
DO ^DIE
End DoDot:2
+34 ; Updating Related eRx's (if any)
+35 SET RELERX=0
FOR
SET RELERX=$ORDER(^PS(52.49,ERXIEN,201,"B",RELERX))
if 'RELERX
QUIT
Begin DoDot:2
+36 IF $$GET1^DIQ(52.49,RELERX,3.2,"I")=OLDDRUG
Begin DoDot:3
+37 KILL NEWVAL
SET NEWVAL(1)=$$GET1^DIQ(50,NEWDRUG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(NEWDRUG)_")"_" - VISTA DRUG EDITED"
+38 DO AUDLOG^PSOERXUT(RELERX,"DRUG",DUZ,.NEWVAL)
+39 KILL DIE
SET DIE="^PS(52,49"
SET DA=RELERX
SET DR="3.2////"_NEWDRUG
DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+40 ;
+41 ; Updating CPRS
+42 DO EN^PSOHLSN1(RXIEN,"XX","","Order edited")
+43 ;
+44 ; Unlocking Patient
+45 DO UL^PSSLOCK(PATIENT)
+46 ;
+47 QUIT 1
