- LRLNCC ;DALOI/CA-LOINC COMMON CODE;1-JAN-2001 ; 5/10/07 2:31pm
- ;;5.2;LAB SERVICE;**232,280,334**;Sep 27, 1994;Build 12
- ;============================================================
- ;Not valid entry call
- Q
- ;
- CODE ;ask which code to map
- I +LRLOINC("DILIST",0)=0 D Q
- .W !!,"No matches found."
- .S LRNO=1
- W !! S I=0
- F S I=$O(LRLOINC("DILIST","ID",I)) Q:'I!$G(LREND) D
- .I $E(IOST,1,2)="C-",'(I#18) D Q:$G(LREND)
- ..S DIR(0)="E" D ^DIR
- ..S:$S($G(DIRUT):1,$G(DUOUT):1,1:0) LREND=1
- .W !,I,":",LRLOINC("DILIST","ID",I,80)
- K DIRUT,DUOUT,DIR
- W !!
- S DIR(0)="N^1:"_$S($G(LREND):I-2,1:$P(LRLOINC("DILIST",0),U),1:0)
- S DIR("A")="LOINC code to map this test"
- D ^DIR K DIR,LREND
- I $D(DIRUT) S LREND=1 Q
- S LRCODE=LRLOINC("DILIST",1,+Y)
- DISPL ;Show LOINC entry selected in file 95.3
- ;display header-system and class
- ;display LOINC code, component, property, time aspect, scale type and method type
- ; LRDEL = Deprecated code
- K LRLNC0,DA S LRLNC0(8)=$P($G(^LAB(95.3,LRCODE,0)),U,8)
- N LRDEL,LRLNC0,LRLNCNAM,I
- S DA=LRCODE
- S LRLNC0=^LAB(95.3,DA,0) S:$G(^LAB(95.3,DA,4)) LRDEL=1
- F I=2,6,7,8,9,10,11,14,15 S LRLNC0(I)=$P(LRLNC0,U,I)
- S LRLNCNAM=$P($G(^LAB(95.3,DA,80)),U)
- W @IOF
- I $G(LRDEL) W !," **** Deprecated ****"
- W !,"LOINC CODE: ",LRCODE_"-"_LRLNC0(15)," ",LRLNCNAM
- W !,"SYSTEM: ",$P($G(^LAB(64.061,+LRLNC0(8),0)),U),?40,"CLASS: ",$P($G(^LAB(64.061,+LRLNC0(11),0)),U)
- W:LRLNC0(2) !,"COMPONENT: ",$P($G(^LAB(95.31,+LRLNC0(2),0)),U)
- W:LRLNC0(6) !,"PROPERTY: ",$P($G(^LAB(64.061,+LRLNC0(6),0)),U)
- W:LRLNC0(7) !,"TIME ASPECT: ",$P($G(^LAB(64.061,+LRLNC0(7),0)),U)
- W:LRLNC0(9) !,"SCALE TYPE: ",$P($G(^LAB(64.061,+LRLNC0(9),0)),U)
- W:LRLNC0(10) !,"METHOD TYPE: ",$P($G(^LAB(64.2,+LRLNC0(10),0)),U)
- W:LRLNC0(14) !,"UNITS: ",$P($G(^LAB(64.061,+LRLNC0(14),0)),U)
- Q
- ENTERLNC ;Enter LOINC code when already know the LOINC code
- W !! N DIR
- S LREND=0,DIR(0)="PO^95.3:AEMZ",DIR("A")="Enter LOINC Code/Name "
- S DIR("?")="Enter LOINC Code Name or LOINC Number"
- S DIR("?",1)="You can see possible LOINC CODES/Specimen by entering the"
- S DIR("?",2)="LOINC Test Name..Specimen example( GLUCOSE..UR )"
- S DIR("?",3)=" "
- D ^DIR K DIR
- I $D(DUOUT)!($D(DTOUT))!(Y=-1) K DTOUT,DUOUT S LREND=1 Q
- S LRCODE=+Y
- D DISPL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLNCC 2285 printed Jan 18, 2025@03:17:16 Page 2
- LRLNCC ;DALOI/CA-LOINC COMMON CODE;1-JAN-2001 ; 5/10/07 2:31pm
- +1 ;;5.2;LAB SERVICE;**232,280,334**;Sep 27, 1994;Build 12
- +2 ;============================================================
- +3 ;Not valid entry call
- +4 QUIT
- +5 ;
- CODE ;ask which code to map
- +1 IF +LRLOINC("DILIST",0)=0
- Begin DoDot:1
- +2 WRITE !!,"No matches found."
- +3 SET LRNO=1
- End DoDot:1
- QUIT
- +4 WRITE !!
- SET I=0
- +5 FOR
- SET I=$ORDER(LRLOINC("DILIST","ID",I))
- if 'I!$GET(LREND)
- QUIT
- Begin DoDot:1
- +6 IF $EXTRACT(IOST,1,2)="C-"
- IF '(I#18)
- Begin DoDot:2
- +7 SET DIR(0)="E"
- DO ^DIR
- +8 if $SELECT($GET(DIRUT)
- SET LREND=1
- End DoDot:2
- if $GET(LREND)
- QUIT
- +9 WRITE !,I,":",LRLOINC("DILIST","ID",I,80)
- End DoDot:1
- +10 KILL DIRUT,DUOUT,DIR
- +11 WRITE !!
- +12 SET DIR(0)="N^1:"_$SELECT($GET(LREND):I-2,1:$PIECE(LRLOINC("DILIST",0),U),1:0)
- +13 SET DIR("A")="LOINC code to map this test"
- +14 DO ^DIR
- KILL DIR,LREND
- +15 IF $DATA(DIRUT)
- SET LREND=1
- QUIT
- +16 SET LRCODE=LRLOINC("DILIST",1,+Y)
- DISPL ;Show LOINC entry selected in file 95.3
- +1 ;display header-system and class
- +2 ;display LOINC code, component, property, time aspect, scale type and method type
- +3 ; LRDEL = Deprecated code
- +4 KILL LRLNC0,DA
- SET LRLNC0(8)=$PIECE($GET(^LAB(95.3,LRCODE,0)),U,8)
- +5 NEW LRDEL,LRLNC0,LRLNCNAM,I
- +6 SET DA=LRCODE
- +7 SET LRLNC0=^LAB(95.3,DA,0)
- if $GET(^LAB(95.3,DA,4))
- SET LRDEL=1
- +8 FOR I=2,6,7,8,9,10,11,14,15
- SET LRLNC0(I)=$PIECE(LRLNC0,U,I)
- +9 SET LRLNCNAM=$PIECE($GET(^LAB(95.3,DA,80)),U)
- +10 WRITE @IOF
- +11 IF $GET(LRDEL)
- WRITE !," **** Deprecated ****"
- +12 WRITE !,"LOINC CODE: ",LRCODE_"-"_LRLNC0(15)," ",LRLNCNAM
- +13 WRITE !,"SYSTEM: ",$PIECE($GET(^LAB(64.061,+LRLNC0(8),0)),U),?40,"CLASS: ",$PIECE($GET(^LAB(64.061,+LRLNC0(11),0)),U)
- +14 if LRLNC0(2)
- WRITE !,"COMPONENT: ",$PIECE($GET(^LAB(95.31,+LRLNC0(2),0)),U)
- +15 if LRLNC0(6)
- WRITE !,"PROPERTY: ",$PIECE($GET(^LAB(64.061,+LRLNC0(6),0)),U)
- +16 if LRLNC0(7)
- WRITE !,"TIME ASPECT: ",$PIECE($GET(^LAB(64.061,+LRLNC0(7),0)),U)
- +17 if LRLNC0(9)
- WRITE !,"SCALE TYPE: ",$PIECE($GET(^LAB(64.061,+LRLNC0(9),0)),U)
- +18 if LRLNC0(10)
- WRITE !,"METHOD TYPE: ",$PIECE($GET(^LAB(64.2,+LRLNC0(10),0)),U)
- +19 if LRLNC0(14)
- WRITE !,"UNITS: ",$PIECE($GET(^LAB(64.061,+LRLNC0(14),0)),U)
- +20 QUIT
- ENTERLNC ;Enter LOINC code when already know the LOINC code
- +1 WRITE !!
- NEW DIR
- +2 SET LREND=0
- SET DIR(0)="PO^95.3:AEMZ"
- SET DIR("A")="Enter LOINC Code/Name "
- +3 SET DIR("?")="Enter LOINC Code Name or LOINC Number"
- +4 SET DIR("?",1)="You can see possible LOINC CODES/Specimen by entering the"
- +5 SET DIR("?",2)="LOINC Test Name..Specimen example( GLUCOSE..UR )"
- +6 SET DIR("?",3)=" "
- +7 DO ^DIR
- KILL DIR
- +8 IF $DATA(DUOUT)!($DATA(DTOUT))!(Y=-1)
- KILL DTOUT,DUOUT
- SET LREND=1
- QUIT
- +9 SET LRCODE=+Y
- +10 DO DISPL
- +11 QUIT