| 1 | PSSOPKI ;BHAM ISC/MHA-New API's to CPRS for DEA/PKI Pilot Project ;03/11/02
|
|---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;**61,69**;9/30/97
|
|---|
| 3 | ;Reference to ^PSNDF(50.68 supported by DBIA 3735
|
|---|
| 4 | ;
|
|---|
| 5 | OIDEA(PSSXOI,PSSXOIP) ; CPRS Orderable Item call
|
|---|
| 6 | ;returns the CS Federal Schedule code in the VA PRODUCT file (#50.68)
|
|---|
| 7 | ;or the DEA Special Hndl code depending on the "ND" node of the
|
|---|
| 8 | ;drugs associated to the Orderable Item, and Usage passed in
|
|---|
| 9 | ;1 Sch. I Nar.
|
|---|
| 10 | ;2 II
|
|---|
| 11 | ;2n II Non-Nar.
|
|---|
| 12 | ;3 III
|
|---|
| 13 | ;3n III Non-Nar.
|
|---|
| 14 | ;4 IV
|
|---|
| 15 | ;5 V
|
|---|
| 16 | ;0 there are other active drugs
|
|---|
| 17 | ;"" no active drugs
|
|---|
| 18 | ;
|
|---|
| 19 | N PSSXOLP,PSSXOLPD,PSSXOLPX,PSSXNODD,PSSPKLX,PSSI,PSSK,PSSJ,PSSGD
|
|---|
| 20 | S (PSSXOLPD,PSSXNODD)=0 I PSSXOIP="X" G OIQ
|
|---|
| 21 | I '$G(PSSXOI)!($G(PSSXOIP)="") G OIQ
|
|---|
| 22 | S PSSPKLX=$S(PSSXOIP="I":1,PSSXOIP="U":1,1:0)
|
|---|
| 23 | F PSSXOLP=0:0 S PSSXOLP=$O(^PSDRUG("ASP",PSSXOI,PSSXOLP)) Q:'PSSXOLP D
|
|---|
| 24 | .I $P($G(^PSDRUG(PSSXOLP,"I")),"^"),$P($G(^("I")),"^")<DT Q
|
|---|
| 25 | .I 'PSSPKLX,$P($G(^PSDRUG(PSSXOLP,2)),"^",3)'["O" Q
|
|---|
| 26 | .I PSSPKLX I $P($G(^PSDRUG(PSSXOLP,2)),"^",3)'["U",$P($G(^(2)),"^",3)'["I" Q
|
|---|
| 27 | .S PSSXNODD=1,PSSJ=($P($G(^PSDRUG(PSSXOLP,0)),"^",3)) S:PSSJ]"" PSSGD(PSSJ)=""
|
|---|
| 28 | .I +$P($G(^PSDRUG(PSSXOLP,"ND")),"^",3) S PSSK=$P(^("ND"),"^",3) D
|
|---|
| 29 | ..I +$P($G(^PSNDF(50.68,PSSK,7)),"^") S PSSK=$P(^(7),"^"),PSSI($S($E(PSSK,2)="n":$E(PSSK)_".5",1:PSSK))=""
|
|---|
| 30 | G:$O(PSSI(""))]"" CSS
|
|---|
| 31 | S PSSXOLPX="" F S PSSXOLPX=$O(PSSGD(PSSXOLPX)) Q:PSSXOLPX="" D
|
|---|
| 32 | .I PSSXOLPX[1 S PSSI(1)="" Q
|
|---|
| 33 | .I PSSXOLPX[2,PSSXOLPX'["C" S PSSI(2)="" Q
|
|---|
| 34 | .I PSSXOLPX[2,PSSXOLPX["C" S PSSI(2.5)="" Q
|
|---|
| 35 | .I PSSXOLPX[3,PSSXOLPX'["C" S PSSI(3)="" Q
|
|---|
| 36 | .I PSSXOLPX[3,PSSXOLPX["C" S PSSI(3.5)="" Q
|
|---|
| 37 | .I PSSXOLPX[4 S PSSI(4)="" Q
|
|---|
| 38 | .I PSSXOLPX[5 S PSSI(5)=""
|
|---|
| 39 | CSS S PSSK=0 S PSSK=$O(PSSI(PSSK)) I PSSK S PSSXOLPD=$E(PSSK)_$S($L(PSSK)>1:"n",1:"")
|
|---|
| 40 | OIQ I PSSXOLPD=0 S:'PSSXNODD PSSXOLPD=""
|
|---|
| 41 | I +PSSXOLPD=1!(+PSSXOLPD=2) S PSSXOLPD=1_";"_PSSXOLPD
|
|---|
| 42 | I +PSSXOLPD=3!(+PSSXOLPD=4)!(+PSSXOLPD=5) S PSSXOLPD=2_";"_PSSXOLPD
|
|---|
| 43 | Q PSSXOLPD
|
|---|
| 44 | ;
|
|---|
| 45 | DEAPKI(PSSDIENM) ;Return CS Federal Sch or the DEA Special Hndl for CPRS Dose Call - PKI Project
|
|---|
| 46 | Q:'$G(PSSDIENM)
|
|---|
| 47 | N PSSDEAX,PSSDEAXV,PSSJ
|
|---|
| 48 | I +$P($G(^PSDRUG(PSSDIENM,"ND")),"^",3) S PSSDEAX=$P(^("ND"),"^",3) D
|
|---|
| 49 | .I +$P($G(^PSNDF(50.68,PSSDEAX,7)),"^") S PSSDEAXV=$P(^(7),"^"),PSSJ=1
|
|---|
| 50 | G:$G(PSSJ) DSET
|
|---|
| 51 | S PSSDEAX=$P($G(^PSDRUG(PSSDIENM,0)),"^",3)
|
|---|
| 52 | I PSSDEAX[1 S PSSDEAXV=1 G DSET
|
|---|
| 53 | I PSSDEAX[2,PSSDEAX'["C" S PSSDEAXV=2 G DSET
|
|---|
| 54 | I PSSDEAX[2,PSSDEAX["C" S PSSDEAXV="2n" G DSET
|
|---|
| 55 | I PSSDEAX[3,PSSDEAX'["C" S PSSDEAXV=3 G DSET
|
|---|
| 56 | I PSSDEAX[3,PSSDEAX["C" S PSSDEAXV="3n" G DSET
|
|---|
| 57 | I PSSDEAX[4 S PSSDEAXV=4 G DSET
|
|---|
| 58 | I PSSDEAX[5 S PSSDEAXV=5 G DSET
|
|---|
| 59 | S PSSDEAXV=0
|
|---|
| 60 | DSET ;
|
|---|
| 61 | I +PSSDEAXV=1!(+PSSDEAXV=2) S PSSDEAXV=1_";"_PSSDEAXV
|
|---|
| 62 | I +PSSDEAXV=3!(+PSSDEAXV=4)!(+PSSDEAXV=5) S PSSDEAXV=2_";"_PSSDEAXV
|
|---|
| 63 | S PSSX("DD",PSSDIENM)=PSSX("DD",PSSDIENM)_"^"_PSSDEAXV_"^"_$S($D(PSSHLF(PSSDIENM)):1,1:0)
|
|---|
| 64 | Q
|
|---|
