VistA-FOIAVistA/r/LAB_SERVICE-LR-LS/LR7OB630.m

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