source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOAIP1.m@ 1036

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1ONCOAIP1 ;Hines OIFO/GWB [EE Abstract Edit Primary]; 08/29/01
2 ;;2.11;ONCOLOGY;**45**;Mar 07, 1995
3 ;
4SSS ;SYSTEMIC/SURGERY SEQUENCE (165.5,15)
5 Q:$P(^ONCO(165.5,D0,3.1),U,39)'=""
6 S S=$E($$GET1^DIQ(165.5,D0,58.6,"E"),1,2)
7 S SATF=$E($$GET1^DIQ(165.5,D0,58.7,"E"),1,2)
8 S SCP=$P($G(^ONCO(165.5,D0,3.1)),U,31)
9 S SCPATF=$P($G(^ONCO(165.5,D0,3.1)),U,32)
10 S SOTH=$P($G(^ONCO(165.5,D0,3.1)),U,33)
11 S SOTHATF=$P($G(^ONCO(165.5,D0,3.1)),U,34)
12 S C=$$GET1^DIQ(165.5,D0,53.2,"I")
13 S CATF=$$GET1^DIQ(165.5,D0,53.3,"I")
14 S H=$$GET1^DIQ(165.5,D0,54.2,"I")
15 S HATF=$$GET1^DIQ(165.5,D0,54.3,"I")
16 S I=$$GET1^DIQ(165.5,D0,55.2,"I")
17 S IATF=$$GET1^DIQ(165.5,D0,55.3,"I")
18 S HTE=$$GET1^DIQ(165.5,D0,153,"I")
19 I ((S="00")!(S=99)!(S=98)!(S=""))&((SATF="00")!(SATF=99)!(SATF=98)!(SATF=""))&((SCP=0)!(SCP="")!(SCP=9))&((SCPATF=0)!(SCPATF="")!(SCPATF=9))&((SOTH=0)!(SOTH=""))&((SOTHATF=0)!(SOTHATF="")) S SR=0
20 E S SR=1
21 S DST=$$GET1^DIQ(165.5,D0,152)
22 I ((DST="00/00/0000")!(DST="99/99/9999")!(DST="88/88/8888")!(DST="")) S ST=0
23 E S ST=1
24 I ($G(SR)&$G(ST)) D
25 .S SDT=$P($G(^ONCO(165.5,D0,3)),U,1)
26 .S:SDT'="" SSSEQ("S",SDT)="S",SSSEQ(SDT)="S"
27 .S SATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,8)
28 .S:SATFDT'="" SSSEQ("S",SATFDT)="S",SSSEQ(SATFDT)="S"
29 .S SCPDT=$P($G(^ONCO(165.5,D0,3.1)),U,22)
30 .S:SCPDT'="" SSSEQ("S",SCPDT)="S",SSSEQ(SCPDT)="S"
31 .S SCPATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,23)
32 .S:SCPATFDT'="" SSSEQ("S",SCPATFDT)="S",SSSEQ(SCPATFDT)="S"
33 .S SOTDT=$P($G(^ONCO(165.5,D0,3.1)),U,24)
34 .S:SOTDT'="" SSSEQ("S",SOTDT)="S",SSSEQ(SOTDT)="S"
35 .S SOTATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,25)
36 .S:SOTATFDT'="" SSSEQ("S",SOTATFDT)="S",SSSEQ(SOTATFDT)="S"
37 .S CDT=$P($G(^ONCO(165.5,D0,3)),U,11)
38 .S:CDT'="" SSSEQ("SYS",CDT)="SYS",SSSEQ(CDT)="SYS"
39 .S CATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,15)
40 .S:CATFDT'="" SSSEQ("SYS",CATFDT)="SYS",SSSEQ(CATFDT)="SYS"
41 .S HDT=$P($G(^ONCO(165.5,D0,3)),U,14)
42 .S:HDT'="" SSSEQ("SYS",HDT)="SYS",SSSEQ(HDT)="SYS"
43 .S HATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,17)
44 .S:HATFDT'="" SSSEQ("SYS",HATFDT)="SYS",SSSEQ(HATFDT)="SYS"
45 .S IDT=$P($G(^ONCO(165.5,D0,3)),U,17)
46 .S:IDT'="" SSSEQ("SYS",IDT)="SYS",SSSEQ(IDT)="SYS"
47 .S IATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,19)
48 .S:IATFDT'="" SSSEQ("SYS",IATFDT)="SYS",SSSEQ(IATFDT)="SYS"
49 .S HTEDT=$P($G(^ONCO(165.5,D0,3.1)),U,35)
50 .S:HTEDT'="" SSSEQ("SYS",HTEDT)="SYS",SSSEQ(HTEDT)="SYS"
51 .S FSDT=$O(SSSEQ("S",0)),FSYSDT=$O(SSSEQ("SYS",0))
52 .I FSDT=FSYSDT G EXIT
53 .S SSSEQ=$O(SSSEQ(0))
54 .I SSSEQ(SSSEQ)="SYS" S $P(^ONCO(165.5,D0,3.1),U,39)=2
55 .I SSSEQ(SSSEQ)="S" S $P(^ONCO(165.5,D0,3.1),U,39)=3
56 E D
57 .S $P(^ONCO(165.5,D0,3.1),U,39)=0
58 ;
59EXIT ;Exit
60 K S,SATF,SCP,SCPATF,SOTH,SOTHATF,C,CATF,H,HATF,I,IATF,HTE,SR,DST,ST
61 K SDT,SATFDT,SCPDT,SCPATFDT,SOTDT,SOTATFDT
62 K CDT,CATFDT,HDT,HATFDT,IDT,IATFDT,HTEDT
63 K SSSEQ,FSDT,FSYSDT
64 Q
Note: See TracBrowser for help on using the repository browser.