Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRWU7

LRWU7.m

Go to the documentation of this file. 
  1. LRWU7 ;DALOI/JMC - ADD A NEW ANTIBIOTIC TO FILE 63 ;04/02/09  09:59
  1.  ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
  1.  ;
  1.  ; Reference to ^DD supported by ICR #29/999
  1.  ;
  1.  ; ZEXCEPT is used to identify variables which are external to a specific TAG
  1.  ;         used in conjunction with Eclipse M-editor.
  1.  ;
  1. ACCESS ;
  1.  N LRX
  1.  D OWNSKEY^XUSRB(.LRX,"LRLIASON",DUZ)
  1.  I LRX(0)'=1 D  Q
  1.  . D EN^DDIOL("You do not have proper access for using this option.","","!?2")
  1.  ;
  1. BEGIN ;
  1.  ;
  1.  ;ZEXCEPT: DTIME - Kernel variable which can be set by applications via API
  1.  ;
  1.  N %,I,DA,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,LR4,LRINC,LRNAME,LRNAME1,LRNAME2,LRNUM,LRNUM1,LRNUM2,LROK,LRSITE,LRSUBFIL,LRTYPE,LRY,X,Y
  1.  S U="^",DTIME=$$DTIME^XUP(DUZ),DT=$$DT^XLFDT,LROK=1
  1.  S LR4=$$KSP^XUPARAM("INST")
  1.  S LRSITE=$$STA^XUAF4(LR4)
  1.  I 'LRSITE D  Q
  1.  . N A
  1.  . S A(1)="Your site number is not defined, indicating that FileMan was not",A(1,"F")="!"
  1.  . S A(2)="installed correctly.  Contact your site manager!",A(2,"F")="!"
  1.  . D EN^DDIOL(.A)
  1.  ;
  1.  S DIR(0)="S^1:Bacterial Antibiotic;2:Mycobacterium Antibiotic"
  1.  S DIR("A")="Select Antibiotic Type to Add",DIR("B")=1
  1.  D ^DIR
  1.  I $D(DIRUT) D END Q
  1.  S LRTYPE=Y,LRSUBFIL=$S(LRTYPE=1:63.3,LRTYPE=2:63.39,1:"")
  1.  ;
  1.  D NAME
  1.  I 'LROK D END Q
  1.  D NUMBER,SETUP,END
  1.  Q
  1.  ;
  1.  ;
  1. END ; Cleanup before quiting
  1.  ;
  1.  ;ZEXCEPT: %,DA,DIC,DIK,I,LRINC,LRNAME,LRNAME1,LRNAME2,LRNUM,LRNUM1,LRNUM2,LROK,LRSITE,X
  1.  ;
  1.  K %,I,DA,DIC,DIK,LRINC,LRNAME,LRNAME1,LRNAME2,LRNUM,LRNUM1,LRNUM2,LROK,LRSITE,X
  1.  Q
  1.  ;
  1.  ;
  1. NAME ; Prompt user for the name of the new antibiotic to be added.
  1.  ;
  1.  ;ZEXCEPT: LRNAME,LRNAME1,LRNAME2,LROK - used by calling process
  1.  ;
  1.  N DA,DIR,DIROUT,DIRUT,DTOUT,Y
  1.  S DIR(0)="FO^3:20^D CHECK^LRWU7"
  1.  S DIR("A")="Enter the name of the new antibiotic you wish to create"
  1.  D ^DIR
  1.  I $D(DIRUT) S LROK=0 Q
  1.  S LROK=1,LRNAME=Y,LRNAME1=LRNAME_" INTERP",LRNAME2=LRNAME_" SCREEN"
  1.  Q
  1.  ;
  1.  ;
  1. CHECK ; Check if field already exists for the same name.
  1.  ;
  1.  ;ZEXCEPT: LROK,LRSUBFIL,X - set by calling process
  1.  ;
  1.  D EN^DDIOL("Checking if field exists...","","!!")
  1.  S X=$$UP^XLFSTR(X)
  1.  I '$$FLDNUM^DILFD(LRSUBFIL,X) D EN^DDIOL("OK","","?1") Q
  1.  D EN^DDIOL($C(7)_X_" already exists!","","?1")
  1.  S LROK=0 K X
  1.  Q
  1.  ;
  1.  ;
  1. NUMBER ; Determine the next field number by checking existing fields.
  1.  ;
  1.  ;ZEXCEPT: LRINC,LRNUM,LRNUM1,LRNUM2,LRSITE,LRSUBFIL - set by calling process
  1.  ;
  1.  N LROK
  1.  S LRNUM="2.00"_LRSITE,LRINC=$S($L(LRSITE)=3:.00000001,1:.000000001),LRNUM=LRNUM+LRINC,LROK=0
  1.  ;
  1.  F  D  Q:LROK
  1.  . I '$$VFIELD^DILFD(LRSUBFIL,LRNUM),'$D(^DD(LRSUBFIL,"GL",LRNUM)) S LROK=1 Q
  1.  . S LRNUM=LRNUM+LRINC
  1.  ;
  1.  S LRNUM1=+$S($L(LRSITE)=3:LRNUM+.000000001,1:LRNUM+.0000000001)
  1.  S LRNUM2=+$S($L(LRSITE)=3:LRNUM+.000000002,1:LRNUM+.0000000002)
  1.  S LRNUM=+LRNUM
  1.  Q
  1.  ;
  1.  ;
  1. SETUP ; Confirm creation of new antibiotic and setup corresponding fields in DD
  1.  ;
  1.  ;ZEXCEPT: LR6206,LRNAME,LRNUM,LRTYPE - set by calling process
  1.  ;
  1.  N A,DA,DIR,DIROUT,DIRUT,DTOUT,X,Y
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Are you sure you wish to create "_LRNAME
  1.  S DIR("A",1)=" (DRUG NODE will be "_LRNUM_")"
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  I Y<1 Q
  1.  ;
  1.  ; Create new field(s) in file #63 Data Dictionary
  1.  D SETFLDS
  1.  ;
  1.  ; Ask if user wants to setupcorresponding entry in file #62.06
  1.  S A(1)=LRNAME_" has now been created.",A(1,"F")="!!"
  1.  S A(2)="You must now add a new antibiotic in the ANTIMICROBIAL SUSCEPTIBILITY file",A(2,"F")="!"
  1.  S A(3)="and use "_LRNAME_" as the entry for the "_$S(LRTYPE=1:"",LRTYPE=2:"AFB ",1:"")_"INTERNAL NAME field.",A(3,"F")="!"
  1.  D EN^DDIOL(.A)
  1.  ;
  1.  ;
  1.  K DIR,DIROUT,DIRUT,DTOUT,X,Y
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Do you want to setup "_LRNAME_" as a new "_$S(LRTYPE=1:"Bacterial",LRTYPE=2:"Mycobacterium",1:"")_" Antibiotic"
  1.  S DIR("A",1)=" "
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  I Y<1 Q
  1.  ;
  1.  N FDA,LRDIE,LRIEN
  1.  S FDA(1,62.06,"+1,",.01)=LRNAME
  1.  D UPDATE^DIE("","FDA(1)","LRIEN","LRDIE(1)")
  1.  S LR6206=LRIEN(1)
  1.  I $D(LRDIE) D  Q
  1.  . D EN^DDIOL("Encountered an error adding new antibiotic","","!?2")
  1.  D DIE
  1.  Q
  1.  ;
  1.  ;
  1. SETFLDS ; Create the fields in the DD for bacterial and mycobacteria
  1.  ;  LRSUBFIL = sub file # within MI subscript
  1.  ;     LRNUM = field number of antibiotic field
  1.  ;    LRNUM1 = field number of bacterial interpretation field
  1.  ;    LRNUM2 = field number of bacterial screen field
  1.  ;    LRNAME = field name for field LRNUM
  1.  ;   LRNAME1 = field name for field LRNUM1
  1.  ;   LRNAME2 = field name for field LRNUM2
  1.  ;    LRTYPE = 1 (BACTERIAL) / 2 (MYCOBACTERIUM)
  1.  ;
  1.  ;
  1.  ;ZEXCEPT: LRNAME,LRNAME1,LRNAME2,LRNUM,LRNUM1,LRNUM2,LRSUBFIL,LRTYPE - set by calling process
  1.  ;
  1.  N DA,DIK
  1.  ; Setup antibiotic - bacterial and AFB.
  1.  S ^DD(LRSUBFIL,LRNUM,0)=LRNAME_"^FX^^"_LRNUM_";1^"_$S(LRTYPE=1:"D ^LRMISR",LRTYPE=2:"D COM^LRMISR",1:"")
  1.  S ^DD(LRSUBFIL,LRNUM,3)=""
  1.  S ^DD(LRSUBFIL,LRNUM,4)=$S(LRTYPE=1:"D EN^LRMISR",LRTYPE=2:"D ZQ^LRMISR",1:"")
  1.  S ^DD(LRSUBFIL,LRNUM,"DT")=DT
  1.  ;
  1.  ; Setup two additional fields used for bacterial antibiotics
  1.  I LRTYPE=1 D
  1.  . S ^DD(LRSUBFIL,LRNUM1,0)=LRNAME1_"^FX^^"_LRNUM_";2^D INT^LRMISR",^(3)="",^(4)="D HINT^LRMISR",^("DT")=DT
  1.  . S ^DD(LRSUBFIL,LRNUM2,0)=LRNAME2_"^S^A:ALWAYS DISPLAY;N:NEVER DISPLAY;R:RESTRICT DISPLAY;^"_LRNUM_";3^Q",^("DT")=DT
  1.  ;
  1.  S $P(^DD(LRSUBFIL),U,4)=$P(^DD(LRSUBFIL,0),U,4)+3
  1.  ;
  1.  ; Call FileMan to reindex the new fields.
  1.  S DIK="^DD(LRSUBFIL,",DA=LRNUM,DA(1)=LRSUBFIL
  1.  D IX1^DIK
  1.  I LRTYPE=1 F DA=LRNUM1,LRNUM2 D IX1^DIK
  1.  Q
  1.  ;
  1.  ;
  1. DIE ; Edit file #62.06
  1.  ; LRTYPE = 1-BACTERIAL, 2-MYCOBACTERIUM
  1.  ; LR6206 = ien of entry to edit
  1.  ;  LRNUM = drug node
  1.  ;
  1.  ;ZEXCEPT: LR6206,LRNUM,LRTYPE - set by calling process
  1.  ;
  1.  N DA,DIE,DR
  1.  ;
  1.  S DA=LR6206,DIE="^LAB(62.06,"
  1.  I LRTYPE=1 S DR=".01;5//"_LRNUM_";4;6;7;.5;2;64",DR(2,62.061)=".01;1"
  1.  I LRTYPE=2 S DR=".01;5.1//"_LRNUM_";64"
  1.  D ^DIE
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. EDIT ; Edit an existing entry in file #62.06
  1.  N DIC,DIR,DIROUT,DIRUT,DTOUT,LR6206,LRNUM,LRTYPE,X,Y
  1.  ;
  1.  S DIR(0)="S^1:Bacterial Antibiotic;2:Mycobacterium Antibiotic"
  1.  S DIR("A")="Select Antibiotic Type to Edit",DIR("B")=1
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  S LRTYPE=Y
  1.  S DIC="^LAB(62.06,",DIC(0)="AELMOQZ",DIC("S")="I $P(^(0),U,$S(LRTYPE=1:8,1:4))="""""
  1.  D ^DIC
  1.  I Y<1 Q
  1.  ;
  1.  S LR6206=+Y,LRNUM=$P(Y(0),"^",$S(LRTYPE=1:4,1:8)) D DIE
  1.  ;
  1.  Q