92 lines
4.1 KiB
Mathematica
92 lines
4.1 KiB
Mathematica
LRAPCUM ;AVAMC/REG/KLL - AP PATIENT CUM ;9/25/00
|
|
;;5.2;LAB SERVICE;**34,72,173,248,259**;Sep 27, 1994
|
|
;
|
|
;Reference to ^%ZIS supported by IA #10086
|
|
;Reference to ^DIWP supported by IA #10011
|
|
;Reference to ^DIWW supported by IA #10029
|
|
;
|
|
S IOP="HOME" D ^%ZIS,L^LRU
|
|
W !!?15,LRAA(1)," PATIENT REPORT(S) DISPLAY"
|
|
P W ! S LR("Q")=0 K DIC D ^LRDPA Q:LRDFN=-1 D R G P
|
|
;
|
|
R W !!,"Is this the patient " S %=1 D YN^LRU Q:%'=1
|
|
I '$D(^LR(LRDFN,LRSS)) W $C(7),!!,"No ",LRAA(1)," reports on file",! Q
|
|
D S F LRI=0:0 W @IOF S LRA(1)=21,LRI=$O(^LR(LRDFN,LRSS,LRI)) Q:'LRI S B=$G(^(LRI,0)) I B D W Q:LRA(2)?1P
|
|
Q
|
|
C S C=0 F LRZ=0:1 S C=$O(^LR(LRDFN,LRSS,LRI,LRV,C)) Q:'C D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P W !?2,$P(^LR(LRDFN,LRSS,LRI,LRV,C,0),U)
|
|
Q
|
|
F D E
|
|
K ^UTILITY($J,"W")
|
|
S C=0 F LRZ=0:1 S C=$O(^LR(LRDFN,LRSS,LRI,LRV,C)) Q:'C!(LRA(2)?1P) D
|
|
.D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
|
|
.S X=^LR(LRDFN,LRSS,LRI,LRV,C,0),X=$P(X,U)
|
|
.D ^DIWP
|
|
Q:LRA(2)?1P D:LRZ ^DIWW
|
|
Q
|
|
E K ^TMP($J) S DIWL=3,DIWR=IOM-3,DIWF="W" Q
|
|
W S Y=+B D D^LRU S LRW(1)=Y,Y=$P(B,"^",10) D D^LRU S LRW(10)=Y,Y=$P(B,"^",3) D D^LRU S LRW(3)=Y,X=$P(B,"^",2) D:X D^LRUA S LRW(2)=X,LRW(11)=$P(B,"^",11)
|
|
S X=$P(B,"^",4) D:X D^LRUA S LRW(4)=X,X=$P(B,"^",7) D:X D^LRUA S LRW(7)=X
|
|
W !,"Date Spec taken: ",LRW(1),?38,"Pathologist:",LRW(2),!,"Date Spec rec'd: ",LRW(10),?38,$S(LRSS="SP":"Resident: ",1:"Tech: "),LRW(4)
|
|
W !,$S($L(LRW(3)):"Date completed: ",1:"REPORT INCOMPLETE"),LRW(3),?38,"Accession #: ",$P(B,"^",6),!,"Submitted by: ",$P(B,"^",5),?38,"Practitioner:",LRW(7),!,LR("%")
|
|
I LRW(11)="" D A W !,$C(7),"Report not verified",! G MORE
|
|
I $D(^LR(LRDFN,LRSS,LRI,.1)) W !,"Specimen: " S LRV=.1 D C Q:LRA(2)?1P
|
|
I $D(^LR(LRDFN,LRSS,LRI,.2)) W !,"Brief Clinical History:" S LRV=.2 D F Q:LRA(2)?1P
|
|
I $D(^LR(LRDFN,LRSS,LRI,.3)) W !,"Preoperative Diagnosis:" S LRV=.3 D F Q:LRA(2)?1P
|
|
I $D(^LR(LRDFN,LRSS,LRI,.4)) W !,"Operative Findings:" S LRV=.4 D F Q:LRA(2)?1P
|
|
I $D(^LR(LRDFN,LRSS,LRI,.5)) W !,"Postoperative Diagnosis:" S LRV=.5 D F Q:LRA(2)?1P
|
|
D SET^LRUA
|
|
I $O(^LR(LRDFN,LRSS,LRI,1.3,0)) D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P W !,LR(69.2,.13) I $P($G(^LR(LRDFN,LRSS,LRI,6,0)),U,4) S LR(0)=6 D ^LRSPRPTM
|
|
S LRV=1.3 D F Q:LRA(2)?1P
|
|
I $O(^LR(LRDFN,LRSS,LRI,1,0)) D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P W !,LR(69.2,.03) I $P($G(^LR(LRDFN,LRSS,LRI,7,0)),U,4) S LR(0)=7 D ^LRSPRPTM
|
|
S LRV=1 D F Q:LRA(2)?1P
|
|
I $O(^LR(LRDFN,LRSS,LRI,1.1,0)) D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P W !,LR(69.2,.04)," (Date Spec taken: ",LRW(1),")" I $P($G(^LR(LRDFN,LRSS,LRI,4,0)),U,4) S LR(0)=4 D ^LRSPRPTM
|
|
S LRV=1.1 D F Q:LRA(2)?1P I $O(^LR(LRDFN,LRSS,LRI,1.4,0)) D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P W !,LR(69.2,.14) I $P($G(^LR(LRDFN,LRSS,LRI,5,0)),U,4) S LR(0)=5 D ^LRSPRPTM
|
|
S LRV=1.4 D F Q:LRA(2)?1P
|
|
I $O(^LR(LRDFN,LRSS,LRI,1.2,0)) D
|
|
.W !,"Supplementary Report:"
|
|
.F C=0:0 S C=$O(^LR(LRDFN,LRSS,LRI,1.2,C)) Q:'C!(LRA(2)?1P) D
|
|
..S X=^(C,0),Y=+X,X=$P(X,U,2) D D^LRU
|
|
..W !?3,"Date: ",Y W:'X " not verified"
|
|
..D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
|
|
..I X,$P($G(^LR(LRDFN,LRSS,LRI,1.2,C,2,0)),U,4) D
|
|
...S LRV=C,LR("Q")=LRA(2)
|
|
...D SUPA^LRSPRPT
|
|
...S LRA(2)=LR("Q")
|
|
..D:X U Q:LRA(2)?1P
|
|
Q:LRA(2)?1P
|
|
;USER MUST POSSESS THE LRLAB KEY TO VIEW SNOMED CODES
|
|
I $D(^LR(LRDFN,LRSS,LRI,2)) D
|
|
.D B
|
|
.I $D(^XUSEC("LRLAB",DUZ)) D ^LRAPCUM1
|
|
Q:LRA(2)?1P D MORE Q
|
|
MORE R !,"'^' TO STOP: ",LRA(2):DTIME I LRA(2)["?" W $C(7) G MORE
|
|
I LRA(2)?1P S A=0 Q
|
|
S LRA(1)=LRA(1)+21
|
|
W $C(13),$J("",15),$C(13)
|
|
Q
|
|
S S (A,LRA(2))=0 Q
|
|
U D E
|
|
K ^UTILITY($J,"W")
|
|
S E=0
|
|
F LRZ=0:1 S E=$O(^LR(LRDFN,LRSS,LRI,1.2,C,1,E)) Q:'E!(LRA(2)?1P) D
|
|
.D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
|
|
.S X=^LR(LRDFN,LRSS,LRI,1.2,C,1,E,0)
|
|
.D ^DIWP
|
|
Q:LRA(2)?1P D:LRZ ^DIWW
|
|
Q
|
|
B F C=0:0 S C=$O(^LR(LRDFN,LRSS,LRI,2,C)) Q:'C!(LRA(2)?1P) D SP
|
|
Q
|
|
SP F G=0:0 S G=$O(^LR(LRDFN,LRSS,LRI,2,C,5,G)) Q:'G S X=^(G,0),Y=$P(X,"^",2),E=$P(X,"^",3),E(1)=$P(X,"^")_":",E(1)=$P($P(LR(LRSS),E(1),2),";") D D^LRU S T(2)=Y D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P D WP
|
|
Q
|
|
WP W !,E(1)," ",E," Date: ",T(2)," ",!
|
|
D E
|
|
K ^UTILITY($J,"W")
|
|
S F=0
|
|
F LRZ=0:1 S F=$O(^LR(LRDFN,LRSS,LRI,2,C,5,G,1,F)) Q:'F!(LRA(2)?1P) D
|
|
.D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
|
|
.S X=^LR(LRDFN,LRSS,LRI,2,C,5,G,1,F,0) D ^DIWP
|
|
Q:LRA(2)?1P D:LRZ ^DIWW
|
|
Q
|
|
A S A=0 F S A=$O(^LR(LRDFN,LRSS,LRI,97,A)) Q:'A W !,^(A,0)
|
|
Q
|