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

LA7VLCM.m

Go to the documentation of this file.
  1. LA7VLCM ;DALOI/JDB - LAB CODE MAPPING FILE UTILITIES ;03/07/12 09:46
  1. ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
  1. ;
  1. Q
  1. ;
  1. PS ;
  1. ; Called from OPTION LA7V 62.47 PRINT SUSC
  1. ; Print #62.47 Susc
  1. D E1^LA7VLCM6
  1. Q
  1. ;
  1. PL ;
  1. ; Called from OPTION LA7V 62.47 PRINT LOCAL
  1. ; Print #62.47 local codes
  1. D E2^LA7VLCM6
  1. Q
  1. ;
  1. PMC ;
  1. ; Called from OPTION LA7V 62.47 PRINT BY MSG CONFIG
  1. ; Print by Msg Config
  1. D E1^LA7VLCM2
  1. Q
  1. ;
  1. CMC ;
  1. ; Called from OPTION LA7V 62.47 CLONE MSG CONFIG
  1. ; Clone a Message Configuration
  1. D CLONE^LA7VLCM3
  1. Q
  1. ;
  1. CSM ;
  1. ; Called from OPTION LA7V 62.47 PRINT CS MISMATCHES
  1. ; Code Set Mismatches
  1. D E2^LA7VLCM2
  1. Q
  1. ;
  1. FI ;
  1. ; Called from OPTION LA7V 62.47 FIND IDENTIFIER
  1. ; Find Identifier
  1. D E1^LA7VLCM4
  1. Q
  1. ;
  1. DOD6247 ;
  1. ; Called from option LA7V 62.47 ADD DOD
  1. D DOD6247^LA7VLCM7
  1. Q
  1. ;
  1. MAPABS ;
  1. ; Called from option LA7V 62.47 MAP SUSCS
  1. D MAPABS^LA7VLCM7
  1. Q
  1. ;
  1. ES ;
  1. ; Called from OPTION LA7V 62.47 EDIT SUSC
  1. ; Edit Susceptibility
  1. ; Allow user to select either BACT or MYCO Susceptibility concept.
  1. ; Within identifier multiple allow selection of identifiers that
  1. ; are:
  1. ; LOINC or (Non LOINC and local (national standard=no))
  1. ; and Purpose is RESULT CODE.
  1. ; Allow editing of field #2.1 Related entry - must be selectable
  1. ; only from file #62.06 (ANTIMICROBIAL SUSCEPTIBILITY)
  1. ; If local code then field #2.2 for specific related message
  1. ; configuration (local codes are interface specific).
  1. ;
  1. N DIC,LROUT,D,DA,DIE,DR,LOCK,I,LALOCK
  1. S LROUT=0
  1. F D Q:LROUT ;
  1. . K DIC,Y
  1. . S LROUT=0
  1. . S DIC=62.47
  1. . S DIC(0)="AEMQ"
  1. . S DIC("S")="I +Y=7!(+Y=21)"
  1. . D ^DIC
  1. . K DIC
  1. . S:Y'>0 LROUT=1
  1. . Q:LROUT
  1. . N LROUT
  1. . K DA,DIC,DIE,DR,LOCK,I,D
  1. . S LROUT=0
  1. . S DA(1)=+Y
  1. . F D Q:LROUT W ! ;
  1. . . S DIC="^LAB(62.47,"_DA(1)_",1,"
  1. . . S DIC(0)="AEQBCV"
  1. . . S DIC("S")="N LRZ,LRCS,LRP,LRSTD S LRZ=$G(^LAB(62.47,DA(1),1,+Y,0)) S LRCS=$P(LRZ,""^"",2) S LRP=$P(LRZ,""^"",3) S LRSTD=$P(LRZ,""^"",5) I LRP=1 I LRCS=""LN""!(LRCS'=""LN""&(LRSTD=0))"
  1. . . S D="B"
  1. . . D MIX^DIC1
  1. . . K DIC
  1. . . S:Y'>0 LROUT=1
  1. . . Q:LROUT
  1. . . S DA=+Y
  1. . . S LOCK=0
  1. . . S LALOCK=$NA(^LAB(62.47,DA(1),1,DA))
  1. . . S LOCK=$$GETLOCK^LRUTIL(LALOCK,10,1)
  1. . . I 'LOCK D Q ;
  1. . . . W !,"Could not lock File #62.47 subfile's entry."
  1. . . K DIC,Y
  1. . . S DIE="^LAB(62.47,"_DA(1)_",1,"
  1. . . K DIC("V")
  1. . . S DIE("NO^")="OUTOK"
  1. . . S DR="S DIC(""V"")=""I +Y(0)=62.06"";W "" "",$$LNFSN^LA7VLCM(DA(1),DA);2.1;K DIC(""V"");I $P($G(^LAB(62.47,DA(1),1,DA,0)),""^"",5)=0 S Y=2.2;"
  1. . . D ^DIE
  1. . . L -@LALOCK
  1. . ;
  1. Q
  1. ;
  1. AEL ;
  1. ; Called from OPTION LA7V 62.47 LOCAL IDENTIFIER
  1. ; Add/Edit Local Codes
  1. ; Allow selection of any concept.
  1. ; Local entries to be added at an internal entry number >1000000
  1. ; with the IDENTIFIER multiple.
  1. ; Within identifier multiple allow selection and/or addition of
  1. ; non-standard code.
  1. ; When adding entry field .05 NATIONAL STANDARD will be set to NO
  1. ; Edit fields:
  1. ; .01 -- IDENTIFIER
  1. ; .02 -- CODING SYSTEM (only allow selection of "L" and "99xxx"
  1. ; when non-standard)
  1. ; .03 -- PURPOSE
  1. ; 2.1 -- RELATED ENTRY
  1. ; 2.2 -- RELATED MESSAGE CONFIGURATION
  1. ;
  1. N I,DIC,DIE,X,D,DR,DA,DINUM,DLAYGO,DIDEL,NEXTID,LOCK
  1. N LROUT,R6247,LALOCK
  1. ; Ask concept
  1. F D Q:LROUT ;
  1. . S LROUT=0
  1. . K DIC,Y
  1. . S DIC=62.47
  1. . S DIC(0)="AEMQ"
  1. . D ^DIC
  1. . S:Y'>0 LROUT=1
  1. . Q:LROUT
  1. . N LROUT
  1. . K DIC,DIE,X,D,DR,DA,DINUM,DLAYGO,DIDEL,NEXTID,LOCK
  1. . S LOCK=0
  1. . S R6247=+Y
  1. . S LALOCK=$NA(^LAB(62.47,R6247))
  1. . S LOCK=$$GETLOCK^LRUTIL(LALOCK,10,1)
  1. . I 'LOCK D Q ;
  1. . . W !,"Could not lock #62.47 file."
  1. . F D Q:LROUT ;
  1. . . K D,DIC,Y,DIE,DINUM,DIDEL,DLAYGO
  1. . . S DA(1)=R6247
  1. . . S LROUT=0
  1. . . ;; Find or add new entry
  1. . . S DIC="^LAB(62.47,"_DA(1)_",1,"
  1. . . S DIC(0)="ABELQV"
  1. . . S DIC("S")="I $P($G(^LAB(62.47,DA(1),1,+Y,0)),""^"",5)'=1"
  1. . . S DLAYGO=62.4701
  1. . . S D="B^"
  1. . . D MIX^DIC1
  1. . . K DIC
  1. . . I Y'>0 D Q ;
  1. . . . L -@LALOCK ;^LAB(62.47,DA(1))
  1. . . . S LROUT=1
  1. . . S DA=+Y
  1. . . K DIE,Y,DINUM
  1. . . S DIE="^LAB(62.47,"_DA(1)_",1,"
  1. . . S DIE("NO^")="OUTOK"
  1. . . S DIDEL=62.4701
  1. . . S DR=".01;.05////0;.02;.03;.04;2.1;2.2"
  1. . . D ^DIE
  1. . . W !
  1. . L -@LALOCK ;-^LAB(62.47,DA(1))
  1. . W !
  1. Q
  1. ;
  1. LNFSN(R6247,R624701) ;
  1. ; Returns the LOINC FSN for specified entry
  1. ; Inputs
  1. ; R6247 : File #62.47 IEN
  1. ; R624701 : Subfile #62.4701 IEN
  1. ; Output
  1. ; Null or the LOINC code's Fully Specified Name (FSN)
  1. N X,CODE,SYS,FSN
  1. S FSN=""
  1. S X=$G(^LAB(62.47,R6247,1,R624701,0))
  1. S CODE=$P(X,"^",1)
  1. S SYS=$P(X,"^",2)
  1. I SYS="LN" D ;
  1. . S FSN=$$LOINCFSN^LA7VLCM1(CODE)
  1. Q FSN