- PSORLLL3 ;AITC/BWF - LASER LABELS ;11/20/02
- ;;7.0;OUTPATIENT PHARMACY;**454**;DEC 1997;Build 349
- ; BWF - modified copy of PSOLLL3
- ; - References to $$GETNDC^PSSNDCUT,$$NDCFMT^PSSNDCUT,SAVNDC^PSSNDCUT supported by IA 4707
- ;
- S PRCOPAY=$S('$D(PSOCPN):0,1:1)
- PF ;PATIENT FILL DOCUMENT
- I $G(PSOIO("PFI"))]"" X PSOIO("PFI")
- D S PSOFONT=OFONT
- . S OFONT=PSOFONT,PSOFONT=PSOHFONT
- . I $P(RXY,"^",9)=0 S T="NO REFILL for this prescription" D PRINT(T,1,1) S PSOY=PSOY+PSOYI Q
- . I RXF+1=(1+$P(RXY,"^",9)) S T="NO REFILLS LEFT for this prescription" D PRINT(T,1,1) S PSOY=PSOY+PSOYI Q
- . S T="PHONE IN OR MAIL THIS REFILL REQUEST" D PRINT(T,1,1)
- . S PSOFONT=OFONT,T="Follow the refill instructions provided with your prescription." D PRINT(T,0,1)
- . ;S PSOFONT=OFONT,OPSOX=PSOX,PSOX=PSOX+300,T="For Refill Call "_$P(PS,"^",3)_"-"_$P(PS,"^",4) D PRINT(T,0) S PSOX=OPSOX
- . S PSOFONT=OFONT,OPSOX=PSOX,PSOX=PSOX+300,T="For Refill Call "_$P(HINFO,"^",3) D PRINT(T,0) S PSOX=OPSOX
- S T=PNM_" "_$G(SSNPN) D PRINT(T,1)
- S T="Rx# "_RXN_" " D PRINT(T,1)
- D STRT^PSOLLU1("SEC2",T,.L) S OPSOX=PSOX,PSOX=L($E(PSOFONT,2,99))*300+PSOX
- S T=DATE_" Fill "_(RXF+1)_" of "_(1+$P(RXY,"^",9)),PSOY=PSOY-PSOYI D PRINT(T) S PSOX=OPSOX
- S T="" D PRINT(T,1)
- S T="Qty: "_$G(QTY)_" "_$G(PSDU)_" Days supply: "_$G(DAYS) D PRINT(T,0)
- S T=DRUG D PRINT(T,0)
- S T=$$GET1^DIQ(50,LOCDRUG,31,"E"),T=$$NDCFMT^PSSNDCUT(T) D PRINT(T,1)
- D D PRINT(T,1)
- . S NOR=$P(RXY,"^",9)
- . I $P(RXY,"^",9)=0 S T="NO REFILL" Q
- . I NOR=0 S T="NO REFILLS LEFT" Q
- . S T="May refill "_NOR_"X by "_EXPDT
- S PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:"")
- D PRINT($G(COPAYVAR))
- ;S T=$P(PS,"^")_"-"_$P(PS,"^",6) D STRT^PSOLLU1("SEC2",T,.L)
- S T=$P($G(HINFO),"^")_"-"_$P($G(HINFO),"^",4) D STRT^PSOLLU1("SEC2",T,.L)
- S OPSOX=PSOX,PSOX=2340-(L($E(PSOFONT,2,99))*300),PSOY=PSOY-PSOYI
- D PRINT(T)
- S PSOX=OPSOX,PSOYI=PSOBYI
- I $G(PSOIO("SBT"))]"" X PSOIO("SBT")
- S X2=$P($G(HINFO),"^",4)_"-"_RX
- W X2
- I $G(PSOIO("EBT"))]"" X PSOIO("EBT")
- I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
- Q
- PRINT(T,BOLD,HDR) ;
- S BOLD=+$G(BOLD),HDR=+$G(HDR)
- I 'BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
- I BOLD,$G(PSOIO(PSOFONT_"B"))]"" X PSOIO(PSOFONT_"B")
- I HDR D
- . S OPSOX=PSOX D STRT^PSOLLU1("SEC2",T,.L)
- . S PSOX=4.2-L($E(PSOFONT,2,99))*300/2+OPSOX
- I $G(PSOIO("ST"))]"" X PSOIO("ST")
- W T,!
- I HDR S PSOX=OPSOX
- I $G(PSOIO("ET"))]"" X PSOIO("ET")
- I BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT) ;TURN OFF BOLDING
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORLLL3 2503 printed Jan 18, 2025@03:35:04 Page 2
- PSORLLL3 ;AITC/BWF - LASER LABELS ;11/20/02
- +1 ;;7.0;OUTPATIENT PHARMACY;**454**;DEC 1997;Build 349
- +2 ; BWF - modified copy of PSOLLL3
- +3 ; - References to $$GETNDC^PSSNDCUT,$$NDCFMT^PSSNDCUT,SAVNDC^PSSNDCUT supported by IA 4707
- +4 ;
- +5 SET PRCOPAY=$SELECT('$DATA(PSOCPN):0,1:1)
- PF ;PATIENT FILL DOCUMENT
- +1 IF $GET(PSOIO("PFI"))]""
- XECUTE PSOIO("PFI")
- +2 Begin DoDot:1
- +3 SET OFONT=PSOFONT
- SET PSOFONT=PSOHFONT
- +4 IF $PIECE(RXY,"^",9)=0
- SET T="NO REFILL for this prescription"
- DO PRINT(T,1,1)
- SET PSOY=PSOY+PSOYI
- QUIT
- +5 IF RXF+1=(1+$PIECE(RXY,"^",9))
- SET T="NO REFILLS LEFT for this prescription"
- DO PRINT(T,1,1)
- SET PSOY=PSOY+PSOYI
- QUIT
- +6 SET T="PHONE IN OR MAIL THIS REFILL REQUEST"
- DO PRINT(T,1,1)
- +7 SET PSOFONT=OFONT
- SET T="Follow the refill instructions provided with your prescription."
- DO PRINT(T,0,1)
- +8 ;S PSOFONT=OFONT,OPSOX=PSOX,PSOX=PSOX+300,T="For Refill Call "_$P(PS,"^",3)_"-"_$P(PS,"^",4) D PRINT(T,0) S PSOX=OPSOX
- +9 SET PSOFONT=OFONT
- SET OPSOX=PSOX
- SET PSOX=PSOX+300
- SET T="For Refill Call "_$PIECE(HINFO,"^",3)
- DO PRINT(T,0)
- SET PSOX=OPSOX
- End DoDot:1
- SET PSOFONT=OFONT
- +10 SET T=PNM_" "_$GET(SSNPN)
- DO PRINT(T,1)
- +11 SET T="Rx# "_RXN_" "
- DO PRINT(T,1)
- +12 DO STRT^PSOLLU1("SEC2",T,.L)
- SET OPSOX=PSOX
- SET PSOX=L($EXTRACT(PSOFONT,2,99))*300+PSOX
- +13 SET T=DATE_" Fill "_(RXF+1)_" of "_(1+$PIECE(RXY,"^",9))
- SET PSOY=PSOY-PSOYI
- DO PRINT(T)
- SET PSOX=OPSOX
- +14 SET T=""
- DO PRINT(T,1)
- +15 SET T="Qty: "_$GET(QTY)_" "_$GET(PSDU)_" Days supply: "_$GET(DAYS)
- DO PRINT(T,0)
- +16 SET T=DRUG
- DO PRINT(T,0)
- +17 SET T=$$GET1^DIQ(50,LOCDRUG,31,"E")
- SET T=$$NDCFMT^PSSNDCUT(T)
- DO PRINT(T,1)
- +18 Begin DoDot:1
- +19 SET NOR=$PIECE(RXY,"^",9)
- +20 IF $PIECE(RXY,"^",9)=0
- SET T="NO REFILL"
- QUIT
- +21 IF NOR=0
- SET T="NO REFILLS LEFT"
- QUIT
- +22 SET T="May refill "_NOR_"X by "_EXPDT
- End DoDot:1
- DO PRINT(T,1)
- +23 SET PS=$SELECT($DATA(^PS(59,PSOSITE,0)):^(0),1:"")
- +24 DO PRINT($GET(COPAYVAR))
- +25 ;S T=$P(PS,"^")_"-"_$P(PS,"^",6) D STRT^PSOLLU1("SEC2",T,.L)
- +26 SET T=$PIECE($GET(HINFO),"^")_"-"_$PIECE($GET(HINFO),"^",4)
- DO STRT^PSOLLU1("SEC2",T,.L)
- +27 SET OPSOX=PSOX
- SET PSOX=2340-(L($EXTRACT(PSOFONT,2,99))*300)
- SET PSOY=PSOY-PSOYI
- +28 DO PRINT(T)
- +29 SET PSOX=OPSOX
- SET PSOYI=PSOBYI
- +30 IF $GET(PSOIO("SBT"))]""
- XECUTE PSOIO("SBT")
- +31 SET X2=$PIECE($GET(HINFO),"^",4)_"-"_RX
- +32 WRITE X2
- +33 IF $GET(PSOIO("EBT"))]""
- XECUTE PSOIO("EBT")
- +34 IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +35 QUIT
- PRINT(T,BOLD,HDR) ;
- +1 SET BOLD=+$GET(BOLD)
- SET HDR=+$GET(HDR)
- +2 IF 'BOLD
- IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +3 IF BOLD
- IF $GET(PSOIO(PSOFONT_"B"))]""
- XECUTE PSOIO(PSOFONT_"B")
- +4 IF HDR
- Begin DoDot:1
- +5 SET OPSOX=PSOX
- DO STRT^PSOLLU1("SEC2",T,.L)
- +6 SET PSOX=4.2-L($EXTRACT(PSOFONT,2,99))*300/2+OPSOX
- End DoDot:1
- +7 IF $GET(PSOIO("ST"))]""
- XECUTE PSOIO("ST")
- +8 WRITE T,!
- +9 IF HDR
- SET PSOX=OPSOX
- +10 IF $GET(PSOIO("ET"))]""
- XECUTE PSOIO("ET")
- +11 ;TURN OFF BOLDING
- IF BOLD
- IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +12 QUIT