| [613] | 1 | LRLNCST ;DALOI/FHS-LIST OF LOINC DEPRECIATED CODES ; 5/14/07 12:56pm
|
|---|
| 2 | ;;5.2;LAB SERVICE;**334**;Sep 27, 1994;Build 12
|
|---|
| 3 | EN ;
|
|---|
| 4 | K LRIO,%ZIS,LRIO
|
|---|
| 5 | K DIR,LRANS,Y
|
|---|
| 6 | S DIR(0)="SO^L: List of Deprecated codes;M: Mapped Deprecated codes in use"
|
|---|
| 7 | S DIR("?")="Listing of LOINC deprecated codes"
|
|---|
| 8 | S DIR("?",1)="L = List of all LOINC deprecated codes"
|
|---|
| 9 | S DIR("?",2)="M = List of mapped LOINC deprecated codes"
|
|---|
| 10 | D ^DIR G END:$G(DIRUT)!($G(Y)="")
|
|---|
| 11 | S LRANS=Y
|
|---|
| 12 | DEVICE ;
|
|---|
| 13 | S %ZIS="NQO",%ZIS("A")="Select Device: ",%ZIS("B")=""
|
|---|
| 14 | D ^%ZIS I $G(POP) D END Q
|
|---|
| 15 | I IO'=IO(0) D LOAD D END Q
|
|---|
| 16 | I LRANS="M" D LNK,END Q
|
|---|
| 17 | I LRANS="L" D LST,END
|
|---|
| 18 | Q
|
|---|
| 19 | LOAD ;
|
|---|
| 20 | N ZTRTN,ZTIO,ZTDESC,ZTDTH
|
|---|
| 21 | S ZTRTN=$S(LRANS="L":"LST^LRLNCST",1:"LNK^LRLNCST")
|
|---|
| 22 | S ZTDTH=$H,ZTDESC="Print laboratory LOINC deprecated codes"
|
|---|
| 23 | S ZTIO=IO
|
|---|
| 24 | D ^%ZTLOAD
|
|---|
| 25 | W !,$S($G(ZTSK):"Tasked to "_ION_" "_ZTSK,1:"Not Tasked")
|
|---|
| 26 | Q
|
|---|
| 27 | LST ;Print list of deprecated code
|
|---|
| 28 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 29 | S LRHDR="List of deprecated codes"
|
|---|
| 30 | S (LRPG,LRLNC)=0 D HDR
|
|---|
| 31 | F S LRLNC=$O(^LAB(95.3,"AD",1,LRLNC)) Q:LRLNC<1 D
|
|---|
| 32 | . K LRANS,ERR
|
|---|
| 33 | . D GETS^DIQ(95.3,LRLNC,".01;80","E","LRANS","ERR")
|
|---|
| 34 | . Q:$D(ERR)
|
|---|
| 35 | . W !,$G(LRANS(95.3,LRLNC_",",.01,"E"))," ",$E($G(LRANS(95.3,LRLNC_",",80,"E")),1,60)
|
|---|
| 36 | . I $Y>(IOSL-4) D HDR
|
|---|
| 37 | D END Q
|
|---|
| 38 | LNK ;Provide list of mapped deprecated LOINC codes
|
|---|
| 39 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 40 | S (LRPG,LRIEN)=0,LRNM="",LRPLINE=0
|
|---|
| 41 | S LRHDR="List of mapped LOINC deprecated codes" D HDR
|
|---|
| 42 | S $P(LRPLN,"+",79)=""
|
|---|
| 43 | F S LRNM=$O(^LAB(60,"B",LRNM)) Q:LRNM="" D
|
|---|
| 44 | . S LRIEN=0 F S LRIEN=$O(^LAB(60,"B",LRNM,LRIEN)) Q:LRIEN<1 D
|
|---|
| 45 | . . Q:$G(^LAB(60,"B",LRNM,LRIEN))
|
|---|
| 46 | . . S LR60NM="["_LRIEN_"] "_LRNM_" ",LRPLINE=0
|
|---|
| 47 | . . D LK64
|
|---|
| 48 | D END Q
|
|---|
| 49 | LK64 ;Start looking for NLT linked fields.
|
|---|
| 50 | S LR64=$G(^LAB(60,LRIEN,64)),LRONLT=+LR64,LRRNLT=$P(LR64,U,2)
|
|---|
| 51 | I LRONLT D ORDER
|
|---|
| 52 | I LRRNLT D RESULT
|
|---|
| 53 | Q
|
|---|
| 54 | RESULT ;Look up result NLT codes
|
|---|
| 55 | S LRFLD=1
|
|---|
| 56 | D CHK(LRRNLT,LRFLD) Q:$G(LRNOP)
|
|---|
| 57 | D LNC(LRRNLT,LRFLD)
|
|---|
| 58 | Q
|
|---|
| 59 | ORDER ;Look up NLT order codes
|
|---|
| 60 | S LRFLD=2
|
|---|
| 61 | D CHK(LRONLT,LRFLD) Q:$G(LRNOP)
|
|---|
| 62 | D DEF(LRONLT,LRFLD)
|
|---|
| 63 | Q
|
|---|
| 64 | DEF(LRNLT,FLD) ;Check LOINC default code
|
|---|
| 65 | S LRDEF=+$G(^LAM(LRNLT,9)) I LRDEF D
|
|---|
| 66 | . S LRNLTNM=$P(^LAM(LRNLT,0),U)_" "_$P(^(0),U,2)
|
|---|
| 67 | . I $G(^LAB(95.3,LRDEF,4)) D
|
|---|
| 68 | . . I $Y>(IOSL-6) D HDR
|
|---|
| 69 | . . D:'$G(LRPLINE) PLN
|
|---|
| 70 | . . W !,"Test Name: ",LR60NM
|
|---|
| 71 | . . W !,$S(FLD=1:"RESULT NLT Code LOINC Default ",1:"ORDER NLT Code LOINC Default ")
|
|---|
| 72 | . . W !,"NLT Code: ",LRNLTNM
|
|---|
| 73 | . . W !,LRDEF_"-"_$P(^LAB(95.3,LRDEF,0),U,15)_" "_$G(^LAB(95.3,LRDEF,80)),!
|
|---|
| 74 | Q
|
|---|
| 75 | CHK(LRP,FLD) ;Check for valid node
|
|---|
| 76 | S LRNOP=0 I '$D(^LAM(LRP,0)) D Q
|
|---|
| 77 | . D:'$G(LRPLINE) PLN
|
|---|
| 78 | . S LRTXT="is not valid"
|
|---|
| 79 | . S LRMSG="["_LRIEN_"] "_LRNM_$S(FLD=2:" Order NLT ",1:" Result NLT ")_LRTXT
|
|---|
| 80 | . D MSG(LRMSG) S LRNOP=1
|
|---|
| 81 | S LRNODE=^LAM(LRP,0),LRCC=$P($P(^(0),U,2),".")
|
|---|
| 82 | Q
|
|---|
| 83 | MSG(MSG) ;Print
|
|---|
| 84 | W !,$$CJ^XLFSTR(MSG,IOM)
|
|---|
| 85 | Q
|
|---|
| 86 | LNC(LRNLT,LRFLD) ;Check for LOINC in suffixed NLT codes
|
|---|
| 87 | S:'LRFLD LRFLD=1
|
|---|
| 88 | K LRNOP,LRCC,LRQ,LRQB,NODE
|
|---|
| 89 | S LRCC=$P(^LAM(LRNLT,0),U,2) Q:'LRCC!($G(LRNOP)) D
|
|---|
| 90 | . S LRQB=$P(LRCC,".")
|
|---|
| 91 | . S LRQ=""""_$P(LRCC,".")_".0""",NODE="^LAM(""E"","_LRQ_")"
|
|---|
| 92 | . S NODE=$Q(@NODE) I $P($QS(NODE,2),".")'=LRQB S LRNOP=1 Q
|
|---|
| 93 | . S LRINLT=$QS(NODE,3) D DEF(LRINLT,LRFLD)
|
|---|
| 94 | . D SPEC(LRINLT,3)
|
|---|
| 95 | Q
|
|---|
| 96 | SPEC(LRNLT,LRFLD) ;Check specimen time aspect LOINC
|
|---|
| 97 | S LRSPEC=0 F S LRSPEC=$O(^LAM(LRNLT,5,LRSPEC)) Q:LRSPEC<1 D
|
|---|
| 98 | . S LRSPECN=$P($G(^LAB(61,LRSPEC,0)),U)
|
|---|
| 99 | . S LRTASP=0 F S LRTASP=$O(^LAM(LRNLT,5,LRSPEC,1,LRTASP)) Q:LRTASP<1 D
|
|---|
| 100 | . . S LRTASPN=$P($G(^LAB(64.061,LRTASP,0)),U)
|
|---|
| 101 | . . S LRLNC=+$G(^LAM(LRNLT,5,LRSPEC,1,LRTASP,1))
|
|---|
| 102 | . . I LRLNC,$G(^LAB(95.3,LRLNC,4)) D DISP
|
|---|
| 103 | Q
|
|---|
| 104 | DISP ;
|
|---|
| 105 | I $Y>(IOSL-5) D HDR
|
|---|
| 106 | D:'$G(LRPLINE) PLN
|
|---|
| 107 | W !,"Test Name: ",LR60NM
|
|---|
| 108 | W !,"NLT Code: ",$P($G(^LAM(LRNLT,0)),U)," ",$P(^(0),U,2)
|
|---|
| 109 | W !," ("_LRSPEC_") "_LRSPECN
|
|---|
| 110 | W !,"LOINC Code: ",LRTASPN_" ["_LRLNC_"-"_$P(^LAB(95.3,LRLNC,0),U,15)_"]"
|
|---|
| 111 | W !,"LOINC Name: ",$G(^LAB(95.3,LRLNC,80))
|
|---|
| 112 | Q
|
|---|
| 113 | PLN ;
|
|---|
| 114 | I $Y>(IOSL-6) D HDR
|
|---|
| 115 | W !,LRPLN,!
|
|---|
| 116 | S LRPLINE=1
|
|---|
| 117 | Q
|
|---|
| 118 | END ;
|
|---|
| 119 | W !
|
|---|
| 120 | W:$E($G(IOST),1,2)="P-" @IOF
|
|---|
| 121 | D ^%ZISC
|
|---|
| 122 | K ZTSK,ERR,DIRUT,LR64,LRMSG,LRNM,LRNODE,LRNOPE,LRSPEC,LRTXT
|
|---|
| 123 | K DIR,LR60NM,LRANS,LRCC,LRDEF,LRFLD,LRHDR,LRIEN,LRINLT,LRNLTNM,LRONLT,LRPG,LRPLINE
|
|---|
| 124 | K LRLNC,LRPLN,LRQ,LRQB,LRRNLT,LRSPECN,LRTASP,LRTASPN,NODE,POP,X,Y
|
|---|
| 125 | Q
|
|---|
| 126 | HDR ;
|
|---|
| 127 | S LRPG=$G(LRPG)+1
|
|---|
| 128 | W @IOF,LRHDR," Page: ",LRPG,!
|
|---|
| 129 | Q
|
|---|
