source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSLRA.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1GMTSLRA ; SLC/JER,KER - Surgical Pathology Component ; 09/21/2001
2 ;;2.7;Health Summary;**28,47**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10035 ^DPT( field 63 Read w/Fileman
6 ; DBIA 2056 $$GET1^DIQ (file 2)
7 ;
8MAIN ; Surgical Pathology
9 N GMI,MAX,LRDFN,IX,X,SP,IX0
10 S LRDFN=+($$GET1^DIQ(2,(+($G(DFN))_","),63,"I")) Q:+LRDFN=0
11 S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999) D ^GMTSLRAE
12 I '$D(^TMP("LRA",$J)) Q
13 S IX=0 F GMI=1:1:MAX S IX=$O(^TMP("LRA",$J,IX)) Q:$D(GMTSQIT) Q:IX'>0 D Q:$D(GMTSQIT)
14 . D:GMI>1 CKP^GMTSUP Q:$D(GMTSQIT) W:GMI>1&('GMTSNPG) ! D
15 . . S IX0="" F S IX0=$O(^TMP("LRA",$J,IX,IX0)) Q:IX0=""!(IX0?1A) D
16 . . . S X=^TMP("LRA",$J,IX,IX0)
17 . . . S SP=$G(^TMP("LRA",$J,IX,"SPP")) D WRT
18 . . I $D(^TMP("LRA",$J,IX,1.2)) D SUPPR
19 K ^TMP("LRA",$J)
20 Q
21WRT ; Writes Surgical Pathology Record
22 N IX1,GMJ
23 I IX0=0 D Q
24 . D CKP^GMTSUP Q:$D(GMTSQIT)
25 . W ?8,"Collected:",?19,$P(X,U),?31,"Acc:",?36,$P(X,U,2),!
26 . Q:'$L($G(SP)) D CKP^GMTSUP Q:$D(GMTSQIT)
27 . W "Surgeon/Physician:",?19,$G(SP),!
28 I IX0=.1 D WRTSPC Q
29 I $S(IX0=.2:1,IX0=1:1,IX0=1.1:1,IX0=1.3:1,IX0=1.4:1,1:0) D TEXT Q
30 I IX0=2 S IX1=0 F S IX1=$O(^TMP("LRA",$J,IX,IX0,IX1)) Q:IX1'>0 S X=^(IX1) D WRTTM,WRTP
31 Q
32WRTSPC ; Writes Specimen field entries
33 N GMS
34 D CKP^GMTSUP Q:$D(GMTSQIT) W ?9,"Specimen:"
35 S GMS=0
36 F S GMS=$O(^TMP("LRA",$J,IX,.1,GMS)) Q:GMS'>0 D CKP^GMTSUP Q:$D(GMTSQIT) W ?19,^TMP("LRA",$J,IX,.1,GMS),!
37 Q
38TEXT ; Handles GROSS DESCRIPTION & MICROSCOPIC EXAM/DX Print
39 N LN,GMTSLN,GMTSLNI
40 D CKP^GMTSUP Q:$D(GMTSQIT) W ?(17-$L(X)),X_":",!
41 S LN=0
42 F S LN=$O(^TMP("LRA",$J,IX,IX0,LN)) Q:LN'>0 S GMTSLN=^(LN) D
43 .I $L(GMTSLN)>78 S GMTSLN=$$WRAP^GMTSORC(GMTSLN,78)
44 .D CKP^GMTSUP Q:$D(GMTSQIT) W $P(GMTSLN,"|"),! D
45 ..F GMTSLNI=2:1:$L(GMTSLN,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSLN,"|",GMTSLNI)]"" $P(GMTSLN,"|",GMTSLNI),!
46 Q
47SUPPR ; Writes Supplementary Report
48 N GMTSR,SRDATE,GMTSRL,GMTSRLI,X
49 S IX1=0
50 F S IX1=$O(^TMP("LRA",$J,IX,1.2,IX1)) Q:IX1'>0 D CKP^GMTSUP Q:$D(GMTSQIT) S SRDATE=^TMP("LRA",$J,IX,1.2,IX1,0) S X=SRDATE D REGDTM4^GMTSU W "Supplementary Rpt: ",X,! D
51 .S GMTSR=0
52 .F S GMTSR=$O(^TMP("LRA",$J,IX,1.2,IX1,GMTSR)) Q:GMTSR'>0 S GMTSRL=^(GMTSR) D
53 ..I $L(GMTSRL)>78 S GMTSRL=$$WRAP^GMTSORC(GMTSRL,78)
54 ..W $P(GMTSRL,"|"),! D
55 ...F GMTSRLI=2:1:$L(GMTSRL,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSRL,"|",GMTSRLI)]"" $P(GMTSRL,"|",GMTSRLI),!
56 Q
57WRTTM ; Writes Topography and Morphology
58 N GMT,GMD,GME
59 D CKP^GMTSUP Q:$D(GMTSQIT) W ?7,"Topography:",?19,$P(X,U),!
60 I $O(^TMP("LRA",$J,IX,IX0,IX1,1,0)) D CKP^GMTSUP Q:$D(GMTSQIT)
61 S GMD=0
62 F S GMD=$O(^TMP("LRA",$J,IX,IX0,IX1,1,GMD)) Q:GMD'>0 W:GMD=1 ?9,"Disease:" W ?21,^TMP("LRA",$J,IX,IX0,IX1,1,GMD),! Q
63 I $O(^TMP("LRA",$J,IX,IX0,IX1,2,0)) D CKP^GMTSUP Q:$D(GMTSQIT)
64 S GMT=0
65 F S GMT=$O(^TMP("LRA",$J,IX,IX0,IX1,2,GMT)) Q:GMT'>0 D
66 .I GMT'=4 D CKP^GMTSUP Q:$D(GMTSQIT)
67 .I W ?7,"Morphology:",?21,^TMP("LRA",$J,IX,IX0,IX1,2,GMT),! D Q
68 ..S GME=0
69 ..F S GME=$O(^TMP("LRA",$J,IX,IX0,IX1,2,GMT,1,GME)) Q:GME'>0 D
70 ...D CKP^GMTSUP Q:$D(GMTSQIT) W:GME=1 ?9,"Etiology:" W ?23,^TMP("LRA",$J,IX,IX0,IX1,2,GMT,1,GME),! Q
71 Q
72WRTP ; Writes Procedure field
73 N GMQ,GMK
74 I $O(^TMP("LRA",$J,IX,IX0,IX1,4,0)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?7,"Procedures:"
75 S GMT=0
76 F S GMT=$O(^TMP("LRA",$J,IX,IX0,IX1,4,GMT)) Q:GMT'>0 D
77 .S GMQ=$P(^TMP("LRA",$J,IX,IX0,IX1,4,GMT),U)
78 .I $L(GMQ)>56 S GMQ=$$WRAP^GMTSORC(GMQ,56)
79 .D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,$P(GMQ,"|"),! D
80 ..F GMK=2:1:$L(GMQ,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMQ,"|",GMK)]"" ?23,$P(GMQ,"|",GMK),!
81 Q
Note: See TracBrowser for help on using the repository browser.