- PSOLLL9 ;BIR/JLC -Prints allergy warning label ;01/24/03
- ;;7.0;OUTPATIENT PHARMACY;**120,161**;DEC 1997
- ;
- N AAA,DATE1,EXPDT,ISD,HARDCOPY,PSAA,PSAQUIT,PSBQUIT,PSCQUIT,BBBB,ICOUNT,PSOING,NOW,TB1,TB2,TB2,SSG
- S HARDCOPY=COPIES
- START ;
- I $G(PSOIO("AWI"))]"" X PSOIO("AWI")
- I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
- 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 '$G(RXRP(RX)) S T=$P(PS2,"^",2)_" ("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_") "_$P(NOW,":",1,2) D PRINT(T)
- S T="Rx# "_RXN_" has indicated a DRUG ALLERGY:" D PRINT(T)
- I $O(^PSRX(RX,"DAI",0)) D
- . S PSOY=PSOY+PSOYI,T=" Ingredients:" D PRINT(T)
- . F BBBB=0:0 S BBBB=$O(^PSRX(RX,"DAI",BBBB)) Q:'BBBB S T=" "_$G(^(BBBB,0)) D PRINT(T)
- S PSOY=PSOY+PSOYI
- S PSOY=PSOY+PSOYI,T="This prescription was entered by "_$G(TECH) D PRINT(T)
- S PSOY=PSOY+PSOYI,T="This prescription may require reviewing by a pharmacist" D PRINT(T)
- S PSOY=PSOY+PSOYI I $G(RXRP(RX)) S T="(REPRINT)" D PRINT(T)
- F ICOUNT=1:1 S T=$G(SGY(ICOUNT)) Q:T="" D PRINT(T)
- S T=RXN_" "_DATE1_" Fill "_(RXF+1)_" of "_(1+$P(RXY,"^",9)) D PRINT(T)
- S T=PNM_" "_SSNP D PRINT(T)
- S T="Qty: "_$G(QTY)_" "_$G(PHYS) D PRINT(T)
- S T=$G(DRUG) D PRINT(T)
- S T="Tech__________RPh__________" 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=HARDCOPY K HARDCOPY
- ;
- STORE ;ALLERGY LABEL PRINT NODE - SHOULD ALWAYS BE ON THE ORIGINAL
- D NOW^%DTC S NOW=% S PSAA=0 F AAA=0:0 S AAA=$O(^PSRX(RX,"L",AAA)) Q:'AAA S PSAA=AAA
- S PSAA=PSAA+1,^PSRX(RX,"L",0)="^52.032DA^"_PSAA_"^"_PSAA,^PSRX(RX,"L",PSAA,0)=NOW_"^"_0_"^Allergy warning label"_$S($G(RXRP(RX)):" (Reprint)",1:"")_"^"_PDUZ_"^2"
- END ;
- Q
- PRINT(T) ;
- I $G(PSOIO("ST"))]"" X PSOIO("ST")
- W T,!
- I $G(PSOIO("ET"))]"" X PSOIO("ET")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLLL9 2165 printed Feb 18, 2025@23:57:05 Page 2
- PSOLLL9 ;BIR/JLC -Prints allergy warning label ;01/24/03
- +1 ;;7.0;OUTPATIENT PHARMACY;**120,161**;DEC 1997
- +2 ;
- +3 NEW AAA,DATE1,EXPDT,ISD,HARDCOPY,PSAA,PSAQUIT,PSBQUIT,PSCQUIT,BBBB,ICOUNT,PSOING,NOW,TB1,TB2,TB2,SSG
- +4 SET HARDCOPY=COPIES
- START ;
- +1 IF $GET(PSOIO("AWI"))]""
- XECUTE PSOIO("AWI")
- +2 IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +3 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
- +4 SET Y=DATE
- XECUTE ^DD("DD")
- SET DATE1=Y
- DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET NOW=Y
- +5 IF '$GET(RXRP(RX))
- SET T=$PIECE(PS2,"^",2)_" ("_$PIECE(RXY,"^",16)_"/"_$SELECT(+$GET(VRPH):VRPH,1:" ")_") "_$PIECE(NOW,":",1,2)
- DO PRINT(T)
- +6 SET T="Rx# "_RXN_" has indicated a DRUG ALLERGY:"
- DO PRINT(T)
- +7 IF $ORDER(^PSRX(RX,"DAI",0))
- Begin DoDot:1
- +8 SET PSOY=PSOY+PSOYI
- SET T=" Ingredients:"
- DO PRINT(T)
- +9 FOR BBBB=0:0
- SET BBBB=$ORDER(^PSRX(RX,"DAI",BBBB))
- if 'BBBB
- QUIT
- SET T=" "_$GET(^(BBBB,0))
- DO PRINT(T)
- End DoDot:1
- +10 SET PSOY=PSOY+PSOYI
- +11 SET PSOY=PSOY+PSOYI
- SET T="This prescription was entered by "_$GET(TECH)
- DO PRINT(T)
- +12 SET PSOY=PSOY+PSOYI
- SET T="This prescription may require reviewing by a pharmacist"
- DO PRINT(T)
- +13 SET PSOY=PSOY+PSOYI
- IF $GET(RXRP(RX))
- SET T="(REPRINT)"
- DO PRINT(T)
- +14 FOR ICOUNT=1:1
- SET T=$GET(SGY(ICOUNT))
- if T=""
- QUIT
- DO PRINT(T)
- +15 SET T=RXN_" "_DATE1_" Fill "_(RXF+1)_" of "_(1+$PIECE(RXY,"^",9))
- DO PRINT(T)
- +16 SET T=PNM_" "_SSNP
- DO PRINT(T)
- +17 SET T="Qty: "_$GET(QTY)_" "_$GET(PHYS)
- DO PRINT(T)
- +18 SET T=$GET(DRUG)
- DO PRINT(T)
- +19 SET T="Tech__________RPh__________"
- DO PRINT(T)
- +20 SET T="Routing: "_$SELECT("W"[$EXTRACT(MW):MW,1:MW_" MAIL")
- DO PRINT(T)
- +21 SET T="Days Supply: "_$GET(DAYS)_" Cap: "_$SELECT(PSCAP:"**NON-SFTY**",1:"SAFETY")
- DO PRINT(T)
- +22 SET T="Isd: "_ISD_" Exp: "_EXPDT
- DO PRINT(T)
- +23 SET T="Last Fill: "_$GET(PSOFLAST)
- DO PRINT(T)
- +24 SET T="Pat. Stat "_PATST_" Clinic: "_PSCLN
- DO PRINT(T)
- +25 WRITE @IOF
- +26 IF COPIES>0
- GOTO START
- +27 SET COPIES=HARDCOPY
- KILL HARDCOPY
- +28 ;
- STORE ;ALLERGY LABEL PRINT NODE - SHOULD ALWAYS BE ON THE ORIGINAL
- +1 DO NOW^%DTC
- SET NOW=%
- SET PSAA=0
- FOR AAA=0:0
- SET AAA=$ORDER(^PSRX(RX,"L",AAA))
- if 'AAA
- QUIT
- SET PSAA=AAA
- +2 SET PSAA=PSAA+1
- SET ^PSRX(RX,"L",0)="^52.032DA^"_PSAA_"^"_PSAA
- SET ^PSRX(RX,"L",PSAA,0)=NOW_"^"_0_"^Allergy warning label"_$SELECT($GET(RXRP(RX)):" (Reprint)",1:"")_"^"_PDUZ_"^2"
- END ;
- +1 QUIT
- PRINT(T) ;
- +1 IF $GET(PSOIO("ST"))]""
- XECUTE PSOIO("ST")
- +2 WRITE T,!
- +3 IF $GET(PSOIO("ET"))]""
- XECUTE PSOIO("ET")
- +4 QUIT