67 lines
2.7 KiB
Mathematica
67 lines
2.7 KiB
Mathematica
LR7OB630 ;slc/dcm - Get Lab data from 63 only ;8/11/97
|
|
;;5.2;LAB SERVICE;**121**;Sep 27, 1994
|
|
EN(LABPAT,SS,IDT) ;Get data from 63
|
|
;LABPAT=Lab Patient ID
|
|
;SS=Subscript CH, MI, EM, CY, AU, SP, BB
|
|
;IDT=Inverse D/T verified
|
|
Q:'$G(LABPAT)!('$G(IDT))!('$L($G(SS)))
|
|
N GOTCOM
|
|
I $L($T(@SS)) G @SS
|
|
Q
|
|
CH ;Chem, Hem, Tox, Ria, Ser, etc.
|
|
N Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,ACC,AC,ACD,ACN,X,X0
|
|
Q:'$D(^LR(LABPAT,SS,IDT)) S X0=^(IDT,0)
|
|
D DFN
|
|
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)
|
|
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=""
|
|
I AC D 68 Q
|
|
D 69,63^LR7OB63(1,LRDFN,SS,IDT)
|
|
Q
|
|
MI ;Microbiology
|
|
N Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,ACC,AC,ACD,ACN,X,X0
|
|
Q:'$D(^LR(LABPAT,SS,IDT)) S X0=^(IDT,0)
|
|
D DFN
|
|
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)
|
|
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=""
|
|
I AC D 68 Q
|
|
D 69,63^LR7OB63(1,LRDFN,SS,IDT)
|
|
Q
|
|
BB ;Blood bank
|
|
N Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,ACC,AC,ACD,ACN,X,X0
|
|
Q:'$D(^LR(LABPAT,SS,IDT)) S X0=^(IDT,0)
|
|
D DFN
|
|
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)
|
|
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=""
|
|
I AC D 68 Q
|
|
D 69,63^LR7OB63(1,LRDFN,SS,IDT)
|
|
Q
|
|
EM ;Electron Microscopy
|
|
G CY
|
|
SP ;Surgical Pathology
|
|
G CY
|
|
CY ;Cytology
|
|
N Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,ACC,AC,ACD,ACN,X,X0
|
|
Q:'$D(^LR(LABPAT,SS,IDT)) S X0=^(IDT,0)
|
|
D DFN
|
|
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)
|
|
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=""
|
|
I AC D 68 Q
|
|
D 69,63^LR7OB63(1,LRDFN,SS,IDT)
|
|
Q
|
|
AU ;Autopsy
|
|
N X,X0,Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12
|
|
Q:'$D(^LR(LABPAT,SS)) S X0=^(SS)
|
|
D DFN
|
|
S (Y1,Y3,Y4,Y5,Y8,Y10,Y11,Y12)="",Y2=+X0,Y6=$P(X0,"^",12),Y7=$P(X0,"^",5),Y9=$P(X0,"^",3)
|
|
D 69,63^LR7OB63(1,LRDFN,SS)
|
|
Q
|
|
DFN ;Get patient stuff
|
|
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"))
|
|
Q
|
|
69 ;Set lrx(69
|
|
S ^TMP("LRX",$J,69)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^"_Y7_"^"_Y8_"^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12,^TMP("LRX",$J,69,1)=""
|
|
Q
|
|
68 ;Go get data from file 68
|
|
D A68^LR7OB68(ACD,AC,ACN)
|
|
Q
|