| 1 | LR7OB630 ;slc/dcm - Get Lab data from 63 only ;8/11/97
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
|
|---|
| 3 | EN(LABPAT,SS,IDT) ;Get data from 63
|
|---|
| 4 | ;LABPAT=Lab Patient ID
|
|---|
| 5 | ;SS=Subscript CH, MI, EM, CY, AU, SP, BB
|
|---|
| 6 | ;IDT=Inverse D/T verified
|
|---|
| 7 | Q:'$G(LABPAT)!('$G(IDT))!('$L($G(SS)))
|
|---|
| 8 | N GOTCOM
|
|---|
| 9 | I $L($T(@SS)) G @SS
|
|---|
| 10 | Q
|
|---|
| 11 | CH ;Chem, Hem, Tox, Ria, Ser, etc.
|
|---|
| 12 | N Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,ACC,AC,ACD,ACN,X,X0
|
|---|
| 13 | Q:'$D(^LR(LABPAT,SS,IDT)) S X0=^(IDT,0)
|
|---|
| 14 | D DFN
|
|---|
| 15 | S (AC,Y1,Y3,Y4,Y11)="",Y2=+X0,Y5=+X0,Y6="",Y7=$P(X0,"^",11),Y8=+X0,Y9=$P(X0,"^",3),Y10=$P(X0,"^",5),Y12=$P(X0,"^",4),ACC=$P(X0,"^",6)
|
|---|
| 16 | I $L(ACC) S X=$P(ACC," "),X=$O(^LRO(68,"B",X,0)) I X S AC=X,ACD=+$P(X0,"."),ACN=$P(ACC," ",3) S:'$D(^LRO(68,AC,1,ACD,1,ACN)) AC=""
|
|---|
| 17 | I AC D 68 Q
|
|---|
| 18 | D 69,63^LR7OB63(1,LRDFN,SS,IDT)
|
|---|
| 19 | Q
|
|---|
| 20 | MI ;Microbiology
|
|---|
| 21 | N Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,ACC,AC,ACD,ACN,X,X0
|
|---|
| 22 | Q:'$D(^LR(LABPAT,SS,IDT)) S X0=^(IDT,0)
|
|---|
| 23 | D DFN
|
|---|
| 24 | S (AC,Y1,Y4,Y5,Y11)="",Y2=+X0,Y3=$P(X0,"^",11),Y6=$P(X0,"^",7),Y7=$P(X0,"^",8),Y8=$P(X0,"^",10),Y9=$P(X0,"^",3),Y10=$P(X0,"^",5),Y12=$P(X0,"^",4),ACC=$P(X0,"^",6)
|
|---|
| 25 | I $L(ACC) S X=$P(ACC," "),X=$O(^LRO(68,"B",X,0)) I X S AC=X,ACD=+$P(X0,"."),ACN=$P(ACC," ",3) S:'$D(^LRO(68,AC,1,ACD,1,ACN)) AC=""
|
|---|
| 26 | I AC D 68 Q
|
|---|
| 27 | D 69,63^LR7OB63(1,LRDFN,SS,IDT)
|
|---|
| 28 | Q
|
|---|
| 29 | BB ;Blood bank
|
|---|
| 30 | N Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,ACC,AC,ACD,ACN,X,X0
|
|---|
| 31 | Q:'$D(^LR(LABPAT,SS,IDT)) S X0=^(IDT,0)
|
|---|
| 32 | D DFN
|
|---|
| 33 | S (AC,Y1,Y4,Y5,Y11)="",Y2=+X0,Y3=$P(X0,"^",11),Y6=$P(X0,"^",7),Y7=$P(X0,"^",4),Y8=$P(X0,"^",10),Y9=$P(X0,"^",3),Y10=$P(X0,"^",5),Y12=$P(X0,"^",4),ACC=$P(X0,"^",6)
|
|---|
| 34 | I $L(ACC) S X=$P(ACC," "),X=$O(^LRO(68,"B",X,0)) I X S AC=X,ACD=+$P(X0,"."),ACN=$P(ACC," ",3) S:'$D(^LRO(68,AC,1,ACD,1,ACN)) AC=""
|
|---|
| 35 | I AC D 68 Q
|
|---|
| 36 | D 69,63^LR7OB63(1,LRDFN,SS,IDT)
|
|---|
| 37 | Q
|
|---|
| 38 | EM ;Electron Microscopy
|
|---|
| 39 | G CY
|
|---|
| 40 | SP ;Surgical Pathology
|
|---|
| 41 | G CY
|
|---|
| 42 | CY ;Cytology
|
|---|
| 43 | N Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,ACC,AC,ACD,ACN,X,X0
|
|---|
| 44 | Q:'$D(^LR(LABPAT,SS,IDT)) S X0=^(IDT,0)
|
|---|
| 45 | D DFN
|
|---|
| 46 | S (AC,Y1,Y3,Y4,Y5,Y10,Y11)="",Y2=+X0,Y6=$P(X0,"^",7),Y7=$P(X0,"^",8),Y8=$P(X0,"^",10),Y9=$P(X0,"^",3),Y12=$P(X0,"^",4),ACC=$P(X0,"^",6)
|
|---|
| 47 | I $L(ACC) S X=$P(ACC," "),X=$O(^LRO(68,"B",X,0)) I X S AC=X,ACD=+$P(X0,"."),ACN=$P(ACC," ",3) S:'$D(^LRO(68,AC,1,ACD,1,ACN)) AC=""
|
|---|
| 48 | I AC D 68 Q
|
|---|
| 49 | D 69,63^LR7OB63(1,LRDFN,SS,IDT)
|
|---|
| 50 | Q
|
|---|
| 51 | AU ;Autopsy
|
|---|
| 52 | N X,X0,Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12
|
|---|
| 53 | Q:'$D(^LR(LABPAT,SS)) S X0=^(SS)
|
|---|
| 54 | D DFN
|
|---|
| 55 | S (Y1,Y3,Y4,Y5,Y8,Y10,Y11,Y12)="",Y2=+X0,Y6=$P(X0,"^",12),Y7=$P(X0,"^",5),Y9=$P(X0,"^",3)
|
|---|
| 56 | D 69,63^LR7OB63(1,LRDFN,SS)
|
|---|
| 57 | Q
|
|---|
| 58 | DFN ;Get patient stuff
|
|---|
| 59 | S:'$D(DFN) DFN=$P(^LR(LABPAT,0),"^",3) S:'$D(LRDFN) LRDFN=LABPAT S:'$D(LRDPF) LRDPF=$P(^LR(LABPAT,0),"^",2)_$G(^DIC(+$P(^LR(LABPAT,0),"^",2),0,"GL"))
|
|---|
| 60 | Q
|
|---|
| 61 | 69 ;Set lrx(69
|
|---|
| 62 | S ^TMP("LRX",$J,69)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^"_Y7_"^"_Y8_"^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12,^TMP("LRX",$J,69,1)=""
|
|---|
| 63 | Q
|
|---|
| 64 | 68 ;Go get data from file 68
|
|---|
| 65 | D A68^LR7OB68(ACD,AC,ACN)
|
|---|
| 66 | Q
|
|---|
