source: FOIAVistA/trunk/r/NATIONAL_DRUG_FILE-PSN/PSNSTCL.m@ 1397

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