- PSOLBLD ;BHAM ISC/RTR - PRINTS LABEL ;4/14/93
- ;;7.0;OUTPATIENT PHARMACY;**117,251,387,372**;DEC 1997;Build 54
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External reference to $$DS^PSSDSAPI supported by DBIA 5425
- S HOLDCOPY=COPIES
- N PSODOSEW,PSODRGI,PSOLINFD S (PSODOSEW,PSODRGI,PSOLINFD)=0
- START ;
- 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
- S:'$P($G(^PS(59,+$G(PSOSITE),1)),"^",28) TB1=38,TB2=50,TB3=83 S:$P($G(^PS(59,+$G(PSOSITE),1)),"^",28) TB1=54,TB2=66,TB3=102
- I '$D(^PS(52.4,RX,0)),$P(^PSRX(RX,"STA"),"^")=4 D UNKNOWN D Q
- .I $P(PSOPAR,"^",31),$P($G(^PSRX(RX,"STA")),"^")=4 D BLANK W @IOF
- L1 W !?TB3 W:$G(RXRP(RX)) "(REPRINT)" I '$G(RXRP(RX)) W $P(PS2,"^",2)," ","("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_")"_" ",$P(NOW,":",1,2)
- L2 W ! I ($P(^PSRX(RX,"STA"),"^")=4)!($D(^PSRX(RX,"DRI"))&('$G(RXF))&('$G(RXP))) W ?TB1,"PRESCRIPTION # "_RXN_" HAS"
- W ?TB3,RXN," ",DATE1," Fill ",RXF+1," of ",1+$P(RXY,"^",9)
- I ($P(^PSRX(RX,"STA"),"^")=4)!($D(^PSRX(RX,"DRI"))&('$G(RXF))&('$G(RXP))) W !?TB1,"CAUSED A DRUG-DRUG INTERACTION" S PSOLINFD=1
- W:'$G(PSOLINFD) ! S PSOLINFD=0 W ?TB3,PNM," ",SSNP S PSODRGI=1
- I ($P(^PSRX(RX,"STA"),"^")=4)!($D(^PSRX(RX,"DRI"))&('$G(RXF))&('$G(RXP))) W !?TB1,"WITH THE FOLLOWING PRESCRIPTION(S):" S PSOLINFD=1
- W:'$G(PSOLINFD) ! S PSOLINFD=0 W ?TB3,$S($G(OSGY(1))]"":OSGY(1),1:$G(SGY(1)))
- L5 W !,?TB3,$S($G(OSGY(2))]"":OSGY(2),1:$G(SGY(2)))
- I $G(SGY(3))'="" F SSG=3:1 Q:$G(SGY(SSG))="" W !,?TB3,$S($G(OSGY(SSG))]"":OSGY(SSG),1:$G(SGY(SSG)))
- L6 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=SEV(X) S:$G(SER)=1 PSOSERV=1 W !?TB1,$P($G(^PSRX(RXX(X),0)),"^"),?TB2,$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")," INTERACTION",!?TB1," ",$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") S:SER=1 PSODRGI=1
- 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=SEV(X) W !,?TB1,$P($G(^PSRX(RXX(X),0)),"^"),?TB2,$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")," INTERACTION",!?TB1," ",$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") S:SER=1 PSODRGI=1
- I $$DS^PSSDSAPI,($D(^PS(52.4,RX,1))) S T="",T=$P(^PS(52.4,RX,1),"^") D
- .S T=$$RCONVMS^PSODOSUT(T) W !!?TB1,T S:T>0 PSODOSEW=1
- L7 W !
- L8 W !,?TB1,"THIS PRESCRIPTION WAS ENTERED BY: ",?TB3,"Qty: "_$G(QTY)," ",$G(PHYS)
- L9 W !,?TB1,TECH,?TB3,"Tech__________RPh__________"
- L10 W !,?TB1,"THIS PRESCRIPTION ",$S('$G(PSOSERV):"MAY REQUIRE",1:"REQUIRES"),?TB3,DRUG
- L11 W !,?TB1,$S('$G(PSOSERV):"REVIEWING BY A PHARMACIST",1:"INTERVENTION BY A PHARMACIST"),?TB3,"Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL")
- L12 W !,?TB3,"Days supply: ",$G(DAYS)," Cap: "_$S(PSCAP:"**NON-SFTY**",1:"SAFETY")
- L13 W !,?TB3,"Isd: ",ISD," Exp: ",EXPDT
- L14 W !,?TB3,"Last Fill: ",$G(PSOLASTF)
- L15 W !,?TB3,"Pat. Stat ",PATST," Clinic: ",PSCLN
- L16 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,PSRXSET=""
- 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 K PSRXSET
- K:$D(^PS(52.4,RX,0)) RXF,IR,FDA,NOW,I
- I '$D(PSSPND),$P(PSOPAR,"^",18),$D(^PS(52.4,RX,0)) D CHCK2^PSOTRLBL
- I $P(PSOPAR,"^",31),$P($G(^PSRX(RX,"STA")),"^")=4 D BLANK W @IOF
- 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 TB1,TB2,TB3,PSOSERV
- Q
- UNKNOWN W !!!,?TB1,"PRESCRIPTION # ",$P(^PSRX(RX,0),"^")
- W !,?TB1," ",$P(^PSDRUG($P(^PSRX(RX,0),"^",6),0),"^"),?TB3,$P(PS2,"^",2)_" ("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_")"_" ",$P($P(NOW,":",1,2),"@")
- W !,?TB3,RXN," ",DATE1," Fill ",RXF+1," of ",1+$P(RXY,"^",9)
- W !,?TB1,"The above prescription has a status",?TB3,PNM," ",SSNP
- W !,?TB1,"of PENDING due to a DRUG-DRUG INTERACTION.",?TB3,$S($G(OSGY(1))]"":OSGY(1),1:$G(SGY(1)))
- I $G(SGY(2))'="" F SSG=2:1 Q:$G(SGY(SSG))="" W !,?TB3,$S($G(OSGY(SSG))]"":OSGY(SSG),1:$G(SGY(SSG)))
- W !,?TB1,"Please review printouts of all labels"
- W !,?TB1,"for this patient that follow." D 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,TB1,TB2,TB3,PSOSERV Q
- ;
- BLANK ;label between patients
- F ZBLANK=1:1:10 W !
- W !,"**********************NEXT PATIENT*************",?54,"*********NEXT PATIENT***********NEXT PATIENT***"
- K ZBLANK Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLBLD 5284 printed Feb 18, 2025@23:56:51 Page 2
- PSOLBLD ;BHAM ISC/RTR - PRINTS LABEL ;4/14/93
- +1 ;;7.0;OUTPATIENT PHARMACY;**117,251,387,372**;DEC 1997;Build 54
- +2 ;External reference to ^PSDRUG supported by DBIA 221
- +3 ;External reference to $$DS^PSSDSAPI supported by DBIA 5425
- +4 SET HOLDCOPY=COPIES
- +5 NEW PSODOSEW,PSODRGI,PSOLINFD
- SET (PSODOSEW,PSODRGI,PSOLINFD)=0
- START ;
- +1 KILL PSOSERV
- +2 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
- +3 SET Y=DATE
- XECUTE ^DD("DD")
- SET DATE1=Y
- DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET NOW=Y
- +4 if '$PIECE($GET(^PS(59,+$GET(PSOSITE),1)),"^",28)
- SET TB1=38
- SET TB2=50
- SET TB3=83
- if $PIECE($GET(^PS(59,+$GET(PSOSITE),1)),"^",28)
- SET TB1=54
- SET TB2=66
- SET TB3=102
- +5 IF '$DATA(^PS(52.4,RX,0))
- IF $PIECE(^PSRX(RX,"STA"),"^")=4
- DO UNKNOWN
- Begin DoDot:1
- +6 IF $PIECE(PSOPAR,"^",31)
- IF $PIECE($GET(^PSRX(RX,"STA")),"^")=4
- DO BLANK
- WRITE @IOF
- End DoDot:1
- QUIT
- L1 WRITE !?TB3
- if $GET(RXRP(RX))
- WRITE "(REPRINT)"
- IF '$GET(RXRP(RX))
- WRITE $PIECE(PS2,"^",2)," ","("_$PIECE(RXY,"^",16)_"/"_$SELECT(+$GET(VRPH):VRPH,1:" ")_")"_" ",$PIECE(NOW,":",1,2)
- L2 WRITE !
- IF ($PIECE(^PSRX(RX,"STA"),"^")=4)!($DATA(^PSRX(RX,"DRI"))&('$GET(RXF))&('$GET(RXP)))
- WRITE ?TB1,"PRESCRIPTION # "_RXN_" HAS"
- +1 WRITE ?TB3,RXN," ",DATE1," Fill ",RXF+1," of ",1+$PIECE(RXY,"^",9)
- +2 IF ($PIECE(^PSRX(RX,"STA"),"^")=4)!($DATA(^PSRX(RX,"DRI"))&('$GET(RXF))&('$GET(RXP)))
- WRITE !?TB1,"CAUSED A DRUG-DRUG INTERACTION"
- SET PSOLINFD=1
- +3 if '$GET(PSOLINFD)
- WRITE !
- SET PSOLINFD=0
- WRITE ?TB3,PNM," ",SSNP
- SET PSODRGI=1
- +4 IF ($PIECE(^PSRX(RX,"STA"),"^")=4)!($DATA(^PSRX(RX,"DRI"))&('$GET(RXF))&('$GET(RXP)))
- WRITE !?TB1,"WITH THE FOLLOWING PRESCRIPTION(S):"
- SET PSOLINFD=1
- +5 if '$GET(PSOLINFD)
- WRITE !
- SET PSOLINFD=0
- WRITE ?TB3,$SELECT($GET(OSGY(1))]"":OSGY(1),1:$GET(SGY(1)))
- L5 WRITE !,?TB3,$SELECT($GET(OSGY(2))]"":OSGY(2),1:$GET(SGY(2)))
- +1 IF $GET(SGY(3))'=""
- FOR SSG=3:1
- if $GET(SGY(SSG))=""
- QUIT
- WRITE !,?TB3,$SELECT($GET(OSGY(SSG))]"":OSGY(SSG),1:$GET(SGY(SSG)))
- L6 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
- +1 SET SER=SEV(X)
- if $GET(SER)=1
- SET PSOSERV=1
- WRITE !?TB1,$PIECE($GET(^PSRX(RXX(X),0)),"^"),?TB2,$SELECT(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")," INTERACTION",!?TB1," ",$PIECE(^PSDRUG($PIECE(^PSRX(RXX(X),0),"^",6),0),"^")
- if SER=1
- SET PSODRGI=1
- End DoDot:1
- +2 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
- +3 SET SER=SEV(X)
- WRITE !,?TB1,$PIECE($GET(^PSRX(RXX(X),0)),"^"),?TB2,$SELECT(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")," INTERACTION",!?TB1," ",$PIECE(^PSDRUG($PIECE(^PSRX(RXX(X),0),"^",6),0),"^")
- if SER=1
- SET PSODRGI=1
- End DoDot:1
- +4 IF $$DS^PSSDSAPI
- IF ($DATA(^PS(52.4,RX,1)))
- SET T=""
- SET T=$PIECE(^PS(52.4,RX,1),"^")
- Begin DoDot:1
- +5 SET T=$$RCONVMS^PSODOSUT(T)
- WRITE !!?TB1,T
- if T>0
- SET PSODOSEW=1
- End DoDot:1
- L7 WRITE !
- L8 WRITE !,?TB1,"THIS PRESCRIPTION WAS ENTERED BY: ",?TB3,"Qty: "_$GET(QTY)," ",$GET(PHYS)
- L9 WRITE !,?TB1,TECH,?TB3,"Tech__________RPh__________"
- L10 WRITE !,?TB1,"THIS PRESCRIPTION ",$SELECT('$GET(PSOSERV):"MAY REQUIRE",1:"REQUIRES"),?TB3,DRUG
- L11 WRITE !,?TB1,$SELECT('$GET(PSOSERV):"REVIEWING BY A PHARMACIST",1:"INTERVENTION BY A PHARMACIST"),?TB3,"Routing: "_$SELECT("W"[$EXTRACT(MW):MW,1:MW_" MAIL")
- L12 WRITE !,?TB3,"Days supply: ",$GET(DAYS)," Cap: "_$SELECT(PSCAP:"**NON-SFTY**",1:"SAFETY")
- L13 WRITE !,?TB3,"Isd: ",ISD," Exp: ",EXPDT
- L14 WRITE !,?TB3,"Last Fill: ",$GET(PSOLASTF)
- L15 WRITE !,?TB3,"Pat. Stat ",PATST," Clinic: ",PSCLN
- L16 WRITE !,@IOF
- +1 IF COPIES>0
- GOTO START
- +2 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 SET IR=IR+1
- SET ^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
- SET PSRXSET=""
- +4 SET PSRXSET=NOW_"^"_RXF_"^"_$SELECT($GET(PCOMX)]"":$GET(PCOMX),1:"From RX number "_$PIECE(^PSRX(RX,0),"^"))
- +5 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"
- +6 SET ^PSRX(RX,"L",IR,0)=PSRXSET
- KILL PSRXSET
- +7 if $DATA(^PS(52.4,RX,0))
- KILL RXF,IR,FDA,NOW,I
- +8 IF '$DATA(PSSPND)
- IF $PIECE(PSOPAR,"^",18)
- IF $DATA(^PS(52.4,RX,0))
- DO CHCK2^PSOTRLBL
- +9 IF $PIECE(PSOPAR,"^",31)
- IF $PIECE($GET(^PSRX(RX,"STA")),"^")=4
- DO BLANK
- WRITE @IOF
- 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 TB1,TB2,TB3,PSOSERV
- +1 QUIT
- UNKNOWN WRITE !!!,?TB1,"PRESCRIPTION # ",$PIECE(^PSRX(RX,0),"^")
- +1 WRITE !,?TB1," ",$PIECE(^PSDRUG($PIECE(^PSRX(RX,0),"^",6),0),"^"),?TB3,$PIECE(PS2,"^",2)_" ("_$PIECE(RXY,"^",16)_"/"_$SELECT(+$GET(VRPH):VRPH,1:" ")_")"_" ",$PIECE($PIECE(NOW,":",1,2),"@")
- +2 WRITE !,?TB3,RXN," ",DATE1," Fill ",RXF+1," of ",1+$PIECE(RXY,"^",9)
- +3 WRITE !,?TB1,"The above prescription has a status",?TB3,PNM," ",SSNP
- +4 WRITE !,?TB1,"of PENDING due to a DRUG-DRUG INTERACTION.",?TB3,$SELECT($GET(OSGY(1))]"":OSGY(1),1:$GET(SGY(1)))
- +5 IF $GET(SGY(2))'=""
- FOR SSG=2:1
- if $GET(SGY(SSG))=""
- QUIT
- WRITE !,?TB3,$SELECT($GET(OSGY(SSG))]"":OSGY(SSG),1:$GET(SGY(SSG)))
- +6 WRITE !,?TB1,"Please review printouts of all labels"
- +7 WRITE !,?TB1,"for this patient that follow."
- DO STORE
- +8 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,TB1,TB2,TB3,PSOSERV
- QUIT
- +9 ;
- BLANK ;label between patients
- +1 FOR ZBLANK=1:1:10
- WRITE !
- +2 WRITE !,"**********************NEXT PATIENT*************",?54,"*********NEXT PATIENT***********NEXT PATIENT***"
- +3 KILL ZBLANK
- QUIT