| 1 | PSNDRUG ;BIR/CCH&WRT-Allows user to reset one or several drug matches ; 12/10/98 13:09
|
|---|
| 2 | ;;4.0; NATIONAL DRUG FILE;**2,3,33**; 30 Oct 98
|
|---|
| 3 | ;Reference to EN1^PSSUTIL supported by DBIA #3107
|
|---|
| 4 | ;Reference to ^PSDRUG supported by DBIAs #221 and #2352
|
|---|
| 5 | ;Reference to ^PS(59.7 supported by DBIA #2613
|
|---|
| 6 | S PSNFL=0 D EXPLN F PSNMM=1:1 D START S:'$D(PSNFL) PSNFL=0 Q:PSNFL
|
|---|
| 7 | DONE W !!,"Remember, these matches must be verified using the options ""Verify Matches"" or",!,"""Verify Single Match"" and then be merged using the option ""Merge National Drug File",!,"Data Into Local File"".",!
|
|---|
| 8 | K PSNMM,PSNFL,X,Y,PSNB,PSNDEA,PSNINACT D KILL Q
|
|---|
| 9 | EXPLN W !!,"Enter name of drug from your local drug file and a match",!,"with the National Drug File will be attempted. ",!,"Press return at the ""Select DRUG GENERIC NAME: "" prompt to exit.",! Q
|
|---|
| 10 | START D KILL S DIC="^PSDRUG(",DIC(0)="QEAM" D ^DIC K DIC I Y<0 S PSNFL=1 Q
|
|---|
| 11 | S (PSNB,PSNDRG)=+Y,PSNLOC=$P(Y,"^",2) D CR^PSNHELP
|
|---|
| 12 | DTE S DATE=$G(^PSDRUG(PSNB,"I")) I DATE,DATE>DT S %=0 W !,"This drug has an Inactivation date in the future. Do you want to continue" D YN^DICN G:%=0 DTE0 Q:%=2 Q:%<0
|
|---|
| 13 | I DATE,DATE<DT W !!,"This drug is ""Inactive"". Please try again.",! Q
|
|---|
| 14 | I $D(^PSDRUG(PSNB,3)),$P(^PSDRUG(PSNB,3),"^",1)=1,'$D(^XUSEC("PSNMGR",DUZ)) W !,"You cannot rematch this entry. It is marked to transmit to CMOP.",!,"You do not have the ""PSNMGR"" key.",! Q
|
|---|
| 15 | S PSNSAVEY=$G(Y) I $P(^PS(59.7,1,10),"^",3)=1,'$D(^PSDRUG(PSNB,"ND")) S X="PSSUTIL" X ^%ZOSF("TEST") I D EN1^PSSUTIL(PSNB,0)
|
|---|
| 16 | S Y=$G(PSNSAVEY) K PSNSAVEY
|
|---|
| 17 | I $P(^PS(59.7,1,10),"^",3)=1,$D(^PSDRUG(+Y,"ND")) G REMTCH^PSNHELP
|
|---|
| 18 | MATCH Q:'$D(^PSDRUG(PSNB,0)) Q:$P(^PSDRUG(PSNB,0),"^",1)']""
|
|---|
| 19 | I $D(^PSDRUG(PSNB,"ND")),$P(^PSDRUG(PSNB,"ND"),"^",2)]"" Q
|
|---|
| 20 | I $D(PSNFLB),$D(^PSNTRAN(PSNB,0)) Q
|
|---|
| 21 | D KILL^PSNHIT,^PSNDEA Q:$D(PSNINACT) Q:'$D(PSNDEA) K PSNDEA
|
|---|
| 22 | I $P(^PS(59.7,1,10),"^",3)=1 K:$D(^PSNTRAN(PSNB,0)) ^PSNTRAN(PSNB,0) D NAM^PSNCOMP Q
|
|---|
| 23 | Q
|
|---|
| 24 | KILL K ANS,PSNDA,PSNUNDA,PSNDDA,PSNSTDA,DIC,FF,KK,NBR,PSNANS,PSNCLASS,PSNDRG,PSNSZ,PSNFNM,PSNFORM,PSNLOC,PSNNDF,PSNNEW,PSNOLD,PSNPST,PSNSIZE,PSNSIZE,NDP,PS,PT,DOS,STR,UNT,VV,VV1,PSNTYPE,PSNPD
|
|---|
| 25 | K PSNNAM,PSNNAME,PSNTRFL,PSNTYP,PSNVAR,VAR,STOP,PSND,PSNDFM,PSNVC,PSNVCL,JJ,MJL,PSNODE,PSNOU,PSNSZE,PSNTPE,PSNENT,PSNF,PSNM,^TMP($J,"PSNND"),ASC,PSNRAN,PSNV,PSNWR,PSNX,PSNZ,WRT,BB,END,LIST,^TMP($J,"PSNPSPT"),^TMP($J,"PSNDFPK")
|
|---|
| 26 | K CODE,DA,DATE,DIR,EEE,FFF,FL,GGG,IEN,J,K,NO31,NOM31,NOMSYN,DUNCE,PP,PSNARY,PSNIEN,PSNP,PTPS,QQ,RR,ST,TT,TTT,WR,XX,XXX,Y,ZXZX,PPQ,PPR,^TMP($J,"PSNND"),^TMP($J,"PSNDF1"),^TMP($J,"PSNPSPS"),PSNUP,PSNINQ Q
|
|---|
| 27 | DTE0 W !,"Answer yes or no" G DTE
|
|---|
| 28 | GONE K DUNCE,TT,DIRUT,TTT,PPQ,PSNDRG,PSNLOC,PSNNAM,PSNODE,PSNOU,PSNP,NO31,NOM31,NOMSYN Q
|
|---|
