source: FOIAVistA/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDDSOR1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1PSDDSOR1 ;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
7PRT 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,"^")
31P1 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
Note: See TracBrowser for help on using the repository browser.