LA7VLCM ;DALOI/JDB - LAB CODE MAPPING FILE UTILITIES ;03/07/12 09:46
;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
;
Q
;
PS ;
; Called from OPTION LA7V 62.47 PRINT SUSC
; Print #62.47 Susc
D E1^LA7VLCM6
Q
;
PL ;
; Called from OPTION LA7V 62.47 PRINT LOCAL
; Print #62.47 local codes
D E2^LA7VLCM6
Q
;
PMC ;
; Called from OPTION LA7V 62.47 PRINT BY MSG CONFIG
; Print by Msg Config
D E1^LA7VLCM2
Q
;
CMC ;
; Called from OPTION LA7V 62.47 CLONE MSG CONFIG
; Clone a Message Configuration
D CLONE^LA7VLCM3
Q
;
CSM ;
; Called from OPTION LA7V 62.47 PRINT CS MISMATCHES
; Code Set Mismatches
D E2^LA7VLCM2
Q
;
FI ;
; Called from OPTION LA7V 62.47 FIND IDENTIFIER
; Find Identifier
D E1^LA7VLCM4
Q
;
DOD6247 ;
; Called from option LA7V 62.47 ADD DOD
D DOD6247^LA7VLCM7
Q
;
MAPABS ;
; Called from option LA7V 62.47 MAP SUSCS
D MAPABS^LA7VLCM7
Q
;
ES ;
; Called from OPTION LA7V 62.47 EDIT SUSC
; Edit Susceptibility
; Allow user to select either BACT or MYCO Susceptibility concept.
; Within identifier multiple allow selection of identifiers that
; are:
; LOINC or (Non LOINC and local (national standard=no))
; and Purpose is RESULT CODE.
; Allow editing of field #2.1 Related entry - must be selectable
; only from file #62.06 (ANTIMICROBIAL SUSCEPTIBILITY)
; If local code then field #2.2 for specific related message
; configuration (local codes are interface specific).
;
N DIC,LROUT,D,DA,DIE,DR,LOCK,I,LALOCK
S LROUT=0
F D Q:LROUT ;
. K DIC,Y
. S LROUT=0
. S DIC=62.47
. S DIC(0)="AEMQ"
. S DIC("S")="I +Y=7!(+Y=21)"
. D ^DIC
. K DIC
. S:Y'>0 LROUT=1
. Q:LROUT
. N LROUT
. K DA,DIC,DIE,DR,LOCK,I,D
. S LROUT=0
. S DA(1)=+Y
. F D Q:LROUT W ! ;
. . S DIC="^LAB(62.47,"_DA(1)_",1,"
. . S DIC(0)="AEQBCV"
. . 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))"
. . S D="B"
. . D MIX^DIC1
. . K DIC
. . S:Y'>0 LROUT=1
. . Q:LROUT
. . S DA=+Y
. . S LOCK=0
. . S LALOCK=$NA(^LAB(62.47,DA(1),1,DA))
. . S LOCK=$$GETLOCK^LRUTIL(LALOCK,10,1)
. . I 'LOCK D Q ;
. . . W !,"Could not lock File #62.47 subfile's entry."
. . K DIC,Y
. . S DIE="^LAB(62.47,"_DA(1)_",1,"
. . K DIC("V")
. . S DIE("NO^")="OUTOK"
. . 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;"
. . D ^DIE
. . L -@LALOCK
. ;
Q
;
AEL ;
; Called from OPTION LA7V 62.47 LOCAL IDENTIFIER
; Add/Edit Local Codes
; Allow selection of any concept.
; Local entries to be added at an internal entry number >1000000
; with the IDENTIFIER multiple.
; Within identifier multiple allow selection and/or addition of
; non-standard code.
; When adding entry field .05 NATIONAL STANDARD will be set to NO
; Edit fields:
; .01 -- IDENTIFIER
; .02 -- CODING SYSTEM (only allow selection of "L" and "99xxx"
; when non-standard)
; .03 -- PURPOSE
; 2.1 -- RELATED ENTRY
; 2.2 -- RELATED MESSAGE CONFIGURATION
;
N I,DIC,DIE,X,D,DR,DA,DINUM,DLAYGO,DIDEL,NEXTID,LOCK
N LROUT,R6247,LALOCK
; Ask concept
F D Q:LROUT ;
. S LROUT=0
. K DIC,Y
. S DIC=62.47
. S DIC(0)="AEMQ"
. D ^DIC
. S:Y'>0 LROUT=1
. Q:LROUT
. N LROUT
. K DIC,DIE,X,D,DR,DA,DINUM,DLAYGO,DIDEL,NEXTID,LOCK
. S LOCK=0
. S R6247=+Y
. S LALOCK=$NA(^LAB(62.47,R6247))
. S LOCK=$$GETLOCK^LRUTIL(LALOCK,10,1)
. I 'LOCK D Q ;
. . W !,"Could not lock #62.47 file."
. F D Q:LROUT ;
. . K D,DIC,Y,DIE,DINUM,DIDEL,DLAYGO
. . S DA(1)=R6247
. . S LROUT=0
. . ;; Find or add new entry
. . S DIC="^LAB(62.47,"_DA(1)_",1,"
. . S DIC(0)="ABELQV"
. . S DIC("S")="I $P($G(^LAB(62.47,DA(1),1,+Y,0)),""^"",5)'=1"
. . S DLAYGO=62.4701
. . S D="B^"
. . D MIX^DIC1
. . K DIC
. . I Y'>0 D Q ;
. . . L -@LALOCK ;^LAB(62.47,DA(1))
. . . S LROUT=1
. . S DA=+Y
. . K DIE,Y,DINUM
. . S DIE="^LAB(62.47,"_DA(1)_",1,"
. . S DIE("NO^")="OUTOK"
. . S DIDEL=62.4701
. . S DR=".01;.05////0;.02;.03;.04;2.1;2.2"
. . D ^DIE
. . W !
. L -@LALOCK ;-^LAB(62.47,DA(1))
. W !
Q
;
LNFSN(R6247,R624701) ;
; Returns the LOINC FSN for specified entry
; Inputs
; R6247 : File #62.47 IEN
; R624701 : Subfile #62.4701 IEN
; Output
; Null or the LOINC code's Fully Specified Name (FSN)
N X,CODE,SYS,FSN
S FSN=""
S X=$G(^LAB(62.47,R6247,1,R624701,0))
S CODE=$P(X,"^",1)
S SYS=$P(X,"^",2)
I SYS="LN" D ;
. S FSN=$$LOINCFSN^LA7VLCM1(CODE)
Q FSN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VLCM 4738 printed Apr 09, 2024@20:48:22 Page 2
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
+2 ;
+3 QUIT
+4 ;
PS ;
+1 ; Called from OPTION LA7V 62.47 PRINT SUSC
+2 ; Print #62.47 Susc
+3 DO E1^LA7VLCM6
+4 QUIT
+5 ;
PL ;
+1 ; Called from OPTION LA7V 62.47 PRINT LOCAL
+2 ; Print #62.47 local codes
+3 DO E2^LA7VLCM6
+4 QUIT
+5 ;
PMC ;
+1 ; Called from OPTION LA7V 62.47 PRINT BY MSG CONFIG
+2 ; Print by Msg Config
+3 DO E1^LA7VLCM2
+4 QUIT
+5 ;
CMC ;
+1 ; Called from OPTION LA7V 62.47 CLONE MSG CONFIG
+2 ; Clone a Message Configuration
+3 DO CLONE^LA7VLCM3
+4 QUIT
+5 ;
CSM ;
+1 ; Called from OPTION LA7V 62.47 PRINT CS MISMATCHES
+2 ; Code Set Mismatches
+3 DO E2^LA7VLCM2
+4 QUIT
+5 ;
FI ;
+1 ; Called from OPTION LA7V 62.47 FIND IDENTIFIER
+2 ; Find Identifier
+3 DO E1^LA7VLCM4
+4 QUIT
+5 ;
DOD6247 ;
+1 ; Called from option LA7V 62.47 ADD DOD
+2 DO DOD6247^LA7VLCM7
+3 QUIT
+4 ;
MAPABS ;
+1 ; Called from option LA7V 62.47 MAP SUSCS
+2 DO MAPABS^LA7VLCM7
+3 QUIT
+4 ;
ES ;
+1 ; Called from OPTION LA7V 62.47 EDIT SUSC
+2 ; Edit Susceptibility
+3 ; Allow user to select either BACT or MYCO Susceptibility concept.
+4 ; Within identifier multiple allow selection of identifiers that
+5 ; are:
+6 ; LOINC or (Non LOINC and local (national standard=no))
+7 ; and Purpose is RESULT CODE.
+8 ; Allow editing of field #2.1 Related entry - must be selectable
+9 ; only from file #62.06 (ANTIMICROBIAL SUSCEPTIBILITY)
+10 ; If local code then field #2.2 for specific related message
+11 ; configuration (local codes are interface specific).
+12 ;
+13 NEW DIC,LROUT,D,DA,DIE,DR,LOCK,I,LALOCK
+14 SET LROUT=0
+15 ;
FOR
Begin DoDot:1
+16 KILL DIC,Y
+17 SET LROUT=0
+18 SET DIC=62.47
+19 SET DIC(0)="AEMQ"
+20 SET DIC("S")="I +Y=7!(+Y=21)"
+21 DO ^DIC
+22 KILL DIC
+23 if Y'>0
SET LROUT=1
+24 if LROUT
QUIT
+25 NEW LROUT
+26 KILL DA,DIC,DIE,DR,LOCK,I,D
+27 SET LROUT=0
+28 SET DA(1)=+Y
+29 ;
FOR
Begin DoDot:2
+30 SET DIC="^LAB(62.47,"_DA(1)_",1,"
+31 SET DIC(0)="AEQBCV"
+32 SET 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))"
+33 SET D="B"
+34 DO MIX^DIC1
+35 KILL DIC
+36 if Y'>0
SET LROUT=1
+37 if LROUT
QUIT
+38 SET DA=+Y
+39 SET LOCK=0
+40 SET LALOCK=$NAME(^LAB(62.47,DA(1),1,DA))
+41 SET LOCK=$$GETLOCK^LRUTIL(LALOCK,10,1)
+42 ;
IF 'LOCK
Begin DoDot:3
+43 WRITE !,"Could not lock File #62.47 subfile's entry."
End DoDot:3
QUIT
+44 KILL DIC,Y
+45 SET DIE="^LAB(62.47,"_DA(1)_",1,"
+46 KILL DIC("V")
+47 SET DIE("NO^")="OUTOK"
+48 SET 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;"
+49 DO ^DIE
+50 LOCK -@LALOCK
End DoDot:2
if LROUT
QUIT
WRITE !
+51 ;
End DoDot:1
if LROUT
QUIT
+52 QUIT
+53 ;
AEL ;
+1 ; Called from OPTION LA7V 62.47 LOCAL IDENTIFIER
+2 ; Add/Edit Local Codes
+3 ; Allow selection of any concept.
+4 ; Local entries to be added at an internal entry number >1000000
+5 ; with the IDENTIFIER multiple.
+6 ; Within identifier multiple allow selection and/or addition of
+7 ; non-standard code.
+8 ; When adding entry field .05 NATIONAL STANDARD will be set to NO
+9 ; Edit fields:
+10 ; .01 -- IDENTIFIER
+11 ; .02 -- CODING SYSTEM (only allow selection of "L" and "99xxx"
+12 ; when non-standard)
+13 ; .03 -- PURPOSE
+14 ; 2.1 -- RELATED ENTRY
+15 ; 2.2 -- RELATED MESSAGE CONFIGURATION
+16 ;
+17 NEW I,DIC,DIE,X,D,DR,DA,DINUM,DLAYGO,DIDEL,NEXTID,LOCK
+18 NEW LROUT,R6247,LALOCK
+19 ; Ask concept
+20 ;
FOR
Begin DoDot:1
+21 SET LROUT=0
+22 KILL DIC,Y
+23 SET DIC=62.47
+24 SET DIC(0)="AEMQ"
+25 DO ^DIC
+26 if Y'>0
SET LROUT=1
+27 if LROUT
QUIT
+28 NEW LROUT
+29 KILL DIC,DIE,X,D,DR,DA,DINUM,DLAYGO,DIDEL,NEXTID,LOCK
+30 SET LOCK=0
+31 SET R6247=+Y
+32 SET LALOCK=$NAME(^LAB(62.47,R6247))
+33 SET LOCK=$$GETLOCK^LRUTIL(LALOCK,10,1)
+34 ;
IF 'LOCK
Begin DoDot:2
+35 WRITE !,"Could not lock #62.47 file."
End DoDot:2
QUIT
+36 ;
FOR
Begin DoDot:2
+37 KILL D,DIC,Y,DIE,DINUM,DIDEL,DLAYGO
+38 SET DA(1)=R6247
+39 SET LROUT=0
+40 ;; Find or add new entry
+41 SET DIC="^LAB(62.47,"_DA(1)_",1,"
+42 SET DIC(0)="ABELQV"
+43 SET DIC("S")="I $P($G(^LAB(62.47,DA(1),1,+Y,0)),""^"",5)'=1"
+44 SET DLAYGO=62.4701
+45 SET D="B^"
+46 DO MIX^DIC1
+47 KILL DIC
+48 ;
IF Y'>0
Begin DoDot:3
+49 ;^LAB(62.47,DA(1))
LOCK -@LALOCK
+50 SET LROUT=1
End DoDot:3
QUIT
+51 SET DA=+Y
+52 KILL DIE,Y,DINUM
+53 SET DIE="^LAB(62.47,"_DA(1)_",1,"
+54 SET DIE("NO^")="OUTOK"
+55 SET DIDEL=62.4701
+56 SET DR=".01;.05////0;.02;.03;.04;2.1;2.2"
+57 DO ^DIE
+58 WRITE !
End DoDot:2
if LROUT
QUIT
+59 ;-^LAB(62.47,DA(1))
LOCK -@LALOCK
+60 WRITE !
End DoDot:1
if LROUT
QUIT
+61 QUIT
+62 ;
LNFSN(R6247,R624701) ;
+1 ; Returns the LOINC FSN for specified entry
+2 ; Inputs
+3 ; R6247 : File #62.47 IEN
+4 ; R624701 : Subfile #62.4701 IEN
+5 ; Output
+6 ; Null or the LOINC code's Fully Specified Name (FSN)
+7 NEW X,CODE,SYS,FSN
+8 SET FSN=""
+9 SET X=$GET(^LAB(62.47,R6247,1,R624701,0))
+10 SET CODE=$PIECE(X,"^",1)
+11 SET SYS=$PIECE(X,"^",2)
+12 ;
IF SYS="LN"
Begin DoDot:1
+13 SET FSN=$$LOINCFSN^LA7VLCM1(CODE)
End DoDot:1
+14 QUIT FSN
