PSODRDU2 ;BHAM ISC/SAB - dup drug/class display for outpatient orders ;9/23/97 8:40am
;;7.0;OUTPATIENT PHARMACY;**132**;DEC 1997
;External reference ^PS(50.7 - 2223
;External reference ^PS(50.606 - 2174
;External reference ^PSDRUG( - 221
;External reference to ^PS(55 - 2228
EN(DFN,RXNUM) ;dfn=patient's ifn, rxnum=internal order # for rx, pending or non-va med
D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN) Q:RXNUM=""
S $P(PSONULN,"-",79)="-"
K INST,SD,IFN S FL=$P(RXNUM,";"),IFN=+FL G:RXNUM["P" PEN G:RXNUM["N" NVA
Q:'$D(^PSRX(IFN,0))
S RX0=^PSRX(IFN,0),RX2=^(2),RX3=^(3),STA=+$G(^("STA")),TRM=0,LSTFD=$P(RX2,"^",2),DNM=$P(^PSDRUG($P(RX0,"^",6),0),"^")
W !,PSONULN S RXREC=IFN
S DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),RX0=DUPRX0,RX2=^PSRX(RXREC,2),$P(RX0,"^",15)=+$G(^PSRX(RXREC,"STA"))
W !,$J("Rx #: ",24)_$P(RX0,"^"),?39,DNM
W !,$J("Status: ",24) S J=RXREC D STAT^PSOFUNC W ST K RX0,RX2 W ?40,$J("Issued: ",24),$E(ISSD,4,5)_"/"_$E(ISSD,6,7)_"/"_$E(ISSD,2,3)
K FSIG,BSIG I $P($G(^PSRX(RXREC,"SIG")),"^",2) D FSIG^PSOUTLA("R",RXREC,54) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV)
K FSIG,PSREV I '$P($G(^PSRX(RXREC,"SIG")),"^",2) D EN2^PSOUTLA1(RXREC,54)
W !,$J("SIG: ",24) W $G(BSIG(1))
I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV W !?24,$G(BSIG(PSREV))
K BSIG,PSREV
W !,$J("QTY: ",24)_$P(DUPRX0,"^",7),?40,$J("# of refills: ",24)_RFLS S PHYS=$S($D(^VA(200,+$P(DUPRX0,"^",4),0)):$P(^(0),"^"),1:"UNKNOWN")
W !,$J("Provider: ",24)_PHYS,?40,$J("Refills remaining: ",24),RFLS-$S($D(^PSRX(RXREC,1,0)):$P(^(0),"^",4),1:0)
S LSTFL=+^PSRX(RXREC,3) W !?40,$J("Last filled on: ",24)_$E(LSTFL,4,5)_"/"_$E(LSTFL,6,7)_"/"_$E(LSTFL,2,3),!?40,$J("Days Supply: ",24)_$P(DUPRX0,"^",8)
W !,PSONULN,!
K DNM,RX3,LSTFL,PSONULN,ISSD,J,LSTFD,PHYS,ST,STA,TRM,DUPRX0,FL,FSIG,I,IFN,RFLS,RXREC,X,Y Q
;
PEN Q:'$D(^PS(52.41,IFN,0))
W !,PSONULN,! S RXREC=IFN
S DUPRX0=^PS(52.41,RXREC,0),RFLS=$P(DUPRX0,"^",11),ISSD=$P(DUPRX0,"^",6)
W !,"Pending Order: "_$P(DUPRX0,"^"),!,"Orderable Item: "_$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
W !,"Drug: "_$S($P(DUPRX0,"^",9):$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"),1:"No Dispense Drug Selected")
W !,"Provider Comments: " S TY=2 D INST
D FSIG^PSOUTLA("P",RXREC,IOM-6)
W !,"SIG: " F I=0:0 S I=$O(FSIG(I)) Q:'I W FSIG(I),!?5
W !,"Routing: "_$S($P(DUPRX0,"^",17)="W":"WINDOW",1:"MAIL"),?30,"Quantity: "_$P(DUPRX0,"^",10),!,"# of Refills: "_$P(DUPRX0,"^",11)
W ?30,"Patient Status: SC",!,"Patient Location: "_$S($P(DUPRX0,"^",13):$P($G(^SC($P(DUPRX0,"^",13),0)),"^"),1:""),!,"Med Route: "_$P($G(^PS(51.2,+$P(DUPRX0,"^",15),0)),"^"),?30,"Provider: "_$P(^VA(200,$P(DUPRX0,"^",5),0),"^")
S Y=$P(DUPRX0,"^",6) X ^DD("DD") W !,"Issue Date: "_Y
W !,"Instructions: " S TY=3 D INST
W !,PSONULN,!
K DNM,RX3,LSTFL,PSONULN,ISSD,J,LSTFD,PHYS,ST,STA,TRM,DUPRX0,FL,FSIG,I,IFN,RFLS,RXREC,X,Y Q
;
INST ;displays instruction and/or comments
S INST=0 F S INST=$O(^PS(52.41,IFN,TY,INST)) Q:'INST S MIG=^PS(52.41,IFN,TY,INST,0) D
.F SG=1:1:$L(MIG," ") W:$X+$L($P(MIG," ",SG)_" ")>IOM @$S(TY=3:"!?14",1:"!?19") W $P(MIG," ",SG)_" "
K INST,TY,MIG,SG
Q
NVA ;displays non-va meds
Q:'$G(^PS(55,DFN,"NVA",IFN,0))
W !,PSONULN S DUPRX0=^PS(55,DFN,"NVA",IFN,0)
W !,"Non-VA Med: "_$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
W !,"Drug: "_$S($P(DUPRX0,"^",2):$P(^PSDRUG($P(DUPRX0,"^",2),0),"^"),1:"No Dispense Drug Selected")
W !,"Status: "_$S($P(DUPRX0,"^",7):"Discontinued ("_$$FMTE^XLFDT($P($P(DUPRX0,"^",7),"."))_")",1:"Active")
W !,"Dosage: "_$P(DUPRX0,"^",3)
W !,"Schedule: "_$P(DUPRX0,"^",5),!,"Route: "_$P(DUPRX0,"^",4)
W !,"Start Date: "_$$FMTE^XLFDT($P(DUPRX0,"^",9)),?40,"CPRS Oder #: "_$P(DUPRX0,"^",8)
W !,"Documented By: "_$P(^VA(200,$P(DUPRX0,"^",11),0),"^")_" on "_$$FMTE^XLFDT($P(DUPRX0,"^",10))
S RMLEN=$S($G(IOM):(IOM-5),1:70)
F I=0:0 S I=$O(^PS(55,DFN,"NVA",IFN,"OCK",I)) Q:'I D I $O(^PS(55,DFN,"NVA",IFN,"OCK",I)) S DIR(0)="E",DIR("A")=" Press Enter to Continue" D ^DIR K DIR
.S ORD=$P(^PS(55,DFN,"NVA",IFN,"OCK",I,0),"^"),ORP=$P(^(0),"^",2)
.W !,"Order Check #"_I_": "
.K OCK,LEN I $L(ORD)>RMLEN S (LEN,IEN)=1 D
..F SG=1:1:$L(ORD) S:$L($G(OCK(IEN))_" "_$P(ORD," ",SG))>RMLEN&($P(ORD," ",SG)]"") IEN=IEN+1 S:$P(ORD," ",SG)'="" OCK(IEN)=$G(OCK(IEN))_" "_$P(ORD," ",SG)
..F II=0:0 S II=$O(OCK(II)) Q:'II W !?5,OCK(II)
.W:'$G(LEN) ORD K LEN,SG,IEN,II,OCK,ORD
.W !,"Overriding Provider: "_$S($G(ORP):$P(^VA(200,ORP,0),"^"),1:"")
.K ORP,OCK,REA W !,"Reason:" F SS=0:0 S SS=$O(^PS(55,DFN,"NVA",IFN,"OCK",I,"OVR",SS)) Q:'SS S REA(SS)=^PS(55,DFN,"NVA",IFN,"OCK",I,"OVR",SS,0)
.S IEN=1 F II=0:0 S II=$O(REA(II)) Q:'II D
..F SG=1:1:$L(REA(II)) S:$L($G(OCK(IEN))_" "_$P(REA(II)," ",SG))>RMLEN&($P(REA(II)," ",SG)]"") IEN=IEN+1 S:$P(REA(II)," ",SG)'="" OCK(IEN)=$G(OCK(IEN))_" "_$P(REA(II)," ",SG)
..K REA,IEN,SG F II=0:0 S II=$O(OCK(II)) Q:'II W OCK(II) I $O(OCK(II)) W !?5
K OCK W !,"Statement/Explanation/Comments:" F SS=0:0 S SS=$O(^PS(55,DFN,"NVA",IFN,"DSC",SS)) Q:'SS S DSC(SS)=^PS(55,DFN,"NVA",IFN,"DSC",SS,0)
S IEN=1 F II=0:0 S II=$O(DSC(II)) Q:'II D
.F SG=1:1:$L(DSC(II)) S:$L($G(OCK(IEN))_" "_$P(DSC(II)," ",SG))>RMLEN&($P(DSC(II)," ",SG)]"") IEN=IEN+1 S:$P(DSC(II)," ",SG)'="" OCK(IEN)=$G(OCK(IEN))_" "_$P(DSC(II)," ",SG)
K IEN,DSC,SG F II=0:0 S II=$O(OCK(II)) Q:'II W !?5,OCK(II)
W !,PSONULN,!
K RMLEN
PSODRDU2 ;BHAM ISC/SAB - dup drug/class display for outpatient orders ;9/23/97 8:40am
+1 ;;7.0;OUTPATIENT PHARMACY;**132**;DEC 1997
+2 ;External reference ^PS(50.7 - 2223
+3 ;External reference ^PS(50.606 - 2174
+4 ;External reference ^PSDRUG( - 221
+5 ;External reference to ^PS(55 - 2228
EN(DFN,RXNUM) ;dfn=patient's ifn, rxnum=internal order # for rx, pending or non-va med
+1 IF $PIECE($GET(^PS(55,DFN,0)),"^",6)'=2
DO EN^PSOHLUP(DFN)
IF RXNUM=""
QUIT
+2 SET $PIECE(PSONULN,"-",79)="-"
+3 KILL INST,SD,IFN
SET FL=$PIECE(RXNUM,";")
SET IFN=+FL
IF RXNUM["P"
GOTO PEN
IF RXNUM["N"
GOTO NVA
+4 IF '$DATA(^PSRX(IFN,0))
QUIT
+5 SET RX0=^PSRX(IFN,0)
SET RX2=^(2)
SET RX3=^(3)
SET STA=+$GET(^("STA"))
SET TRM=0
SET LSTFD=$PIECE(RX2,"^",2)
SET DNM=$PIECE(^PSDRUG($PIECE(RX0,"^",6),0),"^")
+6 WRITE !,PSONULN
SET RXREC=IFN
+7 SET DUPRX0=^PSRX(RXREC,0)
SET RFLS=$PIECE(DUPRX0,"^",9)
SET ISSD=$PIECE(^PSRX(RXREC,0),"^",13)
SET RX0=DUPRX0
SET RX2=^PSRX(RXREC,2)
SET $PIECE(RX0,"^",15)=+$GET(^PSRX(RXREC,"STA"))
+8 WRITE !,$JUSTIFY("Rx #: ",24)_$PIECE(RX0,"^"),?39,DNM
+9 WRITE !,$JUSTIFY("Status: ",24)
SET J=RXREC
DO STAT^PSOFUNC
WRITE ST
KILL RX0,RX2
WRITE ?40,$JUSTIFY("Issued: ",24),$EXTRACT(ISSD,4,5)_"/"_$EXTRACT(ISSD,6,7)_"/"_$EXTRACT(ISSD,2,3)
+10 KILL FSIG,BSIG
IF $PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
DO FSIG^PSOUTLA("R",RXREC,54)
FOR PSREV=1:1
IF '$DATA(FSIG(PSREV))
QUIT
SET BSIG(PSREV)=FSIG(PSREV)
+11 KILL FSIG,PSREV
IF '$PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
DO EN2^PSOUTLA1(RXREC,54)
+12 WRITE !,$JUSTIFY("SIG: ",24)
WRITE $GET(BSIG(1))
+13 IF $ORDER(BSIG(1))
FOR PSREV=1:0
SET PSREV=$ORDER(BSIG(PSREV))
IF 'PSREV
QUIT
WRITE !?24,$GET(BSIG(PSREV))
+14 KILL BSIG,PSREV
+15 WRITE !,$JUSTIFY("QTY: ",24)_$PIECE(DUPRX0,"^",7),?40,$JUSTIFY("# of refills: ",24)_RFLS
SET PHYS=$SELECT($DATA(^VA(200,+$PIECE(DUPRX0,"^",4),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+16 WRITE !,$JUSTIFY("Provider: ",24)_PHYS,?40,$JUSTIFY("Refills remaining: ",24),RFLS-$SELECT($DATA(^PSRX(RXREC,1,0)):$PIECE(^(0),"^",4),1:0)
+17 SET LSTFL=+^PSRX(RXREC,3)
WRITE !?40,$JUSTIFY("Last filled on: ",24)_$EXTRACT(LSTFL,4,5)_"/"_$EXTRACT(LSTFL,6,7)_"/"_$EXTRACT(LSTFL,2,3),!?40,$JUSTIFY("Days Supply: ",24)_$PIECE(DUPRX0,"^",8)
+18 WRITE !,PSONULN,!
+19 KILL DNM,RX3,LSTFL,PSONULN,ISSD,J,LSTFD,PHYS,ST,STA,TRM,DUPRX0,FL,FSIG,I,IFN,RFLS,RXREC,X,Y
QUIT
+20 ;
PEN IF '$DATA(^PS(52.41,IFN,0))
QUIT
+1 WRITE !,PSONULN,!
SET RXREC=IFN
+2 SET DUPRX0=^PS(52.41,RXREC,0)
SET RFLS=$PIECE(DUPRX0,"^",11)
SET ISSD=$PIECE(DUPRX0,"^",6)
+3 WRITE !,"Pending Order: "_$PIECE(DUPRX0,"^"),!,"Orderable Item: "_$PIECE(^PS(50.7,$PIECE(DUPRX0,"^",8),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
+4 WRITE !,"Drug: "_$SELECT($PIECE(DUPRX0,"^",9):$PIECE(^PSDRUG($PIECE(DUPRX0,"^",9),0),"^"),1:"No Dispense Drug Selected")
+5 WRITE !,"Provider Comments: "
SET TY=2
DO INST
+6 DO FSIG^PSOUTLA("P",RXREC,IOM-6)
+7 WRITE !,"SIG: "
FOR I=0:0
SET I=$ORDER(FSIG(I))
IF 'I
QUIT
WRITE FSIG(I),!?5
+8 WRITE !,"Routing: "_$SELECT($PIECE(DUPRX0,"^",17)="W":"WINDOW",1:"MAIL"),?30,"Quantity: "_$PIECE(DUPRX0,"^",10),!,"# of Refills: "_$PIECE(DUPRX0,"^",11)
+9 WRITE ?30,"Patient Status: SC",!,"Patient Location: "_$SELECT($PIECE(DUPRX0,"^",13):$PIECE($GET(^SC($PIECE(DUPRX0,"^",13),0)),"^"),1:""),!,"Med Route: "_$PIECE(...
... $GET(^PS(51.2,+$PIECE(DUPRX0,"^",15),0)),"^"),?30,"Provider: "_$PIECE(^VA(200,$PIECE(DUPRX0,"^",5),0),"^")
+10 SET Y=$PIECE(DUPRX0,"^",6)
XECUTE ^DD("DD")
WRITE !,"Issue Date: "_Y
+11 WRITE !,"Instructions: "
SET TY=3
DO INST
+12 WRITE !,PSONULN,!
+13 KILL DNM,RX3,LSTFL,PSONULN,ISSD,J,LSTFD,PHYS,ST,STA,TRM,DUPRX0,FL,FSIG,I,IFN,RFLS,RXREC,X,Y
QUIT
+14 ;
INST ;displays instruction and/or comments
+1 SET INST=0
FOR
SET INST=$ORDER(^PS(52.41,IFN,TY,INST))
IF 'INST
QUIT
SET MIG=^PS(52.41,IFN,TY,INST,0)
Begin DoDot:1
+2 FOR SG=1:1:$LENGTH(MIG," ")
IF $X+$LENGTH($PIECE(MIG," ",SG)_" ")>IOM
WRITE @$SELECT(TY=3:"!?14",1:"!?19")
WRITE $PIECE(MIG," ",SG)_" "
End DoDot:1
+3 KILL INST,TY,MIG,SG
+4 QUIT
NVA ;displays non-va meds
+1 IF '$GET(^PS(55,DFN,"NVA",IFN,0))
QUIT
+2 WRITE !,PSONULN
SET DUPRX0=^PS(55,DFN,"NVA",IFN,0)
+3 WRITE !,"Non-VA Med: "_$PIECE(^PS(50.7,$PIECE(DUPRX0,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
+4 WRITE !,"Drug: "_$SELECT($PIECE(DUPRX0,"^",2):$PIECE(^PSDRUG($PIECE(DUPRX0,"^",2),0),"^"),1:"No Dispense Drug Selected")
+5 WRITE !,"Status: "_$SELECT($PIECE(DUPRX0,"^",7):"Discontinued ("_$$FMTE^XLFDT($PIECE($PIECE(DUPRX0,"^",7),"."))_")",1:"Active")
+6 WRITE !,"Dosage: "_$PIECE(DUPRX0,"^",3)
+7 WRITE !,"Schedule: "_$PIECE(DUPRX0,"^",5),!,"Route: "_$PIECE(DUPRX0,"^",4)
+8 WRITE !,"Start Date: "_$$FMTE^XLFDT($PIECE(DUPRX0,"^",9)),?40,"CPRS Oder #: "_$PIECE(DUPRX0,"^",8)
+9 WRITE !,"Documented By: "_$PIECE(^VA(200,$PIECE(DUPRX0,"^",11),0),"^")_" on "_$$FMTE^XLFDT($PIECE(DUPRX0,"^",10))
+10 SET RMLEN=$SELECT($GET(IOM):(IOM-5),1:70)
+11 FOR I=0:0
SET I=$ORDER(^PS(55,DFN,"NVA",IFN,"OCK",I))
IF 'I
QUIT
Begin DoDot:1
+12 SET ORD=$PIECE(^PS(55,DFN,"NVA",IFN,"OCK",I,0),"^")
SET ORP=$PIECE(^(0),"^",2)
+13 WRITE !,"Order Check #"_I_": "
+14 KILL OCK,LEN
IF $LENGTH(ORD)>RMLEN
SET (LEN,IEN)=1
Begin DoDot:2
+15 FOR SG=1:1:$LENGTH(ORD)
IF $LENGTH($GET(OCK(IEN))_" "_$PIECE(ORD," ",SG))>RMLEN&($PIECE(ORD," ",SG)]"")
SET IEN=IEN+1
IF $PIECE(ORD," ",SG)'=""
SET OCK(IEN)=$GET(OCK(IEN))_" "_$PIECE(ORD," ",SG)
+16 FOR II=0:0
SET II=$ORDER(OCK(II))
IF 'II
QUIT
WRITE !?5,OCK(II)
End DoDot:2
+17 IF '$GET(LEN)
WRITE ORD
KILL LEN,SG,IEN,II,OCK,ORD
+18 WRITE !,"Overriding Provider: "_$SELECT($GET(ORP):$PIECE(^VA(200,ORP,0),"^"),1:"")
+19 KILL ORP,OCK,REA
WRITE !,"Reason:"
FOR SS=0:0
SET SS=$ORDER(^PS(55,DFN,"NVA",IFN,"OCK",I,"OVR",SS))
IF 'SS
QUIT
SET REA(SS)=^PS(55,DFN,"NVA",IFN,"OCK",I,"OVR",SS,0)
+20 SET IEN=1
FOR II=0:0
SET II=$ORDER(REA(II))
IF 'II
QUIT
Begin DoDot:2
+21 FOR SG=1:1:$LENGTH(REA(II))
IF $LENGTH($GET(OCK(IEN))_" "_$PIECE(REA(II)," ",SG))>RMLEN&($PIECE(REA(II)," ",SG)]"")
SET IEN=IEN+1
IF $PIECE(REA(II)," ",SG)'=""
SET OCK(IEN)=$GET(OCK(IEN))_" "_$PIECE(REA(II)," ",SG)
+22 KILL REA,IEN,SG
FOR II=0:0
SET II=$ORDER(OCK(II))
IF 'II
QUIT
WRITE OCK(II)
IF $ORDER(OCK(II))
WRITE !?5
End DoDot:2
End DoDot:1
IF $ORDER(^PS(55,DFN,"NVA",IFN,"OCK",I))
SET DIR(0)="E"
SET DIR("A")=" Press Enter to Continue"
DO ^DIR
KILL DIR
+23 KILL OCK
WRITE !,"Statement/Explanation/Comments:"
FOR SS=0:0
SET SS=$ORDER(^PS(55,DFN,"NVA",IFN,"DSC",SS))
IF 'SS
QUIT
SET DSC(SS)=^PS(55,DFN,"NVA",IFN,"DSC",SS,0)
+24 SET IEN=1
FOR II=0:0
SET II=$ORDER(DSC(II))
IF 'II
QUIT
Begin DoDot:1
+25 FOR SG=1:1:$LENGTH(DSC(II))
IF $LENGTH($GET(OCK(IEN))_" "_$PIECE(DSC(II)," ",SG))>RMLEN&($PIECE(DSC(II)," ",SG)]"")
SET IEN=IEN+1
IF $PIECE(DSC(II)," ",SG)'=""
SET OCK(IEN)=$GET(OCK(IEN))_" "_$PIECE(DSC(II)," ",SG)
End DoDot:1
+26 KILL IEN,DSC,SG
FOR II=0:0
SET II=$ORDER(OCK(II))
IF 'II
QUIT
WRITE !?5,OCK(II)
+27 WRITE !,PSONULN,!
+28 KILL RMLEN
