source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRLNCUTL.m@ 1384

Last change on this file since 1384 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1LRLNCUTL ;DALOI/RH-LEDI HL7 CODES AND CALCULATE CHECKDIGIT ;11-OCT-1998
2 ;;5.2;LAB SERVICE;**215,232**;Sep 27,1994
3EN ;
4 W @IOF
5 W !,$$CJ^XLFSTR("This option allows the user to add/edit",IOM)
6 W !,$$CJ^XLFSTR(" Lab Electronic specimen codes in the Topography file.",IOM)
7 W !!,$$CJ^XLFSTR("It is recommended that you print a copy of Specimen codes ",IOM)
8 W !,$$CJ^XLFSTR(" to assist you in editing SITE/SPECIMENS.",IOM)
9START ;BEGINS PRINTING THE REPORT
10 D DT^DICRW W !
11 S DIR(0)="Y",DIR("A")="Print a copy of the Electronic Code specimens"
12 S DIR("B")="NO" D ^DIR Q:$D(DIRUT)
13 I Y D ^LRLNCHL7 W !!
14 D ADEN
15 D EXIT
16 Q
17ADEN ; ADD/EDIT LEDI HL7 CODE AND TIME ASPECT
18 D EXIT
19 I $Y+5>IOSL W @IOF
20 S DIC=61,DIC(0)="AQEZNM"
21 S DIC("A")="Select Topography Specimen to Map: "
22 D ^DIC Q:Y<1
23 S DA=+Y,DIE="^LAB(61,",DR=".09:.0961" S DIC("S")="I $P(^(0),U,7)=""S""" D ^DIE
24 W !! D ADEN
25 Q
26MOD10 ;Instructions used to Calculate Mod 10 Check Digits
27 ;Appendix B of the LOINC User's Guide
28 ;Example using 12345
29 ;Step 1: assign position to digits, right to left
30 ;pos1=5 pos2=4 pos3=3 pos4=2 pos5=1
31 ;Step 2: take odd digit pos counting from the right
32 ;pos1 - pos3 - pos5 = 531
33 ;Step 3: multiply 531*2 = 1062
34 ;Step 4: take even digit starting from the right
35 ;pos2 - pos4 = 42
36 ;Step 5: append Step 4_Step3 = 421062
37 ;Step 6: add the digits of Step 5 together
38 ;4+2+1+0+6+2 = 15
39 ;Step 7: find the next higest multiple of 10
40 ;20
41 ;Step 8: substract Step 6 from Step 7
42 ;20-15 = 5
43CHEKDIG(X) ;
44 N LREVEN,LRI,LRL,LRSTR,LRODD,LRDIG,LRCHDIG,LRCHSUM
45 S LRSTR=""
46 S (LRI,LRL)=$L(X) F S LRSTR=LRSTR_$E(X,LRI),LRI=LRI-1 Q:LRI<1
47 S LRODD="" F LRI=1:1:LRL S:LRI#2 LRODD=LRODD_$E(LRSTR,LRI)
48 S LRODD=LRODD*2
49 S LREVEN="" F LRI=1:1:LRL S:'(LRI#2) LREVEN=LREVEN_$E(LRSTR,LRI)
50 S LRCHSUM=LREVEN_LRODD,LRL1=$L(LRCHSUM)
51 S LRDIG="" F LRI=1:1:LRL1 S LRDIG=LRDIG+$E(LRCHSUM,LRI)
52 F LRI=10:10 S LRCHDIG=LRI-LRDIG Q:LRCHDIG>-1
53 Q LRCHDIG
54 Q
55EXIT K DIC,DA,DIE,X,Y,DUOUT,DTOUT
56 Q
Note: See TracBrowser for help on using the repository browser.