- PSOLLL8 ;BIR/JLC - LASER LABEL - CRITICAL INTERACTION ;14-Mar-2013 17:53;PLS
- ;;7.0;OUTPATIENT PHARMACY;**120,1015**;DEC 1997;Build 62
- ;
- ;Reference to PS(56 supported by DBIA 2229
- ;Reference to PSDRUG supported by DBIA 221
- ;Modified - IHS/MSC/MGH - 02/26/12 - Line STORE+3
- ;
- S HOLDCOPY=COPIES
- START ;
- I $G(PSOIO("CDII"))]"" X PSOIO("CDII")
- I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
- K PSOSERV
- 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 S PSOY=PSOY+PSOYI,T="This prescription has caused a DRUG-DRUG INTERACTION." D PRINT(T)
- S PSOY=PSOY+PSOYI,T="Rx# "_RXN_" has caused a DRUG-DRUG INTERACTION with the following prescription(s):" D PRINT(T) S PSOY=PSOY+PSOYI
- I $D(^PS(52.4,RX,0)) S SCRIPT=$P(^PS(52.4,RX,0),"^",10),SEV=$P(^PS(52.4,RX,0),"^",9) F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D
- .S SER=$P(^PS(56,SEV(X),0),"^",4) S:$G(SER)=1 PSOSERV=1
- .S T=$P($G(^PSRX(RXX(X),0)),"^")_" "_$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") D PRINT(T)
- I '$D(^PS(52.4,RX,0)),$D(^PSRX(RX,"DRI")) 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 SER=$P(^PS(56,SEV(X),0),"^",4)
- .S T=$P($G(^PSRX(RXX(X),0)),"^")_" "_$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") D PRINT(T)
- S PSOY=PSOY+PSOYI
- S T="This prescription was entered by: "_TECH D PRINT(T)
- S PSOY=PSOY+PSOYI,T="This prescription "_$S('$G(PSOSERV):"may require",1:"requires")_" "_$S('$G(PSOSERV):"reviewing",1:"intervention")_" by a pharmacist" D PRINT(T)
- S PSOY=PSOY+PSOYI
- 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
- ;IHS/MSC/MGH - 02/26/13
- ;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
- S ^PSRX(RX,"L",0)="^52.032DA^"_IR_U_IR,^PSRX(RX,"L",IR,0)=NOW_U_RXF_U_$S($G(PCOMX)]"":$G(PCOMX),1:"From RX number "_$P(^PSRX(RX,0),U))_" Drug-Drug interaction"_$S($G(RXRP(RX)):$S($G(APSPREIS)=1:"(Reissue)",1:" (Reprint)"),1:"")_U_PDUZ_"^1"
- 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
- PSOLLL8 ;BIR/JLC - LASER LABEL - CRITICAL INTERACTION ;14-Mar-2013 17:53;PLS
- +1 ;;7.0;OUTPATIENT PHARMACY;**120,1015**;DEC 1997;Build 62
- +2 ;
- +3 ;Reference to PS(56 supported by DBIA 2229
- +4 ;Reference to PSDRUG supported by DBIA 221
- +5 ;Modified - IHS/MSC/MGH - 02/26/12 - Line STORE+3
- +6 ;
- +7 SET HOLDCOPY=COPIES
- START ;
- +1 IF $GET(PSOIO("CDII"))]""
- XECUTE PSOIO("CDII")
- +2 IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +3 KILL PSOSERV
- +4 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
- +5 SET Y=DATE
- XECUTE ^DD("DD")
- SET DATE1=Y
- DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET NOW=Y
- +6 IF '$DATA(^PS(52.4,RX,0))
- IF $PIECE(^PSRX(RX,"STA"),"^")=4
- DO UNKNOWN
- QUIT
- +7 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 SET PSOY=PSOY+PSOYI
- SET T="This prescription has caused a DRUG-DRUG INTERACTION."
- DO PRINT(T)
- +1 SET PSOY=PSOY+PSOYI
- SET T="Rx# "_RXN_" has caused a DRUG-DRUG INTERACTION with the following prescription(s):"
- DO PRINT(T)
- SET PSOY=PSOY+PSOYI
- +2 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)
- FOR X=1:1
- SET RXX(X)=$PIECE(SCRIPT,",",X)
- SET SEV(X)=$PIECE(SEV,",",X)
- IF RXX(X)=""
- QUIT
- Begin DoDot:1
- +3 SET SER=$PIECE(^PS(56,SEV(X),0),"^",4)
- IF $GET(SER)=1
- SET PSOSERV=1
- +4 SET T=$PIECE($GET(^PSRX(RXX(X),0)),"^")_" "_$SELECT(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$PIECE(^PSDRUG($PIECE(^PSRX(RXX(X),0),"^",6),0),"^")
- DO PRINT(T)
- End DoDot:1
- +5 IF '$DATA(^PS(52.4,RX,0))
- IF $DATA(^PSRX(RX,"DRI"))
- 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
- +6 SET SER=$PIECE(^PS(56,SEV(X),0),"^",4)
- +7 SET T=$PIECE($GET(^PSRX(RXX(X),0)),"^")_" "_$SELECT(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$PIECE(^PSDRUG($PIECE(^PSRX(RXX(X),0),"^",6),0),"^")
- DO PRINT(T)
- End DoDot:1
- +8 SET PSOY=PSOY+PSOYI
- +9 SET T="This prescription was entered by: "_TECH
- DO PRINT(T)
- +10 SET PSOY=PSOY+PSOYI
- 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 PSOY=PSOY+PSOYI
- +12 SET T=DATE1_" Fill "_(RXF+1)_" of "_(1+$PIECE(RXY,"^",9))
- DO PRINT(T)
- +13 SET T=PNM_" "_SSNP
- DO PRINT(T)
- +14 FOR SSG=1:1
- IF $GET(SGY(SSG))=""
- QUIT
- SET T=SGY(SSG)
- DO PRINT(T)
- +15 SET T="Qty: "_$GET(QTY)_" "_$GET(PHYS)
- DO PRINT(T)
- +16 SET T="Tech__________RPh__________"
- DO PRINT(T)
- +17 SET T=DRUG
- DO PRINT(T)
- +18 SET T="Routing: "_$SELECT("W"[$EXTRACT(MW):MW,1:MW_" MAIL")
- DO PRINT(T)
- +19 SET T="Days supply: "_$GET(DAYS)_" Cap: "_$SELECT(PSCAP:"**NON-SFTY**",1:"SAFETY")
- DO PRINT(T)
- +20 SET T="Isd: "_ISD_" Exp: "_EXPDT
- DO PRINT(T)
- +21 SET T="Last Fill: "_$GET(PSOFLAST)
- DO PRINT(T)
- +22 SET T="Pat. Stat "_PATST_" Clinic: "_PSCLN
- DO PRINT(T)
- +23 WRITE @IOF
- +24 IF COPIES>0
- GOTO START
- +25 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 ;IHS/MSC/MGH - 02/26/13
- +4 ;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"
- +5 SET IR=IR+1
- +6 SET ^PSRX(RX,"L",0)="^52.032DA^"_IR_U_IR
- SET ^PSRX(RX,"L",IR,0)=NOW_U_RXF_U_$SELECT($GET(PCOMX)]"":$GET(PCOMX),1:"From RX number "_$PIECE(^PSRX(RX,0),U))_" Drug-Drug interaction"_$SELECT($GET(RXRP(RX)):$SELECT($GET(APSPREIS)=1:"(Reissue)",1:" (Reprint)"),1:"")_U_PDUZ_"^1"
- +7 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
