PSOLLL8 ;BIR/JLC - LASER LABEL - CRITICAL INTERACTION ;12/13/02
;;7.0;OUTPATIENT PHARMACY;**120,251,387,367,372,616**;DEC 1997;Build 3
;Reference to PS(56 supported by DBIA 2229
;Reference to PSDRUG supported by DBIA 221
;External reference to $$DS^PSSDSAPI supported by DBIA 5424
;
S HOLDCOPY=COPIES
START ;
;
I $G(PSOIO("CDII"))]"" X PSOIO("CDII")
I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
K PSOSERV N PSODOSEW,PSODRGI,PSRXSET S (PSODOSEW,PSODRGI)=0
S COPIES=COPIES-1,Y=$P(^PSRX(RX,2),"^",6) X ^DD("DD") S EXPDT=Y,Y=$P(^PSRX(RX,0),"^",13) X ^DD("DD") S ISD=Y
S Y=DATE X ^DD("DD") S DATE1=Y D NOW^%DTC S Y=% X ^DD("DD") S NOW=Y
I '$D(^PS(52.4,RX,0)),$P(^PSRX(RX,"STA"),"^")=4 D UNKNOWN Q
I '$G(RXRP(RX)) S T=$P(PS2,"^",2)_" "_"("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_")"_" "_$P(NOW,":",1,2) D PRINT(T)
2 ;
I $D(^PSRX(RX,"DRI")) D M1 S SCRIPT=$P(^PSRX(RX,"DRI"),"^",2),SEV=$P(^PSRX(RX,"DRI"),"^") F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D
.S:SEV(X)=1 PSOSERV=1
.S T=$P($G(^PSRX(RXX(X),0)),"^")_" "_$S(SEV(X)=1:"CRITICAL",SEV(X)=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") S:SEV(X)=1 PSODRGI=1 D PRINT(T)
I '$D(^PSRX(RX,"DRI")),$D(^PS(52.4,RX,0)) S SCRIPT=$P(^PS(52.4,RX,0),"^",10),SEV=$P(^PS(52.4,RX,0),"^",9) D M2:SCRIPT="" I SCRIPT'="" D M1 F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D
.S:SEV(X)=1 PSOSERV=1
.S T=$P($G(^PSRX(RXX(X),0)),"^")_" "_$S(SEV(X)=1:"CRITICAL",SEV(X)=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") S:SEV(X)=1 PSODRGI=1 D PRINT(T)
I $$DS^PSSDSAPI,($D(^PS(52.4,RX,1))) S T="",T=$P(^PS(52.4,RX,1),"^") D D:T'="" PRINT(T)
. S T=$$RCONVMS^PSODOSUT(T),PSODOSEW=1
S T="This prescription was entered by: "_TECH_"." D PRINT(T)
S T="This prescription "_$S('$G(PSOSERV):"may require",1:"requires")_" "_$S('$G(PSOSERV):"reviewing",1:"intervention")_" by a pharmacist." D PRINT(T)
S T=DATE1_" Fill "_(RXF+1)_" of "_(1+$P(RXY,"^",9)) D PRINT(T)
S T=PNM_" "_SSNP D PRINT(T)
F SSG=1:1 Q:$G(SGY(SSG))="" S T=SGY(SSG) D PRINT(T)
S T="Qty: "_$G(QTY)_" "_$G(PHYS) D PRINT(T)
S T="Tech__________RPh__________" D PRINT(T)
S T=DRUG D PRINT(T)
S T="Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL") D PRINT(T)
S T="Days supply: "_$G(DAYS)_" Cap: "_$S(PSCAP:"**NON-SFTY**",1:"SAFETY") D PRINT(T)
S T="Isd: "_ISD_" Exp: "_EXPDT D PRINT(T)
S T="Last Fill: "_$G(PSOFLAST) D PRINT(T)
S T="Pat. Stat "_PATST_" Clinic: "_PSCLN D PRINT(T)
W @IOF
I COPIES>0 G START
S COPIES=HOLDCOPY K HOLDCOPY
STORE ;LABEL PRINT NODE
D NOW^%DTC S NOW=% K %,%H,%I I $G(RXF)="" S RXF=0 F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I S RXF=I
F IR=0 F FDA=0:0 S FDA=$O(^PSRX(RX,"L",FDA)) Q:'FDA S IR=FDA
;S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR,^PSRX(RX,"L",IR,0)=NOW_"^"_RXF_"^"_$S($G(PCOMX)]"":$G(PCOMX),1:"From RX number "_$P(^PSRX(RX,0),"^"))_" Drug-Drug interaction"_$S($G(RXRP(RX)):" (Reprint)",1:"")_"^"_PDUZ_"^1"
S IR=IR+1,PSRXSET="^52.032DA^"_IR_"^"_IR
S ^PSRX(RX,"L",0)=PSRXSET ; PSO*7*616 Fix missing Header node
S PSRXSET=NOW_"^"_RXF_"^"_$S($G(PCOMX)]"":$G(PCOMX),1:"From RX number "_$P(^PSRX(RX,0),"^"))
S PSRXSET=PSRXSET_$S(PSODRGI&(PSODOSEW)&$$DS^PSSDSAPI:" Drug-Drug interaction/dose warning",PSODRGI:" Drug-Drug interaction",PSODOSEW&$$DS^PSSDSAPI:" Dose Warning",1:"")_$S($G(RXRP(RX)):" (Reprint)",1:"")_"^"_PDUZ_"^1"
S ^PSRX(RX,"L",IR,0)=PSRXSET
;
;Storing FDA Medication Guide filename in the Prescription file
I $$MGONFILE^PSOFDAUT(RX) D
. I $G(RXRP(RX)),'$G(RXRP(RX,"MG")) Q
. S ^PSRX(RX,"L",IR,"FDA")=$P($$MGONFILE^PSOFDAUT(RX),"^",2)
;
K:$D(^PS(52.4,RX,0)) RXF,IR,FDA,NOW,I
END K:$D(^PS(52.4,RX,0)) PSCLN,DATE1,DRUG,RFLMSG,COPIES,DRUG,LMI,LINE,PS,PS1,PS2,INT,ISD,I1,MW,STATE,SIDE,SGY,PATST,PRTFL,PHYS,SGC,VRPH,NLWS,X1,X2,X,Y,TECH,EXPDT,NURSE,SEV,SCRIPT,RXX,SGY,SER,SSG,RXY,SIGPH,PS55,PS55X K PSOSERV
Q
UNKNOWN S PSOY=PSOY+(3*PSOYI),T="",$P(T,"*",100)="" D PRINT(T)
S T="THIS PRESCRIPTION HAS CAUSED A DRUG-DRUG INTERACTION " D PRINT(T)
S T="",$P(T,"*",100)="" D PRINT(T)
S T="PRESCRIPTION # "_$P(^PSRX(RX,0),"^")_" "_$P(^PSDRUG($P(^PSRX(RX,0),"^",6),0),"^") D PRINT(T)
S T="The above prescription has a status of PENDING due to a DRUG-DRUG INTERACTION." D PRINT(T)
S T=PNM_" "_SSNP D PRINT(T)
S T=$P(PS2,"^",2)_" ("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_")"_" "_$P($P(NOW,":",1,2),"@") D PRINT(T)
S T=RXN_" "_DATE1_" Fill "_(RXF+1)_" of "_(1+$P(RXY,"^",9)) D PRINT(T)
F SSG=1:1 Q:$G(SGY(SSG))="" S T=SGY(SSG) D PRINT(T)
S PSOY=PSOY+PSOYI,T="Please review printouts of all labels for this patient that follow." D PRINT(T),STORE
W @IOF K PSCLN,DATE1,DRUG,RFLMSG,COPIES,DRUG,LMI,LINE,PS,PS1,PS2,INT,ISD,I1,MW,STATE,SIDE,SIGPH,SGY,PATST,PRTFL,PHYS,SGC,VRPH,NLWS,X1,X2,X,Y,TECH,EXPDT,NURSE,SEV,SCRIPT,RXX,SGY,SER,SSG,RXY,PSOSERV Q
;
PRINT(T) ;
I $G(PSOIO("ST"))]"" X PSOIO("ST")
W T,!
I $G(PSOIO("ET"))]"" X PSOIO("ET")
Q
;
M1 ;
S PSOY=PSOY+PSOYI,T="Rx# "_RXN_" has caused a DRUG-DRUG INTERACTION with the following prescription(s):" D PRINT(T)
Q
M2 ;
S PSOY=PSOY+PSOYI,T="",T="Rx# "_RXN D PRINT(T)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLLL8 5220 printed Sep 23, 2025@20:07:02 Page 2
PSOLLL8 ;BIR/JLC - LASER LABEL - CRITICAL INTERACTION ;12/13/02
+1 ;;7.0;OUTPATIENT PHARMACY;**120,251,387,367,372,616**;DEC 1997;Build 3
+2 ;Reference to PS(56 supported by DBIA 2229
+3 ;Reference to PSDRUG supported by DBIA 221
+4 ;External reference to $$DS^PSSDSAPI supported by DBIA 5424
+5 ;
+6 SET HOLDCOPY=COPIES
START ;
+1 ;
+2 IF $GET(PSOIO("CDII"))]""
XECUTE PSOIO("CDII")
+3 IF $GET(PSOIO(PSOFONT))]""
XECUTE PSOIO(PSOFONT)
+4 KILL PSOSERV
NEW PSODOSEW,PSODRGI,PSRXSET
SET (PSODOSEW,PSODRGI)=0
+5 SET COPIES=COPIES-1
SET Y=$PIECE(^PSRX(RX,2),"^",6)
XECUTE ^DD("DD")
SET EXPDT=Y
SET Y=$PIECE(^PSRX(RX,0),"^",13)
XECUTE ^DD("DD")
SET ISD=Y
+6 SET Y=DATE
XECUTE ^DD("DD")
SET DATE1=Y
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET NOW=Y
+7 IF '$DATA(^PS(52.4,RX,0))
IF $PIECE(^PSRX(RX,"STA"),"^")=4
DO UNKNOWN
QUIT
+8 IF '$GET(RXRP(RX))
SET T=$PIECE(PS2,"^",2)_" "_"("_$PIECE(RXY,"^",16)_"/"_$SELECT(+$GET(VRPH):VRPH,1:" ")_")"_" "_$PIECE(NOW,":",1,2)
DO PRINT(T)
2 ;
+1 IF $DATA(^PSRX(RX,"DRI"))
DO M1
SET SCRIPT=$PIECE(^PSRX(RX,"DRI"),"^",2)
SET SEV=$PIECE(^PSRX(RX,"DRI"),"^")
FOR X=1:1
SET RXX(X)=$PIECE(SCRIPT,",",X)
SET SEV(X)=$PIECE(SEV,",",X)
if RXX(X)=""
QUIT
Begin DoDot:1
+2 if SEV(X)=1
SET PSOSERV=1
+3 SET T=$PIECE($GET(^PSRX(RXX(X),0)),"^")_" "_$SELECT(SEV(X)=1:"CRITICAL",SEV(X)=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$PIECE(^PSDRUG($PIECE(^PSRX(RXX(X),0),"^",6),0),"^")
if SEV(X)=1
SET PSODRGI=1
DO PRINT(T)
End DoDot:1
+4 IF '$DATA(^PSRX(RX,"DRI"))
IF $DATA(^PS(52.4,RX,0))
SET SCRIPT=$PIECE(^PS(52.4,RX,0),"^",10)
SET SEV=$PIECE(^PS(52.4,RX,0),"^",9)
if SCRIPT=""
DO M2
IF SCRIPT'=""
DO M1
FOR X=1:1
SET RXX(X)=$PIECE(SCRIPT,",",X)
SET SEV(X)=$PIECE(SEV,",",X)
if RXX(X)=""
QUIT
Begin DoDot:1
+5 if SEV(X)=1
SET PSOSERV=1
+6 SET T=$PIECE($GET(^PSRX(RXX(X),0)),"^")_" "_$SELECT(SEV(X)=1:"CRITICAL",SEV(X)=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$PIECE(^PSDRUG($PIECE(^PSRX(RXX(X),0),"^",6),0),"^")
if SEV(X)=1
SET PSODRGI=1
DO PRINT(T)
End DoDot:1
+7 IF $$DS^PSSDSAPI
IF ($DATA(^PS(52.4,RX,1)))
SET T=""
SET T=$PIECE(^PS(52.4,RX,1),"^")
Begin DoDot:1
+8 SET T=$$RCONVMS^PSODOSUT(T)
SET PSODOSEW=1
End DoDot:1
if T'=""
DO PRINT(T)
+9 SET T="This prescription was entered by: "_TECH_"."
DO PRINT(T)
+10 SET T="This prescription "_$SELECT('$GET(PSOSERV):"may require",1:"requires")_" "_$SELECT('$GET(PSOSERV):"reviewing",1:"intervention")_" by a pharmacist."
DO PRINT(T)
+11 SET T=DATE1_" Fill "_(RXF+1)_" of "_(1+$PIECE(RXY,"^",9))
DO PRINT(T)
+12 SET T=PNM_" "_SSNP
DO PRINT(T)
+13 FOR SSG=1:1
if $GET(SGY(SSG))=""
QUIT
SET T=SGY(SSG)
DO PRINT(T)
+14 SET T="Qty: "_$GET(QTY)_" "_$GET(PHYS)
DO PRINT(T)
+15 SET T="Tech__________RPh__________"
DO PRINT(T)
+16 SET T=DRUG
DO PRINT(T)
+17 SET T="Routing: "_$SELECT("W"[$EXTRACT(MW):MW,1:MW_" MAIL")
DO PRINT(T)
+18 SET T="Days supply: "_$GET(DAYS)_" Cap: "_$SELECT(PSCAP:"**NON-SFTY**",1:"SAFETY")
DO PRINT(T)
+19 SET T="Isd: "_ISD_" Exp: "_EXPDT
DO PRINT(T)
+20 SET T="Last Fill: "_$GET(PSOFLAST)
DO PRINT(T)
+21 SET T="Pat. Stat "_PATST_" Clinic: "_PSCLN
DO PRINT(T)
+22 WRITE @IOF
+23 IF COPIES>0
GOTO START
+24 SET COPIES=HOLDCOPY
KILL HOLDCOPY
STORE ;LABEL PRINT NODE
+1 DO NOW^%DTC
SET NOW=%
KILL %,%H,%I
IF $GET(RXF)=""
SET RXF=0
FOR I=0:0
SET I=$ORDER(^PSRX(RX,1,I))
if 'I
QUIT
SET RXF=I
+2 FOR IR=0
FOR FDA=0:0
SET FDA=$ORDER(^PSRX(RX,"L",FDA))
if 'FDA
QUIT
SET IR=FDA
+3 ;S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR,^PSRX(RX,"L",IR,0)=NOW_"^"_RXF_"^"_$S($G(PCOMX)]"":$G(PCOMX),1:"From RX number "_$P(^PSRX(RX,0),"^"))_" Drug-Drug interaction"_$S($G(RXRP(RX)):" (Reprint)",1:"")_"^"_PDUZ_"^1"
+4 SET IR=IR+1
SET PSRXSET="^52.032DA^"_IR_"^"_IR
+5 ; PSO*7*616 Fix missing Header node
SET ^PSRX(RX,"L",0)=PSRXSET
+6 SET PSRXSET=NOW_"^"_RXF_"^"_$SELECT($GET(PCOMX)]"":$GET(PCOMX),1:"From RX number "_$PIECE(^PSRX(RX,0),"^"))
+7 SET PSRXSET=PSRXSET_$SELECT(PSODRGI&(PSODOSEW)&$$DS^PSSDSAPI:" Drug-Drug interaction/dose warning",PSODRGI:" Drug-Drug interaction",PSODOSEW&$$DS^PSSDSAPI:" Dose Warning",1:"")_$SELECT($GET(RXRP(RX)):" (Reprint)",1:"")_"^"_PDUZ_"^1"
+8 SET ^PSRX(RX,"L",IR,0)=PSRXSET
+9 ;
+10 ;Storing FDA Medication Guide filename in the Prescription file
+11 IF $$MGONFILE^PSOFDAUT(RX)
Begin DoDot:1
+12 IF $GET(RXRP(RX))
IF '$GET(RXRP(RX,"MG"))
QUIT
+13 SET ^PSRX(RX,"L",IR,"FDA")=$PIECE($$MGONFILE^PSOFDAUT(RX),"^",2)
End DoDot:1
+14 ;
+15 if $DATA(^PS(52.4,RX,0))
KILL RXF,IR,FDA,NOW,I
END if $DATA(^PS(52.4,RX,0))
KILL PSCLN,DATE1,DRUG,RFLMSG,COPIES,DRUG,LMI,LINE,PS,PS1,PS2,INT,ISD,I1,MW,STATE,SIDE,SGY,PATST,PRTFL,PHYS,SGC,VRPH,NLWS,X1,X2,X,Y,TECH,EXPDT,NURSE,SEV,SCRIPT,RXX,SGY,SER,SSG,RXY,SIGPH,PS55,PS55X
KILL PSOSERV
+1 QUIT
UNKNOWN SET PSOY=PSOY+(3*PSOYI)
SET T=""
SET $PIECE(T,"*",100)=""
DO PRINT(T)
+1 SET T="THIS PRESCRIPTION HAS CAUSED A DRUG-DRUG INTERACTION "
DO PRINT(T)
+2 SET T=""
SET $PIECE(T,"*",100)=""
DO PRINT(T)
+3 SET T="PRESCRIPTION # "_$PIECE(^PSRX(RX,0),"^")_" "_$PIECE(^PSDRUG($PIECE(^PSRX(RX,0),"^",6),0),"^")
DO PRINT(T)
+4 SET T="The above prescription has a status of PENDING due to a DRUG-DRUG INTERACTION."
DO PRINT(T)
+5 SET T=PNM_" "_SSNP
DO PRINT(T)
+6 SET T=$PIECE(PS2,"^",2)_" ("_$PIECE(RXY,"^",16)_"/"_$SELECT(+$GET(VRPH):VRPH,1:" ")_")"_" "_$PIECE($PIECE(NOW,":",1,2),"@")
DO PRINT(T)
+7 SET T=RXN_" "_DATE1_" Fill "_(RXF+1)_" of "_(1+$PIECE(RXY,"^",9))
DO PRINT(T)
+8 FOR SSG=1:1
if $GET(SGY(SSG))=""
QUIT
SET T=SGY(SSG)
DO PRINT(T)
+9 SET PSOY=PSOY+PSOYI
SET T="Please review printouts of all labels for this patient that follow."
DO PRINT(T)
DO STORE
+10 WRITE @IOF
KILL PSCLN,DATE1,DRUG,RFLMSG,COPIES,DRUG,LMI,LINE,PS,PS1,PS2,INT,ISD,I1,MW,STATE,SIDE,SIGPH,SGY,PATST,PRTFL,PHYS,SGC,VRPH,NLWS,X1,X2,X,Y,TECH,EXPDT,NURSE,SEV,SCRIPT,RXX,SGY,SER,SSG,RXY,PSOSERV
QUIT
+11 ;
PRINT(T) ;
+1 IF $GET(PSOIO("ST"))]""
XECUTE PSOIO("ST")
+2 WRITE T,!
+3 IF $GET(PSOIO("ET"))]""
XECUTE PSOIO("ET")
+4 QUIT
+5 ;
M1 ;
+1 SET PSOY=PSOY+PSOYI
SET T="Rx# "_RXN_" has caused a DRUG-DRUG INTERACTION with the following prescription(s):"
DO PRINT(T)
+2 QUIT
M2 ;
+1 SET PSOY=PSOY+PSOYI
SET T=""
SET T="Rx# "_RXN
DO PRINT(T)
+2 QUIT
