50 lines
3.7 KiB
Mathematica
50 lines
3.7 KiB
Mathematica
PSNSTCL ;BIR/WRT-ALLOWS USER TO CLASSIFY A DRUG THAT CANNOT BE MATCHED ; 11/22/98 15:10
|
|
;;4.0; NATIONAL DRUG FILE;**3,55**; 30 Oct 98
|
|
;
|
|
;Reference to ^PS(50.3 supported by DBIA #2612
|
|
;Reference to ^PSDRUG supported by DBIA #2352,#221
|
|
;Reference to ^PS(59.7 supported by DBIA #2613
|
|
;
|
|
W !!,"This option allows a VA Drug Classification to be entered for",!,"a drug in your local drug file, however, if the drug has been"
|
|
W !,"classed through ""the National Drug File merge procedure"" you cannot change it!",!
|
|
START R !,"Do you wish to automatically loop through all unmatched drugs?",!,"<Reply Y,N or ""^"" to quit> : " R ANS1:DTIME S:'$T ANS1="^" I ANS1["^"!(ANS1']"") G DONE
|
|
I ANS1?.E1C.E G START
|
|
I "Yy"[$E(ANS1) G MLT
|
|
I "?"[$E(ANS1) D VACLS^PSNHELP1 G START
|
|
I "Nn"'[$E(ANS1)!(ANS1="") W !,"ANSWER MUST BE YES OR NO " G START
|
|
S PSNFL=0 F PSNMM=1:1 D DRUG Q:PSNFL
|
|
DONE K PSNMM,PDA,VADC,X,Y,IFN,PP,COD,FLAG,PRIM,PSNFL,DRUG,CL,PSNCLANS,ANS1,VV,NAM,DA,PSNCLDA Q
|
|
DRUG W ! S DIC="^PSDRUG(",DIC(0)="QEAM" D ^DIC K DIC I "^"[X S PSNFL=1 Q
|
|
I "?"[$E(X) D CL^PSNHELP1 G CLASS
|
|
I Y<1 S PSNFL=1 Q
|
|
S DRUG=+Y I $D(^PSDRUG(DRUG,"ND")),$P(^PSDRUG(DRUG,"ND"),"^",2)]"" W !,"SORRY, CLASSIFICATION CANNOT BE CHANGED",! Q
|
|
CLASS W !!," Select VA DRUG CLASS CODE: " K CL,PSNCLANS I $D(^PSDRUG(DRUG,"ND")) S CL=$P(^PSDRUG(DRUG,"ND"),"^",6) I $D(^PS(50.605,CL,0)) W $P(^PS(50.605,CL,0),"^")_" // "
|
|
R PSNCLANS:DTIME I '$T S PSNFL=1 Q
|
|
I PSNCLANS?.E1C.E G CLASS
|
|
I PSNCLANS']"",'$D(CL) S PSNFL=1,PSNCLANS="^"
|
|
I PSNCLANS']"",$D(CL),$D(^PS(50.605,CL,0)) S PSNCLANS=$P(^PS(50.605,CL,0),"^",1)
|
|
I "^"[$E(PSNCLANS) S PSNFL=1 Q
|
|
I PSNCLANS="?" D CL^PSNHELP1 G CLASS
|
|
I PSNCLANS="??" S DIC="^PS(50.605,",X="??",DIC(0)="QEM" D ^DIC K DIC I Y<0 W !!,$S($D(DRUG):$P(^PSDRUG(DRUG,0),"^",1),$D(NAM):NAM,1:"") G CLASS
|
|
I "XXINPHAS"'[$E(PSNCLANS,1,2),PSNCLANS?2A.3"0" W !,"THIS IS NOT A VALID ANSWER, YOU MUST BE MORE SPECIFIC",! G CLASS
|
|
I PSNCLANS'?2A.3N W !,"THIS IS AN INCORRECT FORMAT ",! G CLASS
|
|
I PSNCLANS?2A.3N&('$D(^PS(50.605,"B",PSNCLANS))) W !," THIS CLASSIFICATION DOES NOT EXIST. PLEASE TRY AGAIN. ",! G CLASS
|
|
I $D(^PSDRUG("VAC")) F VADC=0:0 S VADC=$O(^PSDRUG("VAC",VADC)) Q:'VADC I $D(^PSDRUG("VAC",VADC,DRUG)) K ^PSDRUG("VAC",VADC,DRUG)
|
|
S PSNCLDA=$O(^PS(50.605,"B",PSNCLANS,0)),$P(^PSDRUG(DRUG,"ND"),"^",6)=PSNCLDA,^PSDRUG("VAC",PSNCLDA,DRUG)="" S FLAG=0 I $D(^PS(59.7,1,49.99)),+^(49.99) S $P(^PSDRUG(DRUG,0),"^",2)=PSNCLANS
|
|
I $D(^PSDRUG("APC")) F PP=0:0 S PP=$O(^PSDRUG("APC",PP)) Q:'PP S COD="" F S COD=$O(^PSDRUG("APC",PP,COD)) Q:COD="" I $D(^PSDRUG("APC",PP,COD,DRUG)) K ^PSDRUG("APC",PP,COD,DRUG) S ^PSDRUG("APC",PP,PSNCLANS,DRUG)="" S FLAG=1
|
|
I FLAG=0 S PRIM=$P($G(^PSDRUG(DRUG,2)),"^",6) I PRIM,$D(^PS(50.3,PRIM)) S ^PSDRUG("APC",PRIM,PSNCLANS,DRUG)=""
|
|
I $D(^PSNTRAN(DRUG,0)),$P(^PSNTRAN(DRUG,0),"^",2)']"" K ^PSNTRAN(DRUG,0)
|
|
;
|
|
I $D(^PSDRUG("AOC")) S PP=0 F S PP=$O(^PSDRUG("AOC",PP)) Q:'PP S COD="" F S COD=$O(^PSDRUG("AOC",PP,COD)) Q:COD="" I $D(^PSDRUG("AOC",PP,COD,DRUG)) K ^PSDRUG("AOC",PP,COD,DRUG)
|
|
S PRIM=$P($G(^PSDRUG(DRUG,2)),"^") S:PRIM ^PSDRUG("AOC",PRIM,$P(^PS(50.605,PSNCLDA,0),"^",1),DRUG)=""
|
|
Q
|
|
MLT S PSNFL=0,NAM=$S($D(^PSNTRAN("END")):$P(^PSNTRAN("END"),"^",3),1:"") S:NAM]"" IFN=$O(^PSDRUG("B",NAM,0)),NAM=$S($L(NAM)=1:NAM,1:$E(NAM,1,$L(NAM)-1))
|
|
I $D(^PSNTRAN),$D(IFN),$D(^PSNTRAN(IFN,"END")),$P(^PSNTRAN(IFN,"END"),"^",3)']"" K ^PSNTRAN(IFN,"END")
|
|
F VV=0:0 S NAM=$O(^PSDRUG("B",NAM)) Q:NAM="" S DA=$O(^PSDRUG("B",NAM,0)) D LOOP Q:PSNFL
|
|
S:$D(PDA) $P(^PSNTRAN(PDA,"END"),"^",3)=$P(^PSNTRAN("END"),"^",3) G DONE
|
|
LOOP I $D(^PSDRUG(DA,"I")),$P(^PSDRUG(DA,"I"),"^")<DT Q
|
|
I '$D(^PSDRUG(DA,"ND")) D SET Q
|
|
I $D(^PSDRUG(DA,"ND")),$P(^PSDRUG(DA,"ND"),"^",2)']"" D SET Q
|
|
Q
|
|
SET S DRUG=DA W !!,NAM D CLASS Q:PSNFL S $P(^PSNTRAN("END"),"^",3)=NAM,PDA=DA K:$D(IFN) ^PSNTRAN(IFN,"END") Q
|