source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPCUM.m@ 938

Last change on this file since 938 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1LRAPCUM ;AVAMC/REG/KLL - AP PATIENT CUM ;9/25/00
2 ;;5.2;LAB SERVICE;**34,72,173,248,259**;Sep 27, 1994
3 ;
4 ;Reference to ^%ZIS supported by IA #10086
5 ;Reference to ^DIWP supported by IA #10011
6 ;Reference to ^DIWW supported by IA #10029
7 ;
8 S IOP="HOME" D ^%ZIS,L^LRU
9 W !!?15,LRAA(1)," PATIENT REPORT(S) DISPLAY"
10P W ! S LR("Q")=0 K DIC D ^LRDPA Q:LRDFN=-1 D R G P
11 ;
12R W !!,"Is this the patient " S %=1 D YN^LRU Q:%'=1
13 I '$D(^LR(LRDFN,LRSS)) W $C(7),!!,"No ",LRAA(1)," reports on file",! Q
14 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
15 Q
16C 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)
17 Q
18F D E
19 K ^UTILITY($J,"W")
20 S C=0 F LRZ=0:1 S C=$O(^LR(LRDFN,LRSS,LRI,LRV,C)) Q:'C!(LRA(2)?1P) D
21 .D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
22 .S X=^LR(LRDFN,LRSS,LRI,LRV,C,0),X=$P(X,U)
23 .D ^DIWP
24 Q:LRA(2)?1P D:LRZ ^DIWW
25 Q
26E K ^TMP($J) S DIWL=3,DIWR=IOM-3,DIWF="W" Q
27W 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)
28 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
29 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)
30 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("%")
31 I LRW(11)="" D A W !,$C(7),"Report not verified",! G MORE
32 I $D(^LR(LRDFN,LRSS,LRI,.1)) W !,"Specimen: " S LRV=.1 D C Q:LRA(2)?1P
33 I $D(^LR(LRDFN,LRSS,LRI,.2)) W !,"Brief Clinical History:" S LRV=.2 D F Q:LRA(2)?1P
34 I $D(^LR(LRDFN,LRSS,LRI,.3)) W !,"Preoperative Diagnosis:" S LRV=.3 D F Q:LRA(2)?1P
35 I $D(^LR(LRDFN,LRSS,LRI,.4)) W !,"Operative Findings:" S LRV=.4 D F Q:LRA(2)?1P
36 I $D(^LR(LRDFN,LRSS,LRI,.5)) W !,"Postoperative Diagnosis:" S LRV=.5 D F Q:LRA(2)?1P
37 D SET^LRUA
38 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
39 S LRV=1.3 D F Q:LRA(2)?1P
40 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
41 S LRV=1 D F Q:LRA(2)?1P
42 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
43 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
44 S LRV=1.4 D F Q:LRA(2)?1P
45 I $O(^LR(LRDFN,LRSS,LRI,1.2,0)) D
46 .W !,"Supplementary Report:"
47 .F C=0:0 S C=$O(^LR(LRDFN,LRSS,LRI,1.2,C)) Q:'C!(LRA(2)?1P) D
48 ..S X=^(C,0),Y=+X,X=$P(X,U,2) D D^LRU
49 ..W !?3,"Date: ",Y W:'X " not verified"
50 ..D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
51 ..I X,$P($G(^LR(LRDFN,LRSS,LRI,1.2,C,2,0)),U,4) D
52 ...S LRV=C,LR("Q")=LRA(2)
53 ...D SUPA^LRSPRPT
54 ...S LRA(2)=LR("Q")
55 ..D:X U Q:LRA(2)?1P
56 Q:LRA(2)?1P
57 ;USER MUST POSSESS THE LRLAB KEY TO VIEW SNOMED CODES
58 I $D(^LR(LRDFN,LRSS,LRI,2)) D
59 .D B
60 .I $D(^XUSEC("LRLAB",DUZ)) D ^LRAPCUM1
61 Q:LRA(2)?1P D MORE Q
62MORE R !,"'^' TO STOP: ",LRA(2):DTIME I LRA(2)["?" W $C(7) G MORE
63 I LRA(2)?1P S A=0 Q
64 S LRA(1)=LRA(1)+21
65 W $C(13),$J("",15),$C(13)
66 Q
67S S (A,LRA(2))=0 Q
68U D E
69 K ^UTILITY($J,"W")
70 S E=0
71 F LRZ=0:1 S E=$O(^LR(LRDFN,LRSS,LRI,1.2,C,1,E)) Q:'E!(LRA(2)?1P) D
72 .D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
73 .S X=^LR(LRDFN,LRSS,LRI,1.2,C,1,E,0)
74 .D ^DIWP
75 Q:LRA(2)?1P D:LRZ ^DIWW
76 Q
77B F C=0:0 S C=$O(^LR(LRDFN,LRSS,LRI,2,C)) Q:'C!(LRA(2)?1P) D SP
78 Q
79SP 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
80 Q
81WP W !,E(1)," ",E," Date: ",T(2)," ",!
82 D E
83 K ^UTILITY($J,"W")
84 S F=0
85 F LRZ=0:1 S F=$O(^LR(LRDFN,LRSS,LRI,2,C,5,G,1,F)) Q:'F!(LRA(2)?1P) D
86 .D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
87 .S X=^LR(LRDFN,LRSS,LRI,2,C,5,G,1,F,0) D ^DIWP
88 Q:LRA(2)?1P D:LRZ ^DIWW
89 Q
90A S A=0 F S A=$O(^LR(LRDFN,LRSS,LRI,97,A)) Q:'A W !,^(A,0)
91 Q
Note: See TracBrowser for help on using the repository browser.