source: FOIAVistA/trunk/r/NATIONAL_DRUG_FILE-PSN/PSNLOOK.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1PSNLOOK ;BIR/WRT-Look up into drug file ; 06/19/03 15:00
2 ;;4.0; NATIONAL DRUG FILE;**2,3,5,11,22,27,62,70**; 30 Oct 98
3 ;
4 ; Reference to ^PSDRUG supported by DBIA# 2192
5 ; Reference to ^PS(50.606 supported by DBIA# 2174
6 ;
7BEGIN D ASK F ZZ=0:0 W ! D LOOK Q:Y<0
8KILL K CL,NODE,ZZ,IFN,BB,BILL,DA,DIR,CSFS,FRM,FS,GR,ID,INDT,IST,IUN,IUT,K,MIDD,MISD,MXCD,MXDD,MXSD,NFN,NOD,PMIS,PR,QQ,SEV,SP,STR,TR,UN,UNT,VADU,VPN,DUDA,CC,DF,NUM,SCL,X,Y,RE,WRT,MAP,ENG Q
9ASK W !,"This option will allow you to look up entries in your local DRUG file. It will",!,"display National Drug File software match information.",!! S PR=" (Primary) "
10 Q
11LOOK S DIC="^PSDRUG(",DIC(0)="EM",DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)" R !!,"Select DRUG GENERIC NAME : ",BILL:DTIME S:'$T BILL="^" S X=BILL D ^DIC K DIC G:$E(BILL)["?" LOOK I Y>0 S IFN=+Y D DSPLY Q
12 Q
13DSPLY W @IOF W !?14,"DRUG Generic Name: ",$P(^PSDRUG(IFN,0),"^") I $D(^PSDRUG(IFN,"ND")) S CL=$P(^("ND"),"^",6) I $D(^PS(50.605,CL)) ; W $P(^PS(50.605,CL,0),"^",1)," ",$P(^PS(50.605,CL,0),"^",2)
14 I $D(^PSDRUG(IFN,"ND")),$P(^PSDRUG(IFN,"ND"),"^",2)]"" S NODE=^PSDRUG(IFN,"ND") S (CSFS,MXSD,MISD,MXDD,MIDD,MXCD,SP,INDT)="" D DSPLY1,DSPLY2,PRODF,DSP,ING,SV,DSP1,RESTN
15 I $D(^PSDRUG(IFN,"ND")),$P(^PSDRUG(IFN,"ND"),"^",2)']"" W !?8,"*** NO NATIONAL DRUG FILE INFORMATION ***",!
16 Q
17DSPLY1 W !?5,"VA Product Name: ",$P(NODE,"^",2)
18 W !?5,"VA Generic Name: ",$P(^PSNDF(50.6,$P(NODE,"^",1),0),"^",1)
19 Q
20DSPLY2 S VPN="",ID="",VADU="",TR="",DA=$P(NODE,"^"),K=$P(NODE,"^",3),X=$$PROD2^PSNAPIS(DA,K) I X]"",$P(X,"^")]"" S VPN=$P(X,"^"),ID=$P(X,"^",2),TR=$P(X,"^",3),VADU=$P(X,"^",4)
21 K PMIS I X]"" S QQ=$P(^PSNDF(50.68,K,1),"^",5) D GCN I QQ]"" D GCN1
22 Q
23GCN I QQ']"" S PMIS="None" Q
24GCN1 I $D(^PS(50.623,"B",QQ)) S MAP=$O(^PS(50.623,"B",QQ,0)),ENG=$P(^PS(50.623,MAP,0),"^",2),PMIS=$P(^PS(50.621,+ENG,0),"^")
25 I '$D(^PS(50.623,"B",QQ)) S PMIS="None"
26 Q
27DSPLY3 W ?50,"Transmit To CMOP: "
28 I TR=1 W "YES"
29 I TR=0 W "NO"
30 Q
31PRODF S X=$$PROD0^PSNAPIS(DA,K),DF=$P(X,"^",2),STR=$P(X,"^",3),UN=+$P(X,"^",4),FRM=$P(^PS(50.606,DF,0),"^"),UNT=$P($G(^PS(50.607,UN,0)),"^"),NFN=$P(^PSNDF(50.68,K,0),"^",6)
32 Q
33ING I $D(^PSNDF(50.68,K,2,0)) F BB=0:0 S BB=$O(^PSNDF(50.68,K,2,BB)) Q:'BB S NOD=^PSNDF(50.68,K,2,BB,0),GR=$P(^PS(50.416,$P(NOD,"^",1),0),"^"),IST=$P(NOD,"^",2),IUT=$P(NOD,"^",3) D ING1,IN2
34 Q
35IN2 W ?3,GR,?50,"Str: ",STR W:IUT]"" ?65,"Unt: ",IUN W !
36 Q
37ING1 S:$P(^PS(50.416,$P(NOD,"^"),0),"^",2)="" GR=GR_PR I IUT]"" S IUN=$P(^PS(50.607,IUT,0),"^")
38 Q
39SC I $D(^PSNDF(50.68,K,4,0)) W !,"Secondary Class(es): ",! S NUM=$P(^PSNDF(50.68,K,4,0),"^",4) F CC=0:0 S CC=$O(^PSNDF(50.68,K,4,CC)) Q:'CC S SCL=$P(^PS(50.605,$P(^PSNDF(50.68,K,4,CC,0),"^"),0),"^") D SC1
40 Q
41SC1 W " ",SCL
42 Q
43SV S SEV=$G(^PSNDF(50.68,K,7)) I SEV]"" S CSFS=$P(SEV,"^"),MXSD=$P(SEV,"^",4),MISD=$P(SEV,"^",5),MXDD=$P(SEV,"^",6),MIDD=$P(SEV,"^",7),MXCD=$P(SEV,"^",8),SP=$P(SEV,"^",2) S:SP="M" SP="Multi" S:SP="S" SP="Single" D SV1
44 Q
45SV1 S FS=$S(CSFS=0:"Unscheduled",CSFS=1:"Schedule I",CSFS=2:"Schedule II",CSFS=3:"Schedule III",CSFS=4:"Schedule IV",CSFS=5:"Schedule V",1:"None"),INDT=$P(^PSNDF(50.68,K,7),"^",3)
46 Q
47DSP W !,"Dosage Form: ",FRM,?30,"Strength: ",STR W:$G(UNT) ?50,"Units: ",UNT W !,"National Formulary Name: ",NFN,!,"VA Print Name: ",VPN,!,"VA Product Identifier: ",ID D DSPLY3 W !,"VA Dispense Unit: ",VADU I $D(PMIS) W !,"PMIS: ",PMIS
48 W !,"Active Ingredients: ",!
49 Q
50DSP1 D HG W "Primary Drug Class: ",$P(^PS(50.605,CL,0),"^") D SC W !,"CS Federal Schedule: ",CSFS,?45,"Single/Multi Source Product: ",SP
51 I INDT]"" W !,"Inactivation Date: " S Y=INDT D DD^%DT W Y
52 W !,"Max Single Dose: ",MXSD,?45,"Min Single Dose: ",MISD
53 W !,"Max Daily Dose: ",MXDD,?45,"Min Daily Dose: ",MIDD,!,"Max Cumulative Dose: ",MXCD
54 W !,"National Formulary Indicator: " I $D(^PSNDF(50.68,K,5)) W:$P(^PSNDF(50.68,K,5),"^")=0 "No" W:$P(^PSNDF(50.68,K,5),"^")=1 "Yes"
55 I $G(^PSNDF(50.68,K,8)) W !!,"Exclude Drg-Drg Interaction Ck: Yes (No check for Drug-Drug Interactions)"
56 W !
57 Q
58RESTN I $D(^PSNDF(50.68,K,6,0)) W !,"Restriction: " F RE=0:0 S RE=$O(^PSNDF(50.68,K,6,RE)) Q:'RE S WRT=^PSNDF(50.68,K,6,RE,0) W !,WRT
59 Q
60HG K DIR S DIR(0)="E",DIR("A")="Press <Return> to Continue" D ^DIR
61 W @IOF
62 Q
Note: See TracBrowser for help on using the repository browser.