PSOARX ;B'ham ISC/SAB - display archived rxs ;03/10/94 1:08 pm
;;7.0;OUTPATIENT PHARMACY;**10,148**;DEC 1997
GET S RX=^PSRX(DA,0),J=DA,RX2=$G(^PSRX(DA,2)),R3=$G(^(3)),RTN=$G(^("TN")) S DFN=+$P(RX,"^",2) S ANS="",FFX=0
S PSDIV=$S($D(^PS(59,+$P(RX2,"^",9),0)):$P(^(0),"^",1)_" ("_$P(^(0),"^",6)_")",1:"Unknown"),PSDIV=$E(PSDIV,1,28)
S PSEXDT=$P(RX2,"^",6),PSEXDT=$S(PSEXDT]"":$E(PSEXDT,4,5)_"/"_$E(PSEXDT,6,7)_"/"_$E(PSEXDT,2,3),1:"Unknown")
PR D STAT
W !!,"Rx: "_$P(RX,"^")
S MED=+$P(RX,"^",6),M1="" S:$D(^PSDRUG(MED,0)) M1=^(0) W ?20,$S($P(M1,"^",3)["S":" Item: ",1:" Drug: "),$P(M1,"^",1),?65,$S(RTN'="":"Trade Name: "_RTN,1:"")
W ?96,"QTY: ",$P(RX,"^",7)," ",$S($P(RX,"^",8)?1N.N:$P(RX,"^",8),1:"??")," Day Supply"
W !?7,"SIG: "
I '$P(^PSRX(DA,"SIG"),"^",2) S (SIG,X)=$P($G(^PSRX(DA,"SIG")),"^") D SIGONE^PSOHELP W SIG G RFL
F I=0:0 S I=$O(^PSRX(DA,"SIG1",I)) Q:'I W $P(^PSRX(DA,"SIG1",I,0),"^") W:$O(^PSRX(DA,"SIG1",I)) !?12
RFL S II=J D LAST^PSORFL W !?4,"Latest: "_RFL,?37,"# of Refills: "_$P(RX,"^",9)
S RFM=$P(RX,"^",9),PL=0 I $O(^PSRX(DA,1,0)) F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I S RFM=RFM-1,PL=PL+1
W " Remaining: "_RFM
S PHYS=$S($D(^VA(200,+$P(RX,"^",4),0)):$P(^(0),"^"),1:"Unknown") W ?70,"Provider: "_PHYS
DTT S DTT=$P(RX,"^",13) D DAT W !?4,"Issued: "_DAT,?43,"Clinic: "_$S($D(^SC(+$P(RX,"^",5),0)):$P(^(0),"^",1),1:"Not on File"),?71,"Division: "_PSDIV
S DTT=$P(RX2,"^",1)\1 D DAT W !?4,"Logged: "_DAT,?42,"Routing: " S X=$F("MWI",$P(RX,"^",11))-1 W:X $P("Mail^Window^Inpatient","^",X),?69,"Clerk Code: "_$S($D(^VA(200,+$P(RX,"^",16),0)):$P(^(0),"^"),1:"Unknown")
W !?3,"Expires: "_PSEXDT
W ?46,"Cap: "_$P("Non-^","^",$S($D(^PS(55,DFN,0)):+$P(^(0),"^",2),1:0)),"Safety",?73,"Status: "_ST I ($D(PS)#2),PS="DISCONTINUE",ST["DISCONTINUE" S PS="Reinstate"
G:$D(PSOZVER) REM S DTT=$P(RX2,"^",2) D DAT W !?4,"Filled: "_DAT,?24,"Pharmacist: "_$S($D(^VA(200,+$P(RX2,"^",3),0)):$P(^(0),"^",1),1:""),?56,"Verifying Pharmacist: "_$S($D(^VA(200,+$P(RX2,"^",10),0)):$P(^(0),"^",1),1:"")
W ?75,"Lot #: "_$P(RX2,"^",4),?85," QTY: "_$P(RX,"^",7)
REM W !?2,$S($P(RX2,"^",15):"Returned to Stock: "_$E($P(RX2,"^",15),4,5)_"/"_$E($P(RX2,"^",15),6,7)_"/"_$E($P(RX2,"^",15),2,3),1:"Released: "_$S($P(RX2,"^",13):$E($P(RX2,"^",13),4,5)_"/"_$E($P(RX2,"^",13),6,7)_"/"_$E($P(RX2,"^",13),2,3),1:""))
W !?3,"Remarks: "_$P(R3,"^",7)
S PSOZ=0 D HEAD:PL F N=0:0 S N=$O(^PSRX(DA,1,N)) Q:'N S P1=^(N,0) D N G Q:ANS'=""
ACT G Q:'$O(^PSRX(DA,"A",0)) G Q:ANS="^" D H1 F N=0:0 D LP1 Q:PSOZ
I $O(^PSRX(DA,4,0)) D CMOP^PSOARCTG
G Q
A1 D H1:FFX,DAT1 W !,N1,?3,DAT1,?14 S X=$P(P1,U,2),X=$F("HUCELPRWSIVDABXGKNM",X)-1
W:X $P("Hold^Unhold^DC'd^Edit^Renewed^Partial^Reinstate^Reprint^Suspense^Returned Stock^Intervention^Deleted^Drug Interaction^Processed^X-Interface^Patient Inst.^PKI/DEA^Dispense Completed^ECME^","^",X) W ?25
S X=$P(P1,U,4) W:X]"" $S(X>0&(X<6):"Refill "_X,X=6:"Partial",X>6:"Refill "_(X-1),1:"Original"),?35,$S($D(^VA(200,+$P(P1,"^",3),0)):$P(^(0),"^",1),1:"Unknown")
G:PSOZ A2 W ?60,N2,?63,DAT2,?74 S X=$P(P2,U,2),X=$F("HUCELPRWSIVDABXGKNM",X)-1
W:X $P("Hold^Unhold^DC'd^Edit^Renewed^Partial^Reinstate^Reprint^Suspense^Returned Stock^Intervention^Deleted^Drug Interaction^Processed^X-Interface^Patient Inst.^PKI/DEA^Dispense Completed^ECME^","^",X) W ?85
S X=$P(P2,U,4) W:X]"" $S(X>0&(X<6):"Refill "_X,X=6:"Partial",X>6:"Refill "_(X-1),1:"Original"),?95,$S($D(^VA(200,+$P(P1,"^",3),0)):$P(^(0),"^",1),1:"Unknown")
A2 W:($P(P1,U,5)]"")!(('PSOZ)&($P(P2,U,5)]"")) ! W:$P(P1,U,5)]"" ?5,"Comment: "_$E($P(P1,U,5),1,45) Q:PSOZ W:$P(P2,U,5)]"" ?65,"Comment: "_$E($P(P2,U,5),1,45)
I ($L($P(P1,U,5))>45)!($L($P(P2,U,5))>45) W ! W:$L($P(P1,U,5))>45 ?14,$E($P(P1,U,5),46,75) W:('PSOZ)&($L($P(P2,U,5))>45) ?79,$E($P(P2,U,5),46,75)
Q
N S (DTT1,DTT2)="" Q:ANS="^" D HEAD:FFX W !,N,?3 S DTT1=$P(P1,"^",8)\1,DTT2=$P(P1,U,1) D DAT1 W DAT1,?14,DAT2,?27,$P(P1,"^",4),?32
S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^"),1:"Unknown")
S X=$P(P1,"^",2),X=$F("MWIBD",X)-1 W:X $P("Mail^Window^Inpatient","^",X),?40,$P(P1,"^",6),?52,$E($S($D(^VA(200,+$P(P1,"^",5),0)):$P(^(0),"^",1),1:""),1,16),?70,PSDIV
W !?4,$S($P(P1,"^",16):"Returned to Stock: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:"Released: "_$S($P(P1,"^",18):$E($P(P1,"^",18),4,5)_"/"_$E($P(P1,"^",18),6,7)_"/"_$E($P(P1,"^",18),2,3),1:""))
I $P($G(^PSRX(DA,1,N,"IB")),"^")]"" W " Copay Billing #: "_$P($G(^PSRX(DA,1,N,"IB")),"^")
W !?5,"Remarks: "_$P(P1,"^",3) Q
Q K ANS,PSDIV,PSEXDT,MED,M1,FFX,DTT,DAT,RX,RX2,R3,RTN,SIG,STA,P1,PL,P0,Z0,Z1,EXDT,DAT1,DAT2,DTT1,DTT2,I,N,N1,N2,P2,PSOAC,PSOZ,RFM
Q
LP1 S PSOZ=0,(N,N1)=$O(^PSRX(DA,"A",N)) S:'N PSOZ=1 Q:PSOZ S P1=^(N1,0),DTT1=P1\1,(N,N2)=$O(^PSRX(DA,"A",N)) S:'N PSOZ=1 S (P2,DTT2)=""
I 'PSOZ S P2=^PSRX(DA,"A",N2,0),DTT2=P2\1
D A1
Q
HEAD D:$Y>(PSOACPL-20) HD1^PSOARCSV
W !,"#",?3,"Log Date",?14,"Refill Date",?27,"QTY",?32,"Routing",?40,"Lot #",?52,"Pharmacist",?70,"Division",! F I=1:1:79 W "="
S FFX=0 Q
H1 ;
W !!,"Activity Log:",!,"#",?3,"Date",?14,"Reason",?25,"Rx Ref",?35,"Security",?60,"#",?63,"Date",?74,"Reason",?85,"Rx Ref",?95,"Security",! F I=1:1:55 W "="
W ?60 F I=1:1:60 W "="
Q
DAT ;
S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3)
Q
DAT1 S (DAT1,DAT2)="",DTT1=DTT1\1,DTT2=DTT2\1 S:DTT1?7N DAT1=$E(DTT1,4,5)_"/"_$E(DTT1,6,7)_"/"_$E(DTT1,2,3) S:(DTT2?7N)&('PSOZ) DAT2=$E(DTT2,4,5)_"/"_$E(DTT2,6,7)_"/"_$E(DTT2,2,3)
Q
STAT ;gets status of rx
S ST0=$P(^PSRX(DA,"STA"),"^") I ST0<12,$O(^PS(52.5,"B",J,0)),$D(^PS(52.5,+$O(^(0)),0)),'$G(^("P")) S ST0=5
I ST0<12,$P(RX2,"^",6)<DT S ST0=11
S ST=$P("Error^Active^Non-Verified^Refill^Hold^Non-Verified^Suspended^^^^^Done^Expired^Discontinued^Deleted^Discontinued^Discontinued (Edit)^Provider Hold^","^",ST0+2)
Q
PSOARX ;B'ham ISC/SAB - display archived rxs ;03/10/94 1:08 pm
+1 ;;7.0;OUTPATIENT PHARMACY;**10,148**;DEC 1997
GET SET RX=^PSRX(DA,0)
SET J=DA
SET RX2=$GET(^PSRX(DA,2))
SET R3=$GET(^(3))
SET RTN=$GET(^("TN"))
SET DFN=+$PIECE(RX,"^",2)
SET ANS=""
SET FFX=0
+1 SET PSDIV=$SELECT($DATA(^PS(59,+$PIECE(RX2,"^",9),0)):$PIECE(^(0),"^",1)_" ("_$PIECE(^(0),"^",6)_")",1:"Unknown")
SET PSDIV=$EXTRACT(PSDIV,1,28)
+2 SET PSEXDT=$PIECE(RX2,"^",6)
SET PSEXDT=$SELECT(PSEXDT]"":$EXTRACT(PSEXDT,4,5)_"/"_$EXTRACT(PSEXDT,6,7)_"/"_$EXTRACT(PSEXDT,2,3),1:"Unknown")
PR DO STAT
+1 WRITE !!,"Rx: "_$PIECE(RX,"^")
+2 SET MED=+$PIECE(RX,"^",6)
SET M1=""
IF $DATA(^PSDRUG(MED,0))
SET M1=^(0)
WRITE ?20,$SELECT($PIECE(M1,"^",3)["S":" Item: ",1:" Drug: "),$PIECE(M1,"^",1),?65,$SELECT(RTN'="":"Trade Name: "_RTN,1:"")
+3 WRITE ?96,"QTY: ",$PIECE(RX,"^",7)," ",$SELECT($PIECE(RX,"^",8)?1N.N:$PIECE(RX,"^",8),1:"??")," Day Supply"
+4 WRITE !?7,"SIG: "
+5 IF '$PIECE(^PSRX(DA,"SIG"),"^",2)
SET (SIG,X)=$PIECE($GET(^PSRX(DA,"SIG")),"^")
DO SIGONE^PSOHELP
WRITE SIG
GOTO RFL
+6 FOR I=0:0
SET I=$ORDER(^PSRX(DA,"SIG1",I))
IF 'I
QUIT
WRITE $PIECE(^PSRX(DA,"SIG1",I,0),"^")
IF $ORDER(^PSRX(DA,"SIG1",I))
WRITE !?12
RFL SET II=J
DO LAST^PSORFL
WRITE !?4,"Latest: "_RFL,?37,"# of Refills: "_$PIECE(RX,"^",9)
+1 SET RFM=$PIECE(RX,"^",9)
SET PL=0
IF $ORDER(^PSRX(DA,1,0))
FOR I=0:0
SET I=$ORDER(^PSRX(DA,1,I))
IF 'I
QUIT
SET RFM=RFM-1
SET PL=PL+1
+2 WRITE " Remaining: "_RFM
+3 SET PHYS=$SELECT($DATA(^VA(200,+$PIECE(RX,"^",4),0)):$PIECE(^(0),"^"),1:"Unknown")
WRITE ?70,"Provider: "_PHYS
DTT SET DTT=$PIECE(RX,"^",13)
DO DAT
WRITE !?4,"Issued: "_DAT,?43,"Clinic: "_$SELECT($DATA(^SC(+$PIECE(RX,"^",5),0)):$PIECE(^(0),"^",1),1:"Not on File"),?71,"Division: "_PSDIV
+1 SET DTT=$PIECE(RX2,"^",1)\1
DO DAT
WRITE !?4,"Logged: "_DAT,?42,"Routing: "
SET X=$FIND("MWI",$PIECE(RX,"^",11))-1
IF X
WRITE $PIECE("Mail^Window^Inpatient","^",X),?69,"Clerk Code: "_$SELECT($DATA(^VA(200,+$PIECE(RX,"^",16),0)):$PIECE(^(0),"^"),1:"Unknown")
+2 WRITE !?3,"Expires: "_PSEXDT
+3 WRITE ?46,"Cap: "_$PIECE("Non-^","^",$SELECT($DATA(^PS(55,DFN,0)):+$PIECE(^(0),"^",2),1:0)),"Safety",?73,"Status: "_ST
IF ($DATA(PS)#2)
IF PS="DISCONTINUE"
IF ST["DISCONTINUE"
SET PS="Reinstate"
+4 IF $DATA(PSOZVER)
GOTO REM
SET DTT=$PIECE(RX2,"^",2)
DO DAT
WRITE !?4,"Filled: "_DAT,?24,"Pharmacist: "_$SELECT($DATA(^VA(200,+$PIECE(RX2,"^",3),0)):$PIECE(^(0),"^",1),1:""),?56,"Verifying Pharmacist: "_$SELECT($DATA(^VA(200,+$PIECE(RX2,"^",10),0)):$PIECE(^(0),"^",1),1:"")
+5 WRITE ?75,"Lot #: "_$PIECE(RX2,"^",4),?85," QTY: "_$PIECE(RX,"^",7)
REM WRITE !?2,$SELECT($PIECE(RX2,"^",15):"Returned to Stock: "_...
WRITE $EXTRACT($PIECE(RX2,"^",15),4,5)_"/"_$EXTRACT($PIECE(RX2,"^",15),6,7)_"/"_$EXTRACT($PIECE(RX2,"^",15),2,3),1:"Released: "_$SELECT($PIECE(RX2,"^",13):$EXTRACT($PIECE(RX2,"^",13),4,5)_"/"_$EXTRACT(...
... $PIECE(RX2,"^",13),6,7)_"/"_$EXTRACT($PIECE(RX2,"^",13),2,3),1:""))
+1 WRITE !?3,"Remarks: "_$PIECE(R3,"^",7)
+2 SET PSOZ=0
IF PL
DO HEAD
FOR N=0:0
SET N=$ORDER(^PSRX(DA,1,N))
IF 'N
QUIT
SET P1=^(N,0)
DO N
IF ANS'=""
GOTO Q
ACT IF '$ORDER(^PSRX(DA,"A",0))
GOTO Q
IF ANS="^"
GOTO Q
DO H1
FOR N=0:0
DO LP1
IF PSOZ
QUIT
+1 IF $ORDER(^PSRX(DA,4,0))
DO CMOP^PSOARCTG
+2 GOTO Q
A1 IF FFX
DO H1
DO DAT1
WRITE !,N1,?3,DAT1,?14
SET X=$PIECE(P1,U,2)
SET X=$FIND("HUCELPRWSIVDABXGKNM",X)-1
+1 IF X
WRITE $PIECE("Hold^Unhold^DC'd^Edit^Renewed^Partial^Reinstate^Reprint^Suspense^Returned Stock^Intervention^Deleted^Drug Interaction^Processed^X-Interface^Patient Inst.^PKI/DEA^Dispense Completed^ECME^","^",X)
WRITE ?25
+2 SET X=$PIECE(P1,U,4)
IF X]""
WRITE $SELECT(X>0&(X<6):"Refill "_X,X=6:"Partial",X>6:"Refill "_(X-1),1:"Original"),?35,$SELECT($DATA(^VA(200,+$PIECE(P1,"^",3),0)):$PIECE(^(0),"^",1),1:"Unknown")
+3 IF PSOZ
GOTO A2
WRITE ?60,N2,?63,DAT2,?74
SET X=$PIECE(P2,U,2)
SET X=$FIND("HUCELPRWSIVDABXGKNM",X)-1
+4 IF X
WRITE $PIECE("Hold^Unhold^DC'd^Edit^Renewed^Partial^Reinstate^Reprint^Suspense^Returned Stock^Intervention^Deleted^Drug Interaction^Processed^X-Interface^Patient Inst.^PKI/DEA^Dispense Completed^ECME^","^",X)
WRITE ?85
+5 SET X=$PIECE(P2,U,4)
IF X]""
WRITE $SELECT(X>0&(X<6):"Refill "_X,X=6:"Partial",X>6:"Refill "_(X-1),1:"Original"),?95,$SELECT($DATA(^VA(200,+$PIECE(P1,"^",3),0)):$PIECE(^(0),"^",1),1:"Unknown")
A2 IF ($PIECE(P1,U,5)]"")!(('PSOZ)&($PIECE(P2,U,5)]""))
WRITE !
IF $PIECE(P1,U,5)]""
WRITE ?5,"Comment: "_$EXTRACT($PIECE(P1,U,5),1,45)
IF PSOZ
QUIT
IF $PIECE(P2,U,5)]""
WRITE ?65,"Comment: "_$EXTRACT($PIECE(P2,U,5),1,45)
+1 IF ($LENGTH($PIECE(P1,U,5))>45)!($LENGTH($PIECE(P2,U,5))>45)
WRITE !
IF $LENGTH($PIECE(P1,U,5))>45
WRITE ?14,$EXTRACT($PIECE(P1,U,5),46,75)
IF ('PSOZ)&($LENGTH($PIECE(P2,U,5))>45)
WRITE ?79,$EXTRACT($PIECE(P2,U,5),46,75)
+2 QUIT
N SET (DTT1,DTT2)=""
IF ANS="^"
QUIT
IF FFX
DO HEAD
WRITE !,N,?3
SET DTT1=$PIECE(P1,"^",8)\1
SET DTT2=$PIECE(P1,U,1)
DO DAT1
WRITE DAT1,?14,DAT2,?27,$PIECE(P1,"^",4),?32
+1 SET PSDIV=$SELECT($DATA(^PS(59,+$PIECE(P1,"^",9),0)):$PIECE(^(0),"^"),1:"Unknown")
+2 SET X=$PIECE(P1,"^",2)
SET X=$FIND("MWIBD",X)-1
IF X
WRITE $PIECE("Mail^Window^Inpatient","^",X),?40,$PIECE(P1,"^",6),?52,$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(P1,"^",5),0)):$PIECE(^(0),"^",1),1:""),1,16),?70,PSDIV
+3 WRITE !?4,$SELECT($PIECE(P1,"^",16):"Returned to Stock: "_$EXTRACT($PIECE(P1,"^",16),4,5)_"/"_...
... $EXTRACT($PIECE(P1,"^",16),6,7)_"/"_$EXTRACT($PIECE(P1,"^",16),2,3),1:"Released: "_$SELECT($PIECE(P1,"^",18):$EXTRACT($PIECE(P1,"^",18),4,5)_"/"_$EXTRACT($PIECE(P1,"^",18),6,7)_"/"_$EXTRACT($PIECE(P1,"^",18),2,3),1:""))
+4 IF $PIECE($GET(^PSRX(DA,1,N,"IB")),"^")]""
WRITE " Copay Billing #: "_$PIECE($GET(^PSRX(DA,1,N,"IB")),"^")
+5 WRITE !?5,"Remarks: "_$PIECE(P1,"^",3)
QUIT
Q KILL ANS,PSDIV,PSEXDT,MED,M1,FFX,DTT,DAT,RX,RX2,R3,RTN,SIG,STA,P1,PL,P0,Z0,Z1,EXDT,DAT1,DAT2,DTT1,DTT2,I,N,N1,N2,P2,PSOAC,PSOZ,RFM
+1 QUIT
LP1 SET PSOZ=0
SET (N,N1)=$ORDER(^PSRX(DA,"A",N))
IF 'N
SET PSOZ=1
IF PSOZ
QUIT
SET P1=^(N1,0)
SET DTT1=P1\1
SET (N,N2)=$ORDER(^PSRX(DA,"A",N))
IF 'N
SET PSOZ=1
SET (P2,DTT2)=""
+1 IF 'PSOZ
SET P2=^PSRX(DA,"A",N2,0)
SET DTT2=P2\1
+2 DO A1
+3 QUIT
HEAD IF $Y>(PSOACPL-20)
DO HD1^PSOARCSV
+1 WRITE !,"#",?3,"Log Date",?14,"Refill Date",?27,"QTY",?32,"Routing",?40,"Lot #",?52,"Pharmacist",?70,"Division",!
FOR I=1:1:79
WRITE "="
+2 SET FFX=0
QUIT
H1 ;
+1 WRITE !!,"Activity Log:",!,"#",?3,"Date",?14,"Reason",?25,"Rx Ref",?35,"Security",?60,"#",?63,"Date",?74,"Reason",?85,"Rx Ref",?95,"Security",!
FOR I=1:1:55
WRITE "="
+2 WRITE ?60
FOR I=1:1:60
WRITE "="
+3 QUIT
DAT ;
+1 SET DAT=$EXTRACT(DTT,4,5)_"/"_$EXTRACT(DTT,6,7)_"/"_$EXTRACT(DTT,2,3)
+2 QUIT
DAT1 SET (DAT1,DAT2)=""
SET DTT1=DTT1\1
SET DTT2=DTT2\1
IF DTT1?7N
SET DAT1=$EXTRACT(DTT1,4,5)_"/"_$EXTRACT(DTT1,6,7)_"/"_$EXTRACT(DTT1,2,3)
IF (DTT2?7N)&('PSOZ)
SET DAT2=$EXTRACT(DTT2,4,5)_"/"_$EXTRACT(DTT2,6,7)_"/"_$EXTRACT(DTT2,2,3)
+1 QUIT
STAT ;gets status of rx
+1 SET ST0=$PIECE(^PSRX(DA,"STA"),"^")
IF ST0<12
IF $ORDER(^PS(52.5,"B",J,0))
IF $DATA(^PS(52.5,+$ORDER(^(0)),0))
IF '$GET(^("P"))
SET ST0=5
+2 IF ST0<12
IF $PIECE(RX2,"^",6)<DT
SET ST0=11
+3 SET ST=$PIECE("Error^Active^Non-Verified^Refill^Hold^Non-Verified^Suspended^^^^^Done^Expired^Discontinued^Deleted^Discontinued^Discontinued (Edit)^Provider Hold^","^",ST0+2)
+4 QUIT
