[613] | 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
|
---|