- PSOLBLN ;BIR/RTR-NEW PRINTS LABEL ;11/18/92
- ;;7.0;OUTPATIENT PHARMACY;**16,36,71,107,110,117,135,233**;DEC 1997;Build 8
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External reference to ^VA(200 supported by DBIA 224
- K PSOSTLK,ZTKDRUG I $L($T(PSOSTALK^PSOTALK1)) D PSOSTALK^PSOTALK1 S PSOSTLK=1 ; PRINT SCRIPTALK LABEL IF APPLICABLE
- I $G(IOS),$G(PSOBARS) I $G(PSOBAR0)=""!($G(PSOBAR1)="") S PSOIOS=IOS D DEVBAR^PSOBMST
- I $G(DFN) D ADD^VADPT
- S ADDR(33)=$G(VAPA(4))_", "_$P($G(VAPA(5)),"^",2)_" "_$S($G(VAPA(11))]"":$P($G(VAPA(11)),"^",2),1:$G(VAPA(6))),ADDR(22)=""
- S:$G(VAPA(2))]"" ADDR(22)=$G(VAPA(2))_" "_$G(VAPA(3)),ADDR(22)=$E(ADDR(22),1,46) S:ADDR(22)="" ADDR(22)=ADDR(33),ADDR(33)=""
- S ADDR(4)=$S(ADDR(33)="":ADDR(22),1:ADDR(33)) I $G(VAPA(2))="",$G(VAPA(3))="" S ADDR(2)=ADDR(4),ADDR(3)="",ADDR(4)="" G ST
- I $G(VAPA(2))'="",$G(VAPA(3))="" S ADDR(2)=VAPA(2),ADDR(3)=ADDR(4),ADDR(4)="" G ST
- I $G(VAPA(2))="",$G(VAPA(3))'="" S ADDR(2)=VAPA(3),ADDR(3)=ADDR(4),ADDR(4)="" G ST
- S ADDR(2)=$G(VAPA(2)),ADDR(3)=$G(VAPA(3))
- ST I $P($G(^PSRX(RX,3)),"^",3) S PSOPROV=+$P(^(0),"^",4) S PSOPROV=$S($G(RXP):+$P($G(RXP),"^",17),$G(RXF):+$P($G(^PSRX(RX,1,RXF,0)),"^",17),1:PSOPROV) S:'$G(PSOPROV) PSOPROV=+$P(^PSRX(RX,0),"^",4) D
- .I +$P($G(^VA(200,PSOPROV,"PS")),"^",7) S:'$P($G(PHYS),"/",2) PHYS=$G(PHYS)_"/"_+$P($G(^PSRX(RX,3)),"^",3)
- S COPIES=COPIES-1,$P(ULN,"_",34)="",PSOTRAIL=1 I $G(SIDE) D REP^PSOLBL2 G REP
- S (Y,X1)=EXPDT X ^DD("DD") S EXPDT=Y,Y=$P(^PSRX(RX,0),"^",13) X ^DD("DD") S ISD=Y,X2=DT D ^%DTC S DIFF=X
- S Y=DATE X ^DD("DD") S DATE=Y D NOW^%DTC S Y=% X ^DD("DD") S NOW=Y
- S TECH="("_$S($P($G(^PSRX(+$G(RX),"OR1")),"^",5):$P($G(^PSRX(+$G(RX),"OR1")),"^",5),1:$P(RXY,"^",16))_"/"_$S($G(VRPH)&($P(PSOPAR,"^",32)):VRPH,1:" ")_")"
- S PSZIP=$P(PS,"^",5) S PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
- L1 W ?3,"VAMC ",$P(PS,"^",7),", ",STATE," ",$G(PSOHZIP),?54,"VAMC ",$P(PS,"^",7),", ",STATE," ",$G(PSOHZIP),?102 W $S($D(REPRINT)&($G(PSOBLALL)):"(GROUP REPRINT)",$D(REPRINT):"(REPRINT)",1:"") W:$G(RXP) "(PARTIAL)"
- W !?3,$P(PS2,"^",2)," ",$P(PS,"^",3),"-",$P(PS,"^",4)," ",TECH,?54,$P(PS2,"^",2)," ",$P(PS,"^",3),"-",$P(PS,"^",4)," ",TECH,?102,$P(PS2,"^",2)," ",TECH," ",NOW
- W !,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$P(RXY,"^",9),?54,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$P(RXY,"^",9),?102,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$P(RXY,"^",9)
- W !,PNM," ",$G(SSNPN),?54,PNM," ",$G(SSNPN),?102,PNM," ",$G(SSNPN)
- F DR=1:1 Q:$G(SGY(DR))="" D:DR=4!(DR=7)!(DR=10)!(DR=13) W !,$G(SGY(DR)),?54,$G(SGY(DR)),?102,$S($G(OSGY(DR))]"":OSGY(DR),1:$G(SGY(DR)))
- .F GG=1:1:27 W !
- I DR>4 S KK=$S(DR=5!(DR=8)!(DR=11):2,(DR=6)!(DR=9)!(DR=12):1,1:0) I KK F HH=1:1:KK W !
- I DR=2 W !!
- I DR=3 W !
- W !,$G(PHYS),?54,$G(PHYS),?102,$G(PHYS)
- S PSMF=$S($G(NURSE):"Mfg______Exp______",1:""),PSDU=$P($G(^PSDRUG($P($G(^PSRX(RX,0)),"^",6),660)),"^",8),PSDU=$S(PSDU="":" "_PSMF,1:PSDU_" "_PSMF)
- W !,"Qty: "_$G(QTY)," ",$G(PSDU),?54,"Qty: "_$G(QTY)," ",$G(PSDU),?102,"Qty: "_$G(QTY)," ",$G(PSDU)
- S ZTKDRUG="XXXXXX SCRIPTALK RX XXXXXX"
- I '$G(PSOSTLK) K PSDU,PSMF W !,DRUG,?54,DRUG,?102,DRUG
- I $G(PSOSTLK) K PSDU,PSMF W !,$S($G(PSOSTALK):ZTKDRUG,1:DRUG),?54,DRUG,?102,DRUG
- I $P(RXY,"^",9)-RXF'>0 D ^PSOLBLN1 G L13
- G:DIFF<30 L11
- W !?54,$P(RXY,"^",9)-RXF," Refills remain prior to ",EXPDT,?102,"Mfg "_$G(MFG)_" Lot# "_$G(LOT) G L12
- L11 W !?54,"Last fill prior to ",$G(EXPDT),?102,"Mfg "_$G(MFG)_" Lot# "_$G(LOT)
- L12 W !,$P(PS,"^",2),?54,$S($L($G(COPAYVAR)):$G(COPAYVAR)_" ",1:""),"Days Supply: ",$G(DAYS),?102,"Tech__________RPh_________",!,$P(PS,"^",7),", ",STATE," ",$G(PSOHZIP)
- ;send a CR for OPTIFIL (P-MT661BC)
- I $G(PSOBARS),$P(PSOPAR,"^",19)'=1 S X="S",X2=PSOINST_"-"_RX S X1=$X W ?54,@PSOBAR1,X2,@PSOBAR0,$C(13) S $X=0 W:IOST["P-MT661BC" !
- E W !!!
- W !,"FORWARDING SERVICE REQUESTED" W:"C"[$E(MW) !,?21,"CERTIFIED MAIL" W !?54,$G(VAPA(1))
- W !,$S($G(PS55)=2:"***DO NOT MAIL***",1:"***CRITICAL MEDICAL SHIPMENT***"),?54,$G(ADDR(2)),?102,"Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL")
- W !?54,$G(ADDR(3)),?102,"Days supply: ",$G(DAYS)," Cap: ",$S(PSCAP:"**NON-SFTY**",1:"SAFETY")
- W !?54,$G(ADDR(4)),?102,"Isd: ",ISD," Exp: ",EXPDT
- W !,PNM,?54,"*Indicate address change on back of this form",?102,"Last Fill: ",$G(PSOLASTF)
- W !,$S($D(PSMP(1)):PSMP(1),1:$G(VAPA(1))),?54,"[ ] Permanent",?102,"Pat. Stat ",PATST," Clinic: ",PSCLN
- W !,$S($D(PSMP(2)):PSMP(2),$D(PSMP(1)):"",1:$G(ADDR(2))),?54,"[ ] Temporary until ",$S($P($G(VAPA(10)),"^",2)]"":$P($G(VAPA(10)),"^",2),1:"__/__/__"),?102,$S($G(WARN)'="":"DRUG WARNING "_$G(WARN),1:"")
- W !,$S($D(PSMP(3)):PSMP(3),$D(PSMP(1)):"",1:$G(ADDR(3))),!,$S($D(PSMP(4)):PSMP(4),$D(PSMP(1)):"",1:$G(ADDR(4))),?54,"Signature",ULN
- I $G(PSOBARS) S X="S",X2=PSOINST_"-"_RX S X1=$X W ?102,@PSOBAR1,X2,@PSOBAR0,$C(13) S $X=0
- L13 I $G(WARN)'="",'$G(PSOBLALL) I '$G(PSDFNFLG),'$G(PSOLAPPL) D WARN^PSOLBL2
- W @IOF
- REP I COPIES>0 S SIDE=1 G ST
- 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
- S 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
- S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_$S($G(PCOMX)]"":$G(PCOMX),$G(PCOMH(RX))]"":PCOMH(RX),1:"From RX number "_$P(^PSRX(RX,0),"^"))_$S($G(RXP):" (Partial)",1:"")_$S($D(REPRINT):" (Reprint)",1:"")_"^"_PDUZ
- N PSOBADR,PSOTEMP
- S PSOBADR=$$CHKRX^PSOBAI(RX)
- I $G(PSOBADR) S PSOTEMP=$P(PSOBADR,"^",2),PSOBADR=$P(PSOBADR,"^")
- I $G(PSOBADR),'$G(PSOTEMP) D
- .S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
- .S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_"ROUTING="_$G(MW)_" (BAD ADDRESS)"_"^"_PDUZ
- S ^PSRX(RX,"TYPE")=0 K RXF,IR,FDA,NOW,I,PCOMH(RX)
- I $G(WARN)'="" I $G(PSDFNFLG)!($G(PSOLAPPL)) D ALLWARN^PSOLBLN1
- I $G(WARN)="" I $G(PSDFNFLG)!($G(PSOLAPPL)) D ALL^PSOLBLS
- I $G(PSOBLALL) D:$G(WARN)="" ALL^PSOLBLS D:$G(WARN)'="" ALLWARN^PSOLBLN1
- I '$D(PSSPND),$P(PSOPAR,"^",18) I $G(PSDFNFLG)!($G(PSOLAPPL))!($G(PSOBLALL)) D CHCK2^PSOTRLBL
- D:$G(PSOBLALL) TRAIL^PSOLBL2
- END ;
- I $D(RXFLX(RX)) S RXFL(RX)=$G(RXFLX(RX)) K RXFLX
- D KILL^PSOLBL2 Q
- PSOLBLN ;BIR/RTR-NEW PRINTS LABEL ;11/18/92
- +1 ;;7.0;OUTPATIENT PHARMACY;**16,36,71,107,110,117,135,233**;DEC 1997;Build 8
- +2 ;External reference to ^PSDRUG supported by DBIA 221
- +3 ;External reference to ^VA(200 supported by DBIA 224
- +4 ; PRINT SCRIPTALK LABEL IF APPLICABLE
- KILL PSOSTLK,ZTKDRUG
- IF $LENGTH($TEXT(PSOSTALK^PSOTALK1))
- DO PSOSTALK^PSOTALK1
- SET PSOSTLK=1
- +5 IF $GET(IOS)
- IF $GET(PSOBARS)
- IF $GET(PSOBAR0)=""!($GET(PSOBAR1)="")
- SET PSOIOS=IOS
- DO DEVBAR^PSOBMST
- +6 IF $GET(DFN)
- DO ADD^VADPT
- +7 SET ADDR(33)=$GET(VAPA(4))_", "_$PIECE($GET(VAPA(5)),"^",2)_" "_$SELECT($GET(VAPA(11))]"":$PIECE($GET(VAPA(11)),"^",2),1:$GET(VAPA(6)))
- SET ADDR(22)=""
- +8 IF $GET(VAPA(2))]""
- SET ADDR(22)=$GET(VAPA(2))_" "_$GET(VAPA(3))
- SET ADDR(22)=$EXTRACT(ADDR(22),1,46)
- IF ADDR(22)=""
- SET ADDR(22)=ADDR(33)
- SET ADDR(33)=""
- +9 SET ADDR(4)=$SELECT(ADDR(33)="":ADDR(22),1:ADDR(33))
- IF $GET(VAPA(2))=""
- IF $GET(VAPA(3))=""
- SET ADDR(2)=ADDR(4)
- SET ADDR(3)=""
- SET ADDR(4)=""
- GOTO ST
- +10 IF $GET(VAPA(2))'=""
- IF $GET(VAPA(3))=""
- SET ADDR(2)=VAPA(2)
- SET ADDR(3)=ADDR(4)
- SET ADDR(4)=""
- GOTO ST
- +11 IF $GET(VAPA(2))=""
- IF $GET(VAPA(3))'=""
- SET ADDR(2)=VAPA(3)
- SET ADDR(3)=ADDR(4)
- SET ADDR(4)=""
- GOTO ST
- +12 SET ADDR(2)=$GET(VAPA(2))
- SET ADDR(3)=$GET(VAPA(3))
- ST IF $PIECE($GET(^PSRX(RX,3)),"^",3)
- SET PSOPROV=+$PIECE(^(0),"^",4)
- SET PSOPROV=$SELECT($GET(RXP):+$PIECE($GET(RXP),"^",17),$GET(RXF):+$PIECE($GET(^PSRX(RX,1,RXF,0)),"^",17),1:PSOPROV)
- IF '$GET(PSOPROV)
- SET PSOPROV=+$PIECE(^PSRX(RX,0),"^",4)
- Begin DoDot:1
- +1 IF +$PIECE($GET(^VA(200,PSOPROV,"PS")),"^",7)
- IF '$PIECE($GET(PHYS),"/",2)
- SET PHYS=$GET(PHYS)_"/"_+$PIECE($GET(^PSRX(RX,3)),"^",3)
- End DoDot:1
- +2 SET COPIES=COPIES-1
- SET $PIECE(ULN,"_",34)=""
- SET PSOTRAIL=1
- IF $GET(SIDE)
- DO REP^PSOLBL2
- GOTO REP
- +3 SET (Y,X1)=EXPDT
- XECUTE ^DD("DD")
- SET EXPDT=Y
- SET Y=$PIECE(^PSRX(RX,0),"^",13)
- XECUTE ^DD("DD")
- SET ISD=Y
- SET X2=DT
- DO ^%DTC
- SET DIFF=X
- +4 SET Y=DATE
- XECUTE ^DD("DD")
- SET DATE=Y
- DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET NOW=Y
- +5 SET TECH="("_$SELECT($PIECE($GET(^PSRX(+$GET(RX),"OR1")),"^",5):$PIECE($GET(^PSRX(+$GET(RX),"OR1")),"^",5),1:$PIECE(RXY,"^",16))_"/"_$SELECT($GET(VRPH)&($PIECE(PSOPAR,"^",32)):VRPH,1:" ")_")"
- +6 SET PSZIP=$PIECE(PS,"^",5)
- SET PSOHZIP=$SELECT(PSZIP["-":PSZIP,1:$EXTRACT(PSZIP,1,5)_$SELECT($EXTRACT(PSZIP,6,9)]"":"-"_$EXTRACT(PSZIP,6,9),1:""))
- L1 WRITE ?3,"VAMC ",$PIECE(PS,"^",7),", ",STATE," ",$GET(PSOHZIP),?54,"VAMC ",$PIECE(PS,"^",7),", ",STATE," ",$GET(PSOHZIP),?102
- WRITE $SELECT($DATA(REPRINT)&($GET(PSOBLALL)):"(GROUP REPRINT)",$DATA(REPRINT):"(REPRINT)",1:"")
- IF $GET(RXP)
- WRITE "(PARTIAL)"
- +1 WRITE !?3,$PIECE(PS2,"^",2)," ",$PIECE(PS,"^",3),"-",$PIECE(PS,"^",4)," ",TECH,?54,$PIECE(PS2,"^",2)," ",$PIECE(PS,"^",3),"-",$PIECE(PS,"^",4)," ",TECH,?102,$PIECE(PS2,"^",2)," ",TECH," ",NOW
- +2 WRITE !,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$PIECE(RXY,"^",9),?54,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$PIECE(RXY,"^",9),?102,"Rx# ",RXN," ",DATE," Fill ",RXF+1," of ",1+$PIECE(RXY,"^",9)
- +3 WRITE !,PNM," ",$GET(SSNPN),?54,PNM," ",$GET(SSNPN),?102,PNM," ",$GET(SSNPN)
- +4 FOR DR=1:1
- IF $GET(SGY(DR))=""
- QUIT
- IF DR=4!(DR=7)!(DR=10)!(DR=13)
- Begin DoDot:1
- +5 FOR GG=1:1:27
- WRITE !
- End DoDot:1
- WRITE !,$GET(SGY(DR)),?54,$GET(SGY(DR)),?102,$SELECT($GET(OSGY(DR))]"":OSGY(DR),1:$GET(SGY(DR)))
- +6 IF DR>4
- SET KK=$SELECT(DR=5!(DR=8)!(DR=11):2,(DR=6)!(DR=9)!(DR=12):1,1:0)
- IF KK
- FOR HH=1:1:KK
- WRITE !
- +7 IF DR=2
- WRITE !!
- +8 IF DR=3
- WRITE !
- +9 WRITE !,$GET(PHYS),?54,$GET(PHYS),?102,$GET(PHYS)
- +10 SET PSMF=$SELECT($GET(NURSE):"Mfg______Exp______",1:"")
- SET PSDU=$PIECE($GET(^PSDRUG($PIECE($GET(^PSRX(RX,0)),"^",6),660)),"^",8)
- SET PSDU=$SELECT(PSDU="":" "_PSMF,1:PSDU_" "_PSMF)
- +11 WRITE !,"Qty: "_$GET(QTY)," ",$GET(PSDU),?54,"Qty: "_$GET(QTY)," ",$GET(PSDU),?102,"Qty: "_$GET(QTY)," ",$GET(PSDU)
- +12 SET ZTKDRUG="XXXXXX SCRIPTALK RX XXXXXX"
- +13 IF '$GET(PSOSTLK)
- KILL PSDU,PSMF
- WRITE !,DRUG,?54,DRUG,?102,DRUG
- +14 IF $GET(PSOSTLK)
- KILL PSDU,PSMF
- WRITE !,$SELECT($GET(PSOSTALK):ZTKDRUG,1:DRUG),?54,DRUG,?102,DRUG
- +15 IF $PIECE(RXY,"^",9)-RXF'>0
- DO ^PSOLBLN1
- GOTO L13
- +16 IF DIFF<30
- GOTO L11
- +17 WRITE !?54,$PIECE(RXY,"^",9)-RXF," Refills remain prior to ",EXPDT,?102,"Mfg "_$GET(MFG)_" Lot# "_$GET(LOT)
- GOTO L12
- L11 WRITE !?54,"Last fill prior to ",$GET(EXPDT),?102,"Mfg "_$GET(MFG)_" Lot# "_$GET(LOT)
- L12 WRITE !,$PIECE(PS,"^",2),?54,$SELECT($LENGTH($GET(COPAYVAR)):$GET(COPAYVAR)_" ",1:""),"Days Supply: ",$GET(DAYS),?102,"Tech__________RPh_________",!,$PIECE(PS,"^",7),", ",STATE," ",$GET(PSOHZIP)
- +1 ;send a CR for OPTIFIL (P-MT661BC)
- +2 IF $GET(PSOBARS)
- IF $PIECE(PSOPAR,"^",19)'=1
- SET X="S"
- SET X2=PSOINST_"-"_RX
- SET X1=$X
- WRITE ?54,@PSOBAR1,X2,@PSOBAR0,$CHAR(13)
- SET $X=0
- IF IOST["P-MT661BC"
- WRITE !
- +3 IF '$TEST
- WRITE !!!
- +4 WRITE !,"FORWARDING SERVICE REQUESTED"
- IF "C"[$EXTRACT(MW)
- WRITE !,?21,"CERTIFIED MAIL"
- WRITE !?54,$GET(VAPA(1))
- +5 WRITE !,$SELECT($GET(PS55)=2:"***DO NOT MAIL***",1:"***CRITICAL MEDICAL SHIPMENT***"),?54,$GET(ADDR(2)),?102,"Routing: "_$SELECT("W"[$EXTRACT(MW):MW,1:MW_" MAIL")
- +6 WRITE !?54,$GET(ADDR(3)),?102,"Days supply: ",$GET(DAYS)," Cap: ",$SELECT(PSCAP:"**NON-SFTY**",1:"SAFETY")
- +7 WRITE !?54,$GET(ADDR(4)),?102,"Isd: ",ISD," Exp: ",EXPDT
- +8 WRITE !,PNM,?54,"*Indicate address change on back of this form",?102,"Last Fill: ",$GET(PSOLASTF)
- +9 WRITE !,$SELECT($DATA(PSMP(1)):PSMP(1),1:$GET(VAPA(1))),?54,"[ ] Permanent",?102,"Pat. Stat ",PATST," Clinic: ",PSCLN
- +10 WRITE !,$SELECT($DATA(PSMP(2)):PSMP(2),$DATA(PSMP(1)):"",1:$GET(ADDR(2))),?54,"[ ] Temporary until ",$SELECT($PIECE($GET(VAPA(10)),"^",2)]"":$PIECE($GET(VAPA(10)),"^",2),1:"__/__/__"),?102,$SELECT($GET(WARN)'="":"DRUG WARNING "_$GET(WARN),1:"")
- +11 WRITE !,$SELECT($DATA(PSMP(3)):PSMP(3),$DATA(PSMP(1)):"",1:$GET(ADDR(3))),!,$SELECT($DATA(PSMP(4)):PSMP(4),$DATA(PSMP(1)):"",1:$GET(ADDR(4))),?54,"Signature",ULN
- +12 IF $GET(PSOBARS)
- SET X="S"
- SET X2=PSOINST_"-"_RX
- SET X1=$X
- WRITE ?102,@PSOBAR1,X2,@PSOBAR0,$CHAR(13)
- SET $X=0
- L13 IF $GET(WARN)'=""
- IF '$GET(PSOBLALL)
- IF '$GET(PSDFNFLG)
- IF '$GET(PSOLAPPL)
- DO WARN^PSOLBL2
- +1 WRITE @IOF
- REP IF COPIES>0
- SET SIDE=1
- GOTO ST
- +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 SET 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
- +4 SET ^PSRX(RX,"L",IR,0)=NOW_"^"_$SELECT($GET(RXP):99-RXPI,1:RXF)_"^"_$SELECT($GET(PCOMX)]"":$GET(PCOMX),$GET(PCOMH(RX))]"":PCOMH(RX),1:"From RX number "_$PIECE(^PSRX(RX,0),"^"))_$SELECT(...
- ... $GET(RXP):" (Partial)",1:"")_$SELECT($DATA(REPRINT):" (Reprint)",1:"")_"^"_PDUZ
- +5 NEW PSOBADR,PSOTEMP
- +6 SET PSOBADR=$$CHKRX^PSOBAI(RX)
- +7 IF $GET(PSOBADR)
- SET PSOTEMP=$PIECE(PSOBADR,"^",2)
- SET PSOBADR=$PIECE(PSOBADR,"^")
- +8 IF $GET(PSOBADR)
- IF '$GET(PSOTEMP)
- Begin DoDot:1
- +9 SET IR=IR+1
- SET ^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
- +10 SET ^PSRX(RX,"L",IR,0)=NOW_"^"_$SELECT($GET(RXP):99-RXPI,1:RXF)_"^"_"ROUTING="_$GET(MW)_" (BAD ADDRESS)"_"^"_PDUZ
- End DoDot:1
- +11 SET ^PSRX(RX,"TYPE")=0
- KILL RXF,IR,FDA,NOW,I,PCOMH(RX)
- +12 IF $GET(WARN)'=""
- IF $GET(PSDFNFLG)!($GET(PSOLAPPL))
- DO ALLWARN^PSOLBLN1
- +13 IF $GET(WARN)=""
- IF $GET(PSDFNFLG)!($GET(PSOLAPPL))
- DO ALL^PSOLBLS
- +14 IF $GET(PSOBLALL)
- IF $GET(WARN)=""
- DO ALL^PSOLBLS
- IF $GET(WARN)'=""
- DO ALLWARN^PSOLBLN1
- +15 IF '$DATA(PSSPND)
- IF $PIECE(PSOPAR,"^",18)
- IF $GET(PSDFNFLG)!($GET(PSOLAPPL))!($GET(PSOBLALL))
- DO CHCK2^PSOTRLBL
- +16 IF $GET(PSOBLALL)
- DO TRAIL^PSOLBL2
- END ;
- +1 IF $DATA(RXFLX(RX))
- SET RXFL(RX)=$GET(RXFLX(RX))
- KILL RXFLX
- +2 DO KILL^PSOLBL2
- QUIT
