source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSLRCP.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1GMTSLRCP ; SLC/JER,KER - Cytopathology Comp Dvr ; 09/21/2001
2 ;;2.7;Health Summary;**28,47**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 525 ^LR( all fields
6 ; DBIA 10035 ^DPT( field 63 Read w/Fileman
7 ; DBIA 2056 $$GET1^DIQ (file 2)
8 ;
9MAIN ; Cytopathology
10 N GMI,IX,IX0,IX1,MAX,LRDFN
11 S LRDFN=+($$GET1^DIQ(2,(+($G(DFN))_","),63,"I")) Q:+LRDFN=0 Q:'$D(^LR(LRDFN))
12 S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999) D ^GMTSLRPE
13 Q:'$D(^TMP("LRCY",$J)) S IX=""
14 F GMI=1:1:MAX S IX=$O(^TMP("LRCY",$J,IX)) Q:IX="" D Q:$D(GMTSQIT)
15 . D:GMI>1 CKP^GMTSUP Q:$D(GMTSQIT) W:GMI>1&'GMTSNPG ! S IX0=""
16 . F S IX0=$O(^TMP("LRCY",$J,IX,IX0)) Q:IX0="" D Q:$D(GMTSQIT)
17 . . D TRVRS
18 K ^TMP("LRCY",$J)
19 Q
20TRVRS ; Traverses/Interprets ^TMP("LRCY",$J,
21 N GMS,SPEC
22 I IX0=0 D CKP^GMTSUP Q:$D(GMTSQIT) W ?8,"Collected:",?19,$P(^TMP("LRCY",$J,IX,IX0),U),?31,"Acc:",?36,$P(^TMP("LRCY",$J,IX,IX0),U,2),! Q
23 I IX0=1 D CKP^GMTSUP Q:$D(GMTSQIT) W ?9,"Specimen:" S GMS=0 F S GMS=$O(^TMP("LRCY",$J,IX,IX0,GMS)) Q:GMS'>0 D CKP^GMTSUP Q:$D(GMTSQIT) W ?19,^TMP("LRCY",$J,IX,IX0,GMS),!
24 I IX0=1,($P(^TMP("LRCY",$J,IX,IX0),U,2)'>0) D CKP^GMTSUP Q:$D(GMTSQIT) W ?18,"** REPORT NOT YET RELEASED **",!
25 Q:IX0=1 D @$E(IX0,1,2)
26 Q
27AH ; Writes clinical history
28 N GMTSH,GMTSHL,GMTSHLI
29 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Brief Clinical Hx:",!
30 S GMTSH=0
31 F S GMTSH=$O(^TMP("LRCY",$J,IX,IX0,GMTSH)) Q:+GMTSH'>0 S GMTSHL=^(GMTSH) D
32 .I $L(GMTSHL)>78 S GMTSHL=$$WRAP^GMTSORC(GMTSHL,78)
33 .D CKP^GMTSUP Q:$D(GMTSQIT) W $P(GMTSHL,"|"),! D
34 ..F GMTSHLI=2:1:$L(GMTSHL,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSHL,"|",GMTSHLI)]"" $P(GMTSHL,"|",GMTSHLI),!
35 Q
36G ; Writes Gross Description
37 N GMTSG,GMTSGL,GMTSGLI
38 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Gross Description:",!
39 S GMTSG=0
40 F S GMTSG=$O(^TMP("LRCY",$J,IX,IX0,GMTSG)) Q:GMTSG'>0 S GMTSGL=^(GMTSG) D
41 .I $L(GMTSGL)>78 S GMTSGL=$$WRAP^GMTSORC(GMTSGL,78)
42 .D CKP^GMTSUP Q:$D(GMTSQIT) W $P(GMTSGL,"|"),! D
43 ..F GMTSGLI=2:1:$L(GMTSGL,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSGL,"|",GMTSGLI)]"" $P(GMTSGL,"|",GMTSGLI),!
44 Q
45MI ; Writes Microscopic exam/diagnosis field
46 N GMTSM,GMTSML,GMTSMLI
47 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Microscopic exam:",!
48 S GMTSM=0
49 F S GMTSM=$O(^TMP("LRCY",$J,IX,IX0,GMTSM)) Q:GMTSM'>0 S GMTSML=^(GMTSM) D
50 . I $L(GMTSML)>78 S GMTSML=$$WRAP^GMTSORC(GMTSML,78)
51 . D CKP^GMTSUP Q:$D(GMTSQIT) W $P(GMTSML,"|"),! D
52 . . F GMTSMLI=2:1:$L(GMTSML,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSML,"|",GMTSMLI)]"" $P(GMTSML,"|",GMTSMLI),!
53 Q
54SR ; Writes Supplementary Reports
55 N GMTSLINE,GMTSL,GMTSR,SRDATE,X S IX1=0
56 F S IX1=$O(^TMP("LRCY",$J,IX,IX0,IX1)) Q:IX1'>0 D Q:$D(GMTSQIT)
57 . D CKP^GMTSUP Q:$D(GMTSQIT) S SRDATE=^TMP("LRCY",$J,IX,IX0,IX1,0)
58 . S X=SRDATE D REGDTM4^GMTSU W !,"Supplementary Rpt: ",X,!
59 . S GMTSR=0
60 . F S GMTSR=$O(^TMP("LRCY",$J,IX,IX0,IX1,GMTSR)) Q:GMTSR'>0 D Q:$D(GMTSQIT)
61 . . S GMTSLINE=^TMP("LRCY",$J,IX,IX0,IX1,GMTSR) I $L(GMTSLINE)>78 S GMTSLINE=$$WRAP^GMTSORC(GMTSLINE,78)
62 . . D CKP^GMTSUP Q:$D(GMTSQIT) W $P(GMTSLINE,"|"),! D
63 . . . F GMTSL=2:1:$L(GMTSLINE,"|") D Q:$D(GMTSQIT)
64 . . . . D CKP^GMTSUP Q:$D(GMTSQIT)
65 . . . . W:$P(GMTSLINE,"|",GMTSL)]"" $P(GMTSLINE,"|",GMTSL),!
66 D CKP^GMTSUP Q:$D(GMTSQIT) W !
67 Q
68ND ; Writes Diagnosis field
69 N GMTSD,GMTSDL,GMTSDLI
70 D CKP^GMTSUP Q:$D(GMTSQIT) W !," Cytopathology Dx:",!
71 S GMTSD=0
72 F S GMTSD=$O(^TMP("LRCY",$J,IX,IX0,GMTSD)) Q:GMTSD'>0 D Q:$D(GMTSQIT)
73 . S GMTSDL=^(GMTSD)
74 . I $L(GMTSDL)>78 S GMTSDL=$$WRAP^GMTSORC(GMTSDL,78)
75 . D CKP^GMTSUP Q:$D(GMTSQIT) W $P(GMTSDL,"|"),!
76 . F GMTSDLI=2:1:$L(GMTSDL,"|") D Q:$D(GMTSQIT)
77 . . D CKP^GMTSUP Q:$D(GMTSQIT)
78 . . W:$P(GMTSDL,"|",GMTSDLI)]"" $P(GMTSDL,"|",GMTSDLI),!
79 Q
80OT ; Traverses/Interprets Organ/Tissue Subarray
81 N OT S OT=0 D CKP^GMTSUP Q:$D(GMTSQIT)
82 W ?7,"Topography:",?19,^TMP("LRCY",$J,IX,IX0,OT),!
83 F S OT=$O(^TMP("LRCY",$J,IX,IX0,OT)) Q:OT="" D @$E(OT,1)
84 Q
85D ; Writes Disease Field
86 D CKP^GMTSUP Q:$D(GMTSQIT)
87 W:OT="D1"!(GMTSNPG) ?9,"Diseases:"
88 W ?21,^TMP("LRCY",$J,IX,IX0,OT),!
89 Q
90M ; Writes Morphology Field
91 N GME
92 D CKP^GMTSUP Q:$D(GMTSQIT)
93 W ?7,"Morphology:",?21,$P(^TMP("LRCY",$J,IX,IX0,OT),U),!
94 D CKP^GMTSUP Q:$D(GMTSQIT)
95 S GME="" F S GME=$O(^TMP("LRCY",$J,IX,IX0,OT,GME)) Q:GME="" D Q:$D(GMTSQIT)
96 . D CKP^GMTSUP Q:$D(GMTSQIT)
97 . W:GME[1!(GMTSNPG) ?9,"Etiology:"
98 . W ?23,^TMP("LRCY",$J,IX,IX0,OT,GME),!
99 Q
100P ; Writes Procedure Field
101 N GMTSJ,GMK S GMTSJ=$P(^TMP("LRCY",$J,IX,IX0,OT),U)
102 D CKP^GMTSUP Q:$D(GMTSQIT)
103 I $L(GMTSJ)>56 S GMTSJ=$$WRAP^GMTSORC(GMTSJ,56)
104 D CKP^GMTSUP Q:$D(GMTSQIT) W:((OT="P1")!(GMTSNPG)) ?7,"Procedures:"
105 W ?21,$P(GMTSJ,"|"),!
106 F GMK=2:1:$L(GMTSJ,"|") D Q:$D(GMTSQIT)
107 . D CKP^GMTSUP Q:$D(GMTSQIT)
108 . W:$P(GMTSJ,"|",GMK)]"" ?23,$P(GMTSJ,"|",GMK),!
109 K ^UTILITY($J,"W")
110 Q
111XI ; Writes ICD diagnoses
112 N GMTSDX D CKP^GMTSUP Q:$D(GMTSQIT) W " ICD-9 Diagnoses:" S GMTSDX=0
113 F S GMTSDX=$O(^TMP("LRCY",$J,IX,IX0,GMTSDX)) Q:GMTSDX="" D Q:$D(GMTSQIT)
114 . D CKP^GMTSUP Q:$D(GMTSQIT) W:GMTSNPG ?2,"ICD-9 Diagnoses:"
115 . W ?19,$P(^TMP("LRCY",$J,IX,IX0,GMTSDX),U)
116 . W ?28,$P(^TMP("LRCY",$J,IX,IX0,GMTSDX),U,2),!
117 Q
Note: See TracBrowser for help on using the repository browser.