- PSOARX ;ISC/SAB - display archived rxs ;Dec 02, 2021@12:55:57
- ;;7.0;OUTPATIENT PHARMACY;**10,148,441**;DEC 1997;Build 208
- 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
- ;441 PARK
- S DTT=$P(RX2,"^",1)\1 D DAT W !?4,"Logged: "_DAT,?42,"Routing: " S X=$F("MWIP",$P(RX,"^",11))-1 W:X $P("Mail^Window^Inpatient^Park","^",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("MWIPBD",X)-1 W:X $P("Mail^Window^Inpatient^Park","^",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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOARX 5862 printed Feb 18, 2025@23:50:52 Page 2
- PSOARX ;ISC/SAB - display archived rxs ;Dec 02, 2021@12:55:57
- +1 ;;7.0;OUTPATIENT PHARMACY;**10,148,441**;DEC 1997;Build 208
- 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 ;441 PARK
- +2 SET DTT=$PIECE(RX2,"^",1)\1
- DO DAT
- WRITE !?4,"Logged: "_DAT,?42,"Routing: "
- SET X=$FIND("MWIP",$PIECE(RX,"^",11))-1
- if X
- WRITE $PIECE("Mail^Window^Inpatient^Park","^",X),?69,"Clerk Code: "_$SELECT($DATA(^VA(200,+$PIECE(RX,"^",16),0)):$PIECE(^(0),"^"),1:"Unknown")
- +3 WRITE !?3,"Expires: "_PSEXDT
- +4 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"
- +5 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:"")
- +6 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("MWIPBD",X)-1
- if X
- WRITE $PIECE("Mail^Window^Inpatient^Park","^",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