LRLNCUTL ;DALOI/RH-LEDI HL7 CODES AND CALCULATE CHECKDIGIT ;11-OCT-1998
;;5.2;LAB SERVICE;**215,232**;Sep 27,1994
EN ;
W @IOF
W !,$$CJ^XLFSTR("This option allows the user to add/edit",IOM)
W !,$$CJ^XLFSTR(" Lab Electronic specimen codes in the Topography file.",IOM)
W !!,$$CJ^XLFSTR("It is recommended that you print a copy of Specimen codes ",IOM)
W !,$$CJ^XLFSTR(" to assist you in editing SITE/SPECIMENS.",IOM)
START ;BEGINS PRINTING THE REPORT
D DT^DICRW W !
S DIR(0)="Y",DIR("A")="Print a copy of the Electronic Code specimens"
S DIR("B")="NO" D ^DIR Q:$D(DIRUT)
I Y D ^LRLNCHL7 W !!
D ADEN
D EXIT
Q
ADEN ; ADD/EDIT LEDI HL7 CODE AND TIME ASPECT
D EXIT
I $Y+5>IOSL W @IOF
S DIC=61,DIC(0)="AQEZNM"
S DIC("A")="Select Topography Specimen to Map: "
D ^DIC Q:Y<1
S DA=+Y,DIE="^LAB(61,",DR=".09:.0961" S DIC("S")="I $P(^(0),U,7)=""S""" D ^DIE
W !! D ADEN
Q
MOD10 ;Instructions used to Calculate Mod 10 Check Digits
;Appendix B of the LOINC User's Guide
;Example using 12345
;Step 1: assign position to digits, right to left
;pos1=5 pos2=4 pos3=3 pos4=2 pos5=1
;Step 2: take odd digit pos counting from the right
;pos1 - pos3 - pos5 = 531
;Step 3: multiply 531*2 = 1062
;Step 4: take even digit starting from the right
;pos2 - pos4 = 42
;Step 5: append Step 4_Step3 = 421062
;Step 6: add the digits of Step 5 together
;4+2+1+0+6+2 = 15
;Step 7: find the next higest multiple of 10
;20
;Step 8: substract Step 6 from Step 7
;20-15 = 5
CHEKDIG(X) ;
N LREVEN,LRI,LRL,LRSTR,LRODD,LRDIG,LRCHDIG,LRCHSUM
S LRSTR=""
S (LRI,LRL)=$L(X) F S LRSTR=LRSTR_$E(X,LRI),LRI=LRI-1 Q:LRI<1
S LRODD="" F LRI=1:1:LRL S:LRI#2 LRODD=LRODD_$E(LRSTR,LRI)
S LRODD=LRODD*2
S LREVEN="" F LRI=1:1:LRL S:'(LRI#2) LREVEN=LREVEN_$E(LRSTR,LRI)
S LRCHSUM=LREVEN_LRODD,LRL1=$L(LRCHSUM)
S LRDIG="" F LRI=1:1:LRL1 S LRDIG=LRDIG+$E(LRCHSUM,LRI)
F LRI=10:10 S LRCHDIG=LRI-LRDIG Q:LRCHDIG>-1
Q LRCHDIG
Q
EXIT K DIC,DA,DIE,X,Y,DUOUT,DTOUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLNCUTL 2012 printed Dec 13, 2024@02:16:44 Page 2
LRLNCUTL ;DALOI/RH-LEDI HL7 CODES AND CALCULATE CHECKDIGIT ;11-OCT-1998
+1 ;;5.2;LAB SERVICE;**215,232**;Sep 27,1994
EN ;
+1 WRITE @IOF
+2 WRITE !,$$CJ^XLFSTR("This option allows the user to add/edit",IOM)
+3 WRITE !,$$CJ^XLFSTR(" Lab Electronic specimen codes in the Topography file.",IOM)
+4 WRITE !!,$$CJ^XLFSTR("It is recommended that you print a copy of Specimen codes ",IOM)
+5 WRITE !,$$CJ^XLFSTR(" to assist you in editing SITE/SPECIMENS.",IOM)
START ;BEGINS PRINTING THE REPORT
+1 DO DT^DICRW
WRITE !
+2 SET DIR(0)="Y"
SET DIR("A")="Print a copy of the Electronic Code specimens"
+3 SET DIR("B")="NO"
DO ^DIR
if $DATA(DIRUT)
QUIT
+4 IF Y
DO ^LRLNCHL7
WRITE !!
+5 DO ADEN
+6 DO EXIT
+7 QUIT
ADEN ; ADD/EDIT LEDI HL7 CODE AND TIME ASPECT
+1 DO EXIT
+2 IF $Y+5>IOSL
WRITE @IOF
+3 SET DIC=61
SET DIC(0)="AQEZNM"
+4 SET DIC("A")="Select Topography Specimen to Map: "
+5 DO ^DIC
if Y<1
QUIT
+6 SET DA=+Y
SET DIE="^LAB(61,"
SET DR=".09:.0961"
SET DIC("S")="I $P(^(0),U,7)=""S"""
DO ^DIE
+7 WRITE !!
DO ADEN
+8 QUIT
MOD10 ;Instructions used to Calculate Mod 10 Check Digits
+1 ;Appendix B of the LOINC User's Guide
+2 ;Example using 12345
+3 ;Step 1: assign position to digits, right to left
+4 ;pos1=5 pos2=4 pos3=3 pos4=2 pos5=1
+5 ;Step 2: take odd digit pos counting from the right
+6 ;pos1 - pos3 - pos5 = 531
+7 ;Step 3: multiply 531*2 = 1062
+8 ;Step 4: take even digit starting from the right
+9 ;pos2 - pos4 = 42
+10 ;Step 5: append Step 4_Step3 = 421062
+11 ;Step 6: add the digits of Step 5 together
+12 ;4+2+1+0+6+2 = 15
+13 ;Step 7: find the next higest multiple of 10
+14 ;20
+15 ;Step 8: substract Step 6 from Step 7
+16 ;20-15 = 5
CHEKDIG(X) ;
+1 NEW LREVEN,LRI,LRL,LRSTR,LRODD,LRDIG,LRCHDIG,LRCHSUM
+2 SET LRSTR=""
+3 SET (LRI,LRL)=$LENGTH(X)
FOR
SET LRSTR=LRSTR_$EXTRACT(X,LRI)
SET LRI=LRI-1
if LRI<1
QUIT
+4 SET LRODD=""
FOR LRI=1:1:LRL
if LRI#2
SET LRODD=LRODD_$EXTRACT(LRSTR,LRI)
+5 SET LRODD=LRODD*2
+6 SET LREVEN=""
FOR LRI=1:1:LRL
if '(LRI#2)
SET LREVEN=LREVEN_$EXTRACT(LRSTR,LRI)
+7 SET LRCHSUM=LREVEN_LRODD
SET LRL1=$LENGTH(LRCHSUM)
+8 SET LRDIG=""
FOR LRI=1:1:LRL1
SET LRDIG=LRDIG+$EXTRACT(LRCHSUM,LRI)
+9 FOR LRI=10:10
SET LRCHDIG=LRI-LRDIG
if LRCHDIG>-1
QUIT
+10 QUIT LRCHDIG
+11 QUIT
EXIT KILL DIC,DA,DIE,X,Y,DUOUT,DTOUT
+1 QUIT
