28 lines
2.0 KiB
Mathematica
28 lines
2.0 KiB
Mathematica
|
LRWU7 ;SLC/BA - ADD A NEW ANTIBIOTIC TO FILE 63 ; 5/15/87 23:31 ;
|
||
|
|
;;5.2;LAB SERVICE;;Sep 27, 1994
|
||
|
|
ACCESS I '$D(^XUSEC("LRLIASON",DUZ)) W !,"You do not have proper access for using this option." Q
|
||
|
|
BEGIN S U="^",DTIME=$S($D(DTIME):DTIME,1:300),LRSITE=+$P($G(^XMB(1,1,"XUS")),U,17),LROK=1 D:'LRSITE SITE G:'LROK END D DT^LRX,NAME G:'LROK END D NUMBER,SET
|
||
|
|
END K %,I,DA,DIC,DIK,LRINC,LRNAME,LRNAME1,LRNAME2,LRNUM,LRNUM1,LRNUM2,LROK,LRSITE,X
|
||
|
|
Q
|
||
|
|
SITE W !,"Your site number is not defined, indicating that fileman was not ",!,"installed correctly. Contact your site manager!"
|
||
|
|
S LROK=0 Q
|
||
|
|
NAME W !! F I=0:0 R !,"Enter the name of the new antibiotic you wish to create: ",X:DTIME D CHECK Q:'LROK
|
||
|
|
I X[U!('$L(X)) S LROK=0 Q
|
||
|
|
S LROK=1,LRNAME=X,LRNAME1=LRNAME_" INTERP",LRNAME2=LRNAME_" SCREEN"
|
||
|
|
Q
|
||
|
|
CHECK I X[U!'$L(X) S LROK=0 Q
|
||
|
|
I $L(X)<2!($L(X)>20)!(X["?") W !," Name must be 2-20 characters." Q
|
||
|
|
S DIC="^DD(63.3,",DIC(0)="XM" D ^DIC I Y>0 W $C(7),!," ",X," already exists!" S LROK=1,X="" Q
|
||
|
|
S LROK=0 Q
|
||
|
|
NUMBER S LRNUM="2.00"_LRSITE,LRINC=$S($L(LRSITE)=3:.00000001,1:.000000001),LRNUM=LRNUM+LRINC I $D(^DD(63.3,"GL",LRNUM)) F I=0:0 S LRNUM=LRNUM+LRINC Q:'$D(^DD(63.3,"GL",LRNUM))
|
||
|
|
S LRNUM1=+$S($L(LRSITE)=3:LRNUM+.000000001,1:LRNUM+.0000000001),LRNUM2=+$S($L(LRSITE)=3:LRNUM+.000000002,1:LRNUM+.0000000002),LRNUM=+LRNUM
|
||
|
|
Q
|
||
|
|
SET F I=0:0 W !,"Are you sure you wish to create ",LRNAME,!," (DRUG NODE will be ",LRNUM,")" S %=1 D YN^DICN Q:% W "answer 'Y'es or 'N'o."
|
||
|
|
I %'=1 S LROK=0 Q
|
||
|
|
S ^DD(63.3,LRNUM,0)=LRNAME_"^FX^^"_LRNUM_";1^D ^LRMISR",^(3)="",^(4)="D EN^LRMISR",^("DT")=DT
|
||
|
|
S ^DD(63.3,LRNUM1,0)=LRNAME1_"^FX^^"_LRNUM_";2^D INT^LRMISR",^(3)="",^(4)="D HINT^LRMISR",^("DT")=DT
|
||
|
|
S ^DD(63.3,LRNUM2,0)=LRNAME2_"^S^A:ALWAYS DISPLAY;N:NEVER DISPLAY;R:RESTRICT DISPLAY;^"_LRNUM_";3^Q",^("DT")=DT
|
||
|
|
S $P(^DD(63.3,0),U,4)=$P(^DD(63.3,0),U,4)+3,DIK="^DD(63.3,",DA(1)=63.3 F DA=LRNUM,LRNUM1,LRNUM2 D IX1^DIK
|
||
|
|
W !!,LRNAME," has now been created.",!,"You must now add a new antibiotic in the ANTIMICROBIAL SUSCEPTIBILITY file",!,"and use ",LRNAME," as the entry for the INTERNAL NAME field."
|
||
|
|
Q
|