| 1 | LRLNCUTL ;DALOI/RH-LEDI HL7 CODES AND CALCULATE CHECKDIGIT ;11-OCT-1998
 | 
|---|
| 2 |  ;;5.2;LAB SERVICE;**215,232**;Sep 27,1994
 | 
|---|
| 3 | EN ;
 | 
|---|
| 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)
 | 
|---|
| 9 | START ;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
 | 
|---|
| 17 | ADEN ; 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
 | 
|---|
| 26 | MOD10 ;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
 | 
|---|
| 43 | CHEKDIG(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
 | 
|---|
| 55 | EXIT K DIC,DA,DIE,X,Y,DUOUT,DTOUT
 | 
|---|
| 56 |  Q
 | 
|---|