1 | GMTSLRAE ; 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 | ;
|
---|
11 | XTRCT ; 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
|
---|
16 | APSET ; 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
|
---|
33 | MPD ; 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
|
---|
39 | M ; 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
|
---|
44 | MSET ; 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
|
---|
50 | D ; 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
|
---|
55 | P ; 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
|
---|
61 | PSET ; 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
|
---|
65 | CLHX ; 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
|
---|
72 | GROSS ; 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
|
---|
79 | MIC ; 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
|
---|
86 | SUPPR ; 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
|
---|
98 | FROZ ; 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
|
---|
105 | SPDX ; 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
|
---|
112 | FORMAT ; Format text - Left Margin 3/Right Margin 78
|
---|
113 | S DIWF="N",DIWL=3,DIWR=78 D ^DIWP
|
---|
114 | Q
|
---|