- 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 Feb 18, 2025@23:06:59 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