source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOARX.m@ 762

Last change on this file since 762 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1PSOARX ;B'ham ISC/SAB - display archived rxs ;03/10/94 1:08 pm
2 ;;7.0;OUTPATIENT PHARMACY;**10,148**;DEC 1997
3GET 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
4 S PSDIV=$S($D(^PS(59,+$P(RX2,"^",9),0)):$P(^(0),"^",1)_" ("_$P(^(0),"^",6)_")",1:"Unknown"),PSDIV=$E(PSDIV,1,28)
5 S PSEXDT=$P(RX2,"^",6),PSEXDT=$S(PSEXDT]"":$E(PSEXDT,4,5)_"/"_$E(PSEXDT,6,7)_"/"_$E(PSEXDT,2,3),1:"Unknown")
6PR D STAT
7 W !!,"Rx: "_$P(RX,"^")
8 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:"")
9 W ?96,"QTY: ",$P(RX,"^",7)," ",$S($P(RX,"^",8)?1N.N:$P(RX,"^",8),1:"??")," Day Supply"
10 W !?7,"SIG: "
11 I '$P(^PSRX(DA,"SIG"),"^",2) S (SIG,X)=$P($G(^PSRX(DA,"SIG")),"^") D SIGONE^PSOHELP W SIG G RFL
12 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
13RFL S II=J D LAST^PSORFL W !?4,"Latest: "_RFL,?37,"# of Refills: "_$P(RX,"^",9)
14 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
15 W " Remaining: "_RFM
16 S PHYS=$S($D(^VA(200,+$P(RX,"^",4),0)):$P(^(0),"^"),1:"Unknown") W ?70,"Provider: "_PHYS
17DTT 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
18 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")
19 W !?3,"Expires: "_PSEXDT
20 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"
21 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:"")
22 W ?75,"Lot #: "_$P(RX2,"^",4),?85," QTY: "_$P(RX,"^",7)
23REM 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:""))
24 W !?3,"Remarks: "_$P(R3,"^",7)
25 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'=""
26ACT G Q:'$O(^PSRX(DA,"A",0)) G Q:ANS="^" D H1 F N=0:0 D LP1 Q:PSOZ
27 I $O(^PSRX(DA,4,0)) D CMOP^PSOARCTG
28 G Q
29A1 D H1:FFX,DAT1 W !,N1,?3,DAT1,?14 S X=$P(P1,U,2),X=$F("HUCELPRWSIVDABXGKNM",X)-1
30 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
31 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")
32 G:PSOZ A2 W ?60,N2,?63,DAT2,?74 S X=$P(P2,U,2),X=$F("HUCELPRWSIVDABXGKNM",X)-1
33 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
34 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")
35A2 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)
36 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)
37 Q
38N 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
39 S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^"),1:"Unknown")
40 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
41 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:""))
42 I $P($G(^PSRX(DA,1,N,"IB")),"^")]"" W " Copay Billing #: "_$P($G(^PSRX(DA,1,N,"IB")),"^")
43 W !?5,"Remarks: "_$P(P1,"^",3) Q
44Q 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
45 Q
46LP1 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)=""
47 I 'PSOZ S P2=^PSRX(DA,"A",N2,0),DTT2=P2\1
48 D A1
49 Q
50HEAD D:$Y>(PSOACPL-20) HD1^PSOARCSV
51 W !,"#",?3,"Log Date",?14,"Refill Date",?27,"QTY",?32,"Routing",?40,"Lot #",?52,"Pharmacist",?70,"Division",! F I=1:1:79 W "="
52 S FFX=0 Q
53H1 ;
54 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 "="
55 W ?60 F I=1:1:60 W "="
56 Q
57DAT ;
58 S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3)
59 Q
60DAT1 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)
61 Q
62STAT ;gets status of rx
63 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
64 I ST0<12,$P(RX2,"^",6)<DT S ST0=11
65 S ST=$P("Error^Active^Non-Verified^Refill^Hold^Non-Verified^Suspended^^^^^Done^Expired^Discontinued^Deleted^Discontinued^Discontinued (Edit)^Provider Hold^","^",ST0+2)
66 Q
Note: See TracBrowser for help on using the repository browser.