| 1 | LRCAP64S ;DALISC/FHS - SEARCH 64 FOR CODES
|
|---|
| 2 | ;;5.2;LAB SERVICE;**258,369**;Sep 27, 1994;Build 2
|
|---|
| 3 | EN ;
|
|---|
| 4 | K DA,DIR,LRCPT,LRAN,LRANS,LRCODE,LRN,Y,X,LRX,LRIEN,%ZIS
|
|---|
| 5 | K ^TMP("LROUT",$J)
|
|---|
| 6 | S DIR("A")="Select the code type"
|
|---|
| 7 | S DIR("?",1)="Indicate what code you want to find in the"
|
|---|
| 8 | S DIR("?")="CODE field of the WKLD CODE file."
|
|---|
| 9 | S DIR(0)="SO^1:CPT;2:SNOMED;3:ICD9;4:LOINC"
|
|---|
| 10 | D ^DIR
|
|---|
| 11 | G END:$G(Y)<1
|
|---|
| 12 | S LRAN=Y,LRAN(0)=Y(0)
|
|---|
| 13 | K LRCODE S LRCODE=""
|
|---|
| 14 | S LRANS=$S(Y=1:" CPT",Y=2:" SNOMED,",Y=3:" ICD9",1:" LOINC")
|
|---|
| 15 | K DIR S DIR("A")="Select "_Y(0)_" Code"
|
|---|
| 16 | S LRGLB=$S(Y=1:";ICPT(",Y=2:";LAB(61.1,",Y=3:";ICD9(",1:"")
|
|---|
| 17 | S DIR(0)="PO^"_$S(Y=1:"81",Y=2:"61.1",Y=3:"80",1:"95.3")_":ENMZQ"
|
|---|
| 18 | F D ^DIR Q:Y<1 D
|
|---|
| 19 | . I LRAN'=4 S LRCODE(+Y_LRGLB_"-"_LRANS)=" ["_$S(LRAN=3:$P(Y(0),U,3),1:$P(Y(0),U,2))_"]",DIR("A")=" Select another "_LRAN(0)_" code "
|
|---|
| 20 | . I LRAN=4 S LRCODE(+Y_"-"_LRANS)=" ["_$G(^LAB(95.3,+Y,80))_"]"
|
|---|
| 21 | G:$D(DTOUT)!($D(DUOUT)) END
|
|---|
| 22 | I $O(LRCODE(0))="" W !?5,"Nothing Selected ",!!,$C(7) G END
|
|---|
| 23 | DEV ;SELECT DEVICE
|
|---|
| 24 | K %ZIS S %ZIS="Q" D ^%ZIS G:POP!($D(DUOUT))!($D(DTOUT)) END
|
|---|
| 25 | I $D(IO("Q")) G QUE
|
|---|
| 26 | U IO
|
|---|
| 27 | DEQUE ;
|
|---|
| 28 | S LREND=0 W:$E(IOST,1,2)="C-" @IOF
|
|---|
| 29 | I $D(ZTDEQUED) S ZTREQ="@"
|
|---|
| 30 | S LRHD=LRANS_" Listing "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")
|
|---|
| 31 | S LRPG=0 D HD
|
|---|
| 32 | S LRN="" F S LRN=$O(LRCODE(LRN)) Q:LRN=""!($G(LREND)) D
|
|---|
| 33 | . K ^TMP("LROUT",$J) D FIND^DIC(64,"","@;.01;1;IX",$S(LRAN=4:"XQ",1:"QM"),$P(LRN,"-"),"",$S(LRAN=4:"AH^AI",1:"AB"),"","","^TMP(""LROUT"",$J)")
|
|---|
| 34 | . I '$O(^TMP("LROUT",$J,"DILIST",0)) D Q
|
|---|
| 35 | . . D TOP Q:$G(LREND)
|
|---|
| 36 | . . W !!?2,$TR(LRN,";(-"," ")_$P(LRCODE(LRN),U),!?5," [ IS NOT LINKED ]"
|
|---|
| 37 | . I $O(^TMP("LROUT",$J,"DILIST",0)) D
|
|---|
| 38 | . . D TOP Q:$G(LREND)
|
|---|
| 39 | . . W !!?2,$TR(LRN,";("," ")_$P(LRCODE(LRN),U)_" linked to:"
|
|---|
| 40 | . . S LRX=0 F S LRX=$O(^TMP("LROUT",$J,"DILIST",2,LRX)) Q:LRX<1 Q:LREND D
|
|---|
| 41 | . . . S LRIEN=^TMP("LROUT",$J,"DILIST",2,LRX)
|
|---|
| 42 | . . . S LRANOUT=^TMP("LROUT",$J,"DILIST","ID",LRX,1)_" "_^TMP("LROUT",$J,"DILIST","ID",LRX,.01)
|
|---|
| 43 | . . . D TOP Q:$G(LREND) W !?4,LRIEN,?15,$E(LRANOUT,1,64)
|
|---|
| 44 | G:$D(DTOUT)!($D(DUOUT)) END
|
|---|
| 45 | W !?10,"Finished"
|
|---|
| 46 | END ;
|
|---|
| 47 | W ! I $E(IOST,1,2)="P-" W @IOF
|
|---|
| 48 | D ^%ZISC
|
|---|
| 49 | Q:$G(LRDEBUG)
|
|---|
| 50 | K DA,DIR,DIRUT,DTOUT,DUOUT,LRAN,LRANOUT,LRANS,LRCODE,LRCPT,LREND
|
|---|
| 51 | K LRGLB,LRHD,LRIEN,LRN,LRPG,LRX,POP,X,Y
|
|---|
| 52 | K ZTDEQUED,ZTREQ,ZTSK,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSTOP
|
|---|
| 53 | K ^TMP("LROUT",$J) D CLEAN^DILF
|
|---|
| 54 | Q
|
|---|
| 55 | TOP ;
|
|---|
| 56 | I $$S^%ZTLOAD("Report Stopped") S (ZTSTOP,LREND)=1 Q
|
|---|
| 57 | N DIR
|
|---|
| 58 | Q:$Y<(IOSL-4)
|
|---|
| 59 | I $E(IOST,1,2)="P-" G HD
|
|---|
| 60 | N DIR
|
|---|
| 61 | S DIR(0)="E" D ^DIR
|
|---|
| 62 | S:$D(DTOUT)!($D(DUOUT)) LREND=1
|
|---|
| 63 | I $G(LREND) W !! Q
|
|---|
| 64 | HD ;
|
|---|
| 65 | S LRPG=$G(LRPG)+1
|
|---|
| 66 | W:$G(LRN)'="" @IOF
|
|---|
| 67 | W !!,$$CJ^XLFSTR(LRHD_" Page: "_LRPG,IOM)
|
|---|
| 68 | I $G(LRN)'="" W !?2,$TR(LRN,";("," ")_$P(LRCODE(LRN),U)_" linked to:"
|
|---|
| 69 | Q
|
|---|
| 70 | QUE ;
|
|---|
| 71 | K ZTDTH
|
|---|
| 72 | S ZTRTN="DEQUE^LRCAP64S",ZTSAVE("LR*")=""
|
|---|
| 73 | S ZTDESC="Lab List of codes from LAM"
|
|---|
| 74 | S ZTIO=ION D ^%ZTLOAD
|
|---|
| 75 | I $G(ZTSK) W !,$$CJ^XLFSTR("Queued to "_ION,80)
|
|---|
| 76 | G END
|
|---|
| 77 | Q
|
|---|
