source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSLRAE.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1GMTSLRAE ; SLC/JER,KER - Surgical Pathology Extract ; 09/21/2001
2 ;;2.7;Health Summary;**3,28,47**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 525 ^LR( all fields
6 ; DBIA 10060 ^VA(200, field .01 Read w/Fileman
7 ; DBIA 2056 $$GET1^DIQ (file #200)
8 ; DBIA 10015 EN^DIQ1 (file 63)
9 ; DBIA 10011 ^DIWP
10 ;
11XTRCT ; Extract Surgical Pathology
12 N IX0,IX,DIWF,DIWL,DIWR K ^TMP("LRA",$J)
13 S IX=GMTS1 F IX0=1:0:MAX S IX=$O(^LR(LRDFN,"SP",IX)) Q:IX'>0!(IX>GMTS2) D APSET
14 K AP
15 Q
16APSET ; Sets ^TMP("LRA",$J
17 N ACC,CDT,DA,DIC,DIQ,DR,GMW,SN,X,YR,SPP
18 S CDT=$P(^LR(LRDFN,"SP",IX,0),U),SPP=$P(^LR(LRDFN,"SP",IX,0),U,7),SPP=$$GET1^DIQ(200,(+SPP_","),.01),ACC=$P(^LR(LRDFN,"SP",IX,0),U,6)
19 I $S(+$P(^LR(LRDFN,"SP",IX,0),U)'>0:1,+$P(^(0),U,11)'>0:1,1:0) Q
20 I $D(ACC) S IX0=IX0+1
21 S X=CDT D REGDTM4^GMTSU S CDT=X K X
22 S ^TMP("LRA",$J,IX,0)=CDT_U_ACC
23 S:$L($G(SPP)) ^TMP("LRA",$J,IX,"SPP")=$G(SPP)
24 I $D(^LR(LRDFN,"SP",IX,.1)) S ^TMP("LRA",$J,IX,.1)="Site/Specimen"
25 S SN=0 F S SN=$O(^LR(LRDFN,"SP",IX,.1,SN)) Q:SN'>0 S ^TMP("LRA",$J,IX,.1,SN)=$P(^LR(LRDFN,"SP",IX,.1,SN,0),U)
26 I $D(^LR(LRDFN,"SP",IX,.2,0)),($P(^(0),U,3)]"") D CLHX
27 I $D(^LR(LRDFN,"SP",IX,1,0)),($P(^(0),U,3)]"") D GROSS
28 I $D(^LR(LRDFN,"SP",IX,1.1,0)),($P(^(0),U,3)]"") D MIC
29 I $D(^LR(LRDFN,"SP",IX,1.2,0)),($P(^(0),U,3)]"") D SUPPR
30 I $D(^LR(LRDFN,"SP",IX,1.3,0)),($P(^(0),U,3)]"") D FROZ
31 I $D(^LR(LRDFN,"SP",IX,1.4,0)),($P(^(0),U,3)]"") D SPDX
32 Q
33MPD ; Morphology, Procedure data and Disease data (not used)
34 S DIC=63,DIQ="AP",DIQ(0)="E",DR(63.08)=10,DR(63.12)=".01;1.5;3;4"
35 S DR(63.16)=".01;1",DR(63.82)=.01,DR(63.17)=.01
36 S DA(63.12)=0,DA(63.08)=IX
37 F S DA(63.12)=$O(^LR(LRDFN,"SP",IX,2,DA(63.12))) Q:DA(63.12)="" D M,P,D
38 Q
39M ; Morphology data
40 N AP S DR=8,DA=LRDFN D EN^DIQ1 I $D(AP(63.12)) S ^TMP("LRA",$J,IX,2)="Topography Data",^(2,DA(63.12))=$S($D(AP(63.12,DA(63.12),.01,"E")):AP(63.12,DA(63.12),.01,"E"),1:"")
41 S DA(63.16)=0 F S DA(63.16)=$O(^LR(LRDFN,"SP",IX,2,DA(63.12),2,DA(63.16))) Q:DA(63.16)="" D EN^DIQ1 I $D(AP(63.16)) D MSET
42 K DA(63.16)
43 Q
44MSET ; Save Morphology data
45 S ^TMP("LRA",$J,IX,2,DA(63.12),2,DA(63.16))=$S($D(AP(63.16,DA(63.16),.01,"E")):AP(63.16,DA(63.16),.01,"E"),1:"") D
46 . S DA(63.17)=0 F S DA(63.17)=$O(^LR(LRDFN,"SP",IX,2,DA(63.12),2,DA(63.16),1,DA(63.17))) Q:DA(63.17)="" D EN^DIQ1 I $D(AP(63.17)) D
47 . . S ^TMP("LRA",$J,IX,2,DA(63.12),2,DA(63.16),1,DA(63.17))=$S($D(AP(63.17,DA(63.17),.01,"E")):AP(63.17,DA(63.17),.01,"E"),1:"")
48 K DA(63.17)
49 Q
50D ; Disease data
51 S DA(63.15)=0 F S DA(63.15)=$O(^LR(LRDFN,"SP",IX,2,DA(63.12),1,DA(63.15))) Q:DA(63.15)="" D EN^DIQ1 I $D(AP(63.15)) D
52 .S ^TMP("LRA",$J,IX,2,DA(63.12),1,DA(63.15))=$S($D(AP(63.15,DA(63.15),.01,"E")):AP(63.15,DA(63.15),.01,"E"),1:"")
53 K DA(63.15)
54 Q
55P ; Procedure data
56 N AP
57 S DA(63.82)=0
58 S DA(63.82)=0 F S DR=8,DA=LRDFN,DA(63.82)=$O(^LR(LRDFN,"SP",IX,2,DA(63.12),4,DA(63.82))) Q:DA(63.82)="" D EN^DIQ1 I $D(AP(63.82)) D PSET
59 K DA(63.82)
60 Q
61PSET ; Save Procedure data
62 S ^TMP("LRA",$J,IX,4)="Procedure Field"
63 S ^TMP("LRA",$J,IX,2,DA(63.12),4,DA(63.82))=$S($D(AP(63.82,DA(63.82),.01,"E")):AP(63.82,DA(63.82),.01,"E"),1:"")
64 Q
65CLHX ; Brief Clinical History text
66 N LN
67 S ^TMP("LRA",$J,IX,.2)="Brief Clinical Hx"
68 K ^UTILITY($J,"W") S LN=0 F S LN=$O(^LR(LRDFN,"SP",IX,.2,LN)) Q:LN'>0 S X=^LR(LRDFN,"SP",IX,.2,LN,0) D FORMAT
69 I $D(^UTILITY($J,"W")) F LN=1:1:^UTILITY($J,"W",3) S ^TMP("LRA",$J,IX,.2,LN)=^UTILITY($J,"W",DIWL,LN,0)
70 K ^UTILITY($J,"W")
71 Q
72GROSS ; Gross Description text
73 N LN
74 S ^TMP("LRA",$J,IX,1)="Gross Description"
75 K ^UTILITY($J,"W") S LN=0 F S LN=$O(^LR(LRDFN,"SP",IX,1,LN)) Q:LN'>0 S X=$P(^LR(LRDFN,"SP",IX,1,LN,0),U) D FORMAT
76 I $D(^UTILITY($J,"W")) F LN=1:1:^UTILITY($J,"W",3) S ^TMP("LRA",$J,IX,1,LN)=^UTILITY($J,"W",DIWL,LN,0)
77 K ^UTILITY($J,"W")
78 Q
79MIC ; Microscopic Exam/Diagnosis text
80 N LN
81 S ^TMP("LRA",$J,IX,1.1)="Microscopic Exam"
82 K ^UTILITY($J,"W") S LN=0 F S LN=$O(^LR(LRDFN,"SP",IX,1.1,LN)) Q:LN'>0 S X=$P(^LR(LRDFN,"SP",IX,1.1,LN,0),U) D FORMAT
83 I $D(^UTILITY($J,"W")) F LN=1:1:^UTILITY($J,"W",3) S ^TMP("LRA",$J,IX,1.1,LN)=^UTILITY($J,"W",DIWL,LN,0)
84 K ^UTILITY($J,"W")
85 Q
86SUPPR ; Supplementary Report date/text
87 N SP1 S ^TMP("LRA",$J,IX,1.2)="Supplementary Report"
88 S SP1=0 F S SP1=$O(^LR(LRDFN,"SP",IX,1.2,SP1)) Q:SP1'>0 D
89 . Q:+$P($G(^LR(LRDFN,"SP",IX,1.2,SP1,0)),U,2)'>0
90 . S ^TMP("LRA",$J,IX,1.2,SP1,0)=$P($G(^LR(LRDFN,"SP",IX,1.2,SP1,0)),U)
91 . K ^UTILITY($J,"W")
92 . S SR=0
93 . F S SR=$O(^LR(LRDFN,"SP",IX,1.2,SP1,1,SR)) Q:SR'>0 D
94 . . S X=$P($G(^LR(LRDFN,"SP",IX,1.2,SP1,1,SR,0)),U) D FORMAT
95 . I $D(^UTILITY($J,"W")) F LN=1:1:^UTILITY($J,"W",3) S ^TMP("LRA",$J,IX,1.2,SP1,LN)=^UTILITY($J,"W",DIWL,LN,0)
96 K ^UTILITY($J,"W")
97 Q
98FROZ ; Frozen Section text
99 N LN
100 S ^TMP("LRA",$J,IX,1.3)="Frozen Section"
101 K ^UTILITY($J,"W") S LN=0 F S LN=$O(^LR(LRDFN,"SP",IX,1.3,LN)) Q:LN'>0 S X=$P(^LR(LRDFN,"SP",IX,1.3,LN,0),U) D FORMAT
102 I $D(^UTILITY($J,"W")) F LN=1:1:^UTILITY($J,"W",3) S ^TMP("LRA",$J,IX,1.3,LN)=^UTILITY($J,"W",DIWL,LN,0)
103 K ^UTILITY($J,"W")
104 Q
105SPDX ; Surgical Pathology DX text
106 N LN
107 S ^TMP("LRA",$J,IX,1.4)="Surgical Path Dx"
108 K ^UTILITY($J,"W") S LN=0 F S LN=$O(^LR(LRDFN,"SP",IX,1.4,LN)) Q:LN'>0 S X=$P(^LR(LRDFN,"SP",IX,1.4,LN,0),U) D FORMAT
109 I $D(^UTILITY($J,"W")) F LN=1:1:^UTILITY($J,"W",3) S ^TMP("LRA",$J,IX,1.4,LN)=^UTILITY($J,"W",DIWL,LN,0)
110 K ^UTILITY($J,"W")
111 Q
112FORMAT ; Format text - Left Margin 3/Right Margin 78
113 S DIWF="N",DIWL=3,DIWR=78 D ^DIWP
114 Q
Note: See TracBrowser for help on using the repository browser.