| 1 | PSDDSOR1 ;BHM/MHA - Digitally signed CS Orders Report; 08/30/02
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;**40**;13 Feb 97
|
|---|
| 3 | ;Ref. to ^PSRX( supported by DBIA 1977
|
|---|
| 4 | ;Ref. to ^PS(52.41, supported by DBIA 3848
|
|---|
| 5 | ;
|
|---|
| 6 | Q
|
|---|
| 7 | PRT I ($Y+13)>IOSL D:AC HD^PSDDSOR D:'AC HD^PSDDSOR2 Q:$D(DIRUT)
|
|---|
| 8 | S I=0,PL=""
|
|---|
| 9 | I $P($G(Y2),"^")]"" S PL=$E($P(Y2,"^"),1,30)
|
|---|
| 10 | E S PL=$E($P($G(Y6),"^"),1,30),I=1
|
|---|
| 11 | W !?1," DRUG"_$S($G(I):" (OI)",1:"")_": "_PL,?50,"CS Federal Schedule: "_$P(Y2,"^",5)
|
|---|
| 12 | W !?2,"Provider: "_$E($P(Y4,"^")_P1,1,30),?50,"DEA #: "_$S($P(Y4,"^",3)]"":$P(Y4,"^",3),$P(Y4,"^",2):$$DEA^XUSER(,$P(Y4,"^",2)),1:"")
|
|---|
| 13 | S PL=$P(Y5,"^"),PL1="" F I=2:1:6 S J=$P(Y5,"^",I) D:J]""
|
|---|
| 14 | .I $L(J)+$L(PL)<60 S PL=PL_", "_J
|
|---|
| 15 | .E S PL1=PL1_$S(PL1]"":", ",1:"")_J
|
|---|
| 16 | W !?2,"Provider Address: "_PL W:PL1]"" !?23,PL1
|
|---|
| 17 | W !?2,"CPRS Order #: "_$P(Y0,"^",2),?50,"Date Order Written: " S Y=$P(Y0,"^",5) I Y W $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
|
|---|
| 18 | W !?2,"Patient Name: "_$E($P(Y1,"^")_P1,1,30),?50,"PATIENT ID: "
|
|---|
| 19 | S DFN=$S($D(^PSRX(S5,0)):$P(^PSRX(S5,0),"^",2),1:$P($G(^PS(52.41,S5,0)),"^",2)) D PID^VADPT W $E($P(Y1,"^"))_VA("BID")
|
|---|
| 20 | S PL=$P(Y1,"^",2),PL1="" F I=3:1:7 S J=$P(Y1,"^",I) D:J]""
|
|---|
| 21 | .I $L(J)+$L(PL)<60 S PL=PL_", "_J
|
|---|
| 22 | .E S PL1=PL1_$S(PL1]"":", ",1:"")_J
|
|---|
| 23 | W !?2,"Patient Address: "_PL W:PL1]"" !?19,PL1
|
|---|
| 24 | W !?2,"Rx #: "_$S($D(^PSRX(S5,0)):$P(^PSRX(S5,0),"^"),1:""),?50,"Qty: "_$P(Y2,"^",3)
|
|---|
| 25 | W !?2,"SIG: "
|
|---|
| 26 | S PL=0 I AC'=4,$D(^PSRX(S5,"SIG1")) D G P1
|
|---|
| 27 | .F S PL=$O(^PSRX(S5,"SIG1",PL)) Q:'PL W:PL>1 ! W ?7,^PSRX(S5,"SIG1",PL,0)
|
|---|
| 28 | I AC=4,$D(^PS(52.41,S5,"SIG")) D G P1
|
|---|
| 29 | .F S PL=$O(^PS(52.41,S5,"SIG",PL)) Q:'PL W:PL>1 ! W ?7,^PS(52.41,S5,"SIG",PL,0)
|
|---|
| 30 | W ?7,$P(Y3,"^")
|
|---|
| 31 | P1 S RX2=$S($D(^PSRX(S5,2)):^PSRX(S5,2),1:"")
|
|---|
| 32 | W !?2,"Date Filled: " S Y=$P(RX2,"^",2) I Y W $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
|
|---|
| 33 | W ?50,"Date Released: " S Y=$P(RX2,"^",13) I Y W $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
|
|---|
| 34 | W !?2,"Releasing Pharmacist: "_$S($P(RX2,"^",3):$P(^VA(200,$P(RX2,"^",3),0),"^"),1:"")
|
|---|
| 35 | W ?50,"Valid PKI Certificate?: "
|
|---|
| 36 | N FL0 S FL0="Yes",Y=$P(RX2,"^",2)
|
|---|
| 37 | I $D(^PSRX(S5,"A")) N FL S FL=0 F S FL=$O(^PSRX(S5,"A",FL)) Q:'FL!(FL0="No") I $P(^PSRX(S5,"A",FL,0),"^",2)="K" S FL0="No",Y=$P($P(^(0),"^"),".")
|
|---|
| 38 | W FL0
|
|---|
| 39 | W !?2,"Date Signature Validation Attempted by Pharmacy: "
|
|---|
| 40 | I Y W $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
|
|---|
| 41 | W !?2,"CPRS Nature of Order: "_$P(Y0,"^",3),?50,"CPRS Status: "_$P($P(Y0,"^",4),";",2)
|
|---|
| 42 | S PL=$S($P(Y0,"^",7)]"":$P(Y0,"^",7),$P(Y0,"^"):"Digitally Signed",1:"")
|
|---|
| 43 | W !?2,"Signature Status: "_$E(PL,1,60) W:$L(PL)>60 !,?20,$E(PL,61,200) W !
|
|---|
| 44 | Q
|
|---|
