source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPPF1.m@ 1604

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1LRAPPF1 ;AVAMC/REG/WTY - ANAT PATH FILE PRINT BY PT ;10/16/01
2 ;;5.2;LAB SERVICE;**72,173,201,259,362**;Sep 27, 1994;Build 11
3 ;
4 ;Reference to ^DIC supported by IA #916
5 ;
6 S F=0 F S F=$O(^TMP($J,F)) Q:'F!(LR("Q")) D
7 .S F(1)=$P(^DIC(F,0),"^"),F(2)=^DIC(F,0,"GL")
8 .K LR("F") D H S LR("F")=1 D W
9 Q:LR("Q")
10 D ^LRAPPF2
11 Q
12W S W=0 F LRB=0:0 S W=$O(^TMP($J,F,W)) Q:W=""!(LR("Q")) D LR
13 Q
14LR F LRDFN=0:0 S LRDFN=$O(^TMP($J,F,W,LRDFN)) Q:'LRDFN!(LR("Q")) D NM
15 Q
16NM S X=^LR(LRDFN,0),LRDPF=$P(X,U,2),N=$P(X,"^",3),N=@(F(2)_N_",0)")
17 S LRP=$P(N,"^"),SSN=$P(N,"^",9),Y=$P(N,"^",3)
18 D D^LRU,SSN^LRU S DOB=$S(Y'[1700:Y,1:"")
19 D:$Y>(IOSL-4) H Q:LR("Q")
20 W !!,LRP,?31,SSN W:$L(DOB) ?51,"BORN: ",DOB
21 S LRI=0 F S LRI=$O(^TMP($J,F,W,LRDFN,LRI)) Q:'LRI!(LR("Q")) D
22 .D @($S("CYEMSP"[LRSS:"EN",1:"AUT"))
23 Q
24AUT D:$Y>(IOSL-12) H1 Q:LR("Q")
25 S X=^LR(LRDFN,"AU"),N=$P(X,"^",6),Y=+X D D^LRU S LRH(3)=Y,DA=LRDFN
26 D D^LRAUAW S Y=LR(63,12) D D^LRU S E=Y,H(2)=$E(H(1),1,3)
27 W !,"AUTOPSY #: ",N," AUTOPSY DATE: ",LRH(3),?51,"DIED: ",E
28 D EN^LRAPT2
29 S X=0 F S X=$O(^LR(LRDFN,"AY",X)) Q:'X!(LR("Q")) D
30 .S Y=+^LR(LRDFN,"AY",X,0),Y=$S($D(^LAB(61,Y,0)):$P(^(0),"^"),1:Y)
31 .W !,Y D AM
32 Q
33AM S M=0 F S M=$O(^LR(LRDFN,"AY",X,2,M)) Q:'M!(LR("Q")) D
34 .S Y=+^LR(LRDFN,"AY",X,2,M,0)
35 .S Y=$S($D(^LAB(61.1,Y,0)):$P(^(0),"^"),1:Y)
36 .W !?5,Y
37 Q
38 ;
39EN ;from LRAPT1,LRAPQACN
40 S LRSF515=+$G(LRSF515) ;Indicates that this is generating an SF515
41 S X=$G(^LR(LRDFN,S,LRI,0)) Q:X="" S LR("PATH")=$P(X,U,2),N=$P(X,U,6)
42 S N(11)=$P(X,U,11),X=$P(X,U,10),X=$P(X,"."),LRH(3)=$$Y2K^LRX(X)
43 S H(2)=$E(X,1,3)
44 I LR("PATH")]"" D
45 .S LR("PATH")=$$EXTERNAL^DILFD(LRSF,.02,"",LR("PATH"),LR("PATH"))
46 S:N="" N="?" S:'H(2) H(2)="?"
47 I LRSF515 D:$Y>(IOSL-13) F^LRAPF,^LRAPF
48 I 'LRSF515 D:$Y>(IOSL-4) H1
49 Q:LR("Q")
50 W !?2,"Organ/tissue:",?17,"Date rec'd: ",LRH(3),?43,"Acc #:",N
51 W ?64,$E(LR("PATH"),1,12)
52 I 'N(11) W !?5,"Report not verified." Q
53 ;SNOMED codes
54 I '+$G(LR("SPSM")) D Q:LR("Q")
55 .S O=0 F S O=$O(^LR(LRDFN,S,LRI,2,O)) Q:'O!(LR("Q")) D
56 ..D:$Y>(IOSL-4) H2
57 ..Q:LR("Q")
58 ..S X=^LR(LRDFN,S,LRI,2,O,0),W(3)=$P(X,"^",3)
59 ..S O(6)=$P(^LAB(61,+X,0),"^")
60 ..W !?5,O(6) W:W(3) " ",W(3)," gm" D L
61 ;Comments
62 I $D(LRQ(3)) D
63 .S B=0 F S B=$O(^LR(LRDFN,S,LRI,99,B)) Q:'B!(LR("Q")) D
64 ..W !?5,$E(^LR(LRDFN,S,LRI,99,B,0),1,74)
65 ..I LRSF515 D:$Y>(IOSL-13) F^LRAPF,^LRAPF
66 Q
67L S B=0 F S B=$O(^LR(LRDFN,S,LRI,2,O,3,B)) Q:'B!(LR("Q")) D
68 .S B(1)=+^LR(LRDFN,S,LRI,2,O,3,B,0)
69 .D:$Y>(IOSL-4) H3 Q:LR("Q")
70 .W !?10,$P(^LAB(61.3,B(1),0),"^")
71 S B=0 F S B=$O(^LR(LRDFN,S,LRI,2,O,4,B)) Q:'B!(LR("Q")) D
72 .S X=^LR(LRDFN,S,LRI,2,O,4,B,0),B(1)=+X,B(2)=$P(X,"^",2)
73 .D:$Y>(IOSL-4) H3 Q:LR("Q")
74 .W !?10,$P(^LAB(61.5,B(1),0),"^")
75 .W:B(2)]"" " (",$S(B(2)=0:"Negative",B(2)=1:"Positive",1:"?"),")"
76 S B=0 F S B=$O(^LR(LRDFN,S,LRI,2,O,1,B)) Q:'B!(LR("Q")) D
77 .S B(1)=+^LR(LRDFN,S,LRI,2,O,1,B,0)
78 .D:$Y>(IOSL-4) H3 Q:LR("Q")
79 .W !?10,$P(^LAB(61.4,B(1),0),"^")
80 S M=0 F S M=$O(^LR(LRDFN,S,LRI,2,O,2,M)) Q:'M!(LR("Q")) D
81 .S M(1)=+^LR(LRDFN,S,LRI,2,O,2,M,0)
82 .D:$Y>(IOSL-4) H3 Q:LR("Q")
83 .W !?10,$P(^LAB(61.1,M(1),0),"^") D E
84 S E=0 F S E=$O(^LR(LRDFN,S,LRI,2,O,5,E)) Q:'E!(LR("Q")) D
85 .S E(1)=^LR(LRDFN,S,LRI,2,O,5,E,0) D A
86 Q
87A S Y=$P(E(1),"^",2),E(3)=$P(E(1),"^",3),E(4)=$P(E(1),"^")_":"
88 S E(4)=$P($P(LR(S),E(4),2),";") D D^LRU S E(2)=Y D D^LRU
89 D:$Y>(IOSL-12) H3 Q:LR("Q")
90 W !?5,E(4)," ",E(3)," Date: ",E(2)
91 Q
92 ;
93E S E=0 F S E=$O(^LR(LRDFN,S,LRI,2,O,2,M,1,E)) Q:'E!(LR("Q")) D
94 .W !?12,$P(^LAB(61.2,+^LR(LRDFN,S,LRI,2,O,2,M,1,E,0),0),"^")
95 Q
96H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
97 Q:$A(IOST)'=80 I $D(LRQ(2)) D H^LRSPT Q
98 I $D(LRQ(9)) D H^LRAPT1 Q
99 D F^LRU W !,LRO(68)," "
100 W:F(2)'="^DPT(" !,"Demographic data in ",F(1)," file."
101 W !,"Entries listed by PATIENT (From: ",LRSTR," to: ",LRLST,")"
102 W !,"Name",?31,"Identifier"
103 W !,LR("%")
104 Q
105H1 Q:$A(IOST)'=80
106 D H W:'$D(LRQ(9)) !,LRP,?30,SSN,?42,DOB
107 Q
108H2 Q:$A(IOST)'=80 D H1
109 W !?5,"Organ/tissue:",?25,"Date received: ",LRH(3),?51,"Acc #:",N
110 Q
111H3 Q:$A(IOST)'=80 D H2
112 W !?5,O(6) W:W(3) " ",W(3)," gm"
113 Q
Note: See TracBrowser for help on using the repository browser.