source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOAI.m@ 1154

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1ONCOAI ;Hines OIFO/GWB [AI Complete Abstract]; 7/19/93
2 ;;2.11;ONCOLOGY;**6,15,17,18,19,25,26,27,28,29,32,33,34,35,43,45,47**;Mar 07, 1995;Build 19
3 ;
4BEG D EX
5 W @IOF,!!!
6 S DIC("A")=" Enter patient name: ",DLAYGO=160,DIC="^ONCO(160,"
7 S DIC(0)="AELMQZ" D ^DIC K DIC,DLAYGO G EX:Y<0
8 S (D0,ONCOD0)=+Y,ONCOVP=$P(Y,U,2)
9 S ONCONM=Y(0,0),ONCONAM=$P(ONCONM,",",2)_" "_$P(ONCONM,",",1)
10 S PT0=Y(0),SEX=$P(PT0,U,8) G:SEX'="" PD
11 ;
12DEM ;Display demographic data
13 D ^ONCOAID G BEG:ONCO0=""
14PD K DXS,DIOT S D0=ONCOD0 D PRT^ONCPDI
15 S SX=$S(SEX=1:"M",SEX=2:"F",1:"")
16 S ONCOSX=$S(SX="M":"Male",SX="F":"Female",1:"")
17A1 K DIR W ! S DIR("A")=" Edit patient data",DIR("B")="YES",DIR(0)="Y"
18 D ^DIR G CONT:Y[U,EX:Y="",HIS:'Y
19 ;
20PAT ;Edit ONCOLOGY PATIENT (160) data
21 N RACE,R1 S RACE="" D RACE^ONCOES
22 I X'="" D
23 .S R1=X
24 .S RACE=$S(R1["BLACK":"Black",R1["WHITE":"White",R1["AMERICAN INDIAN OR ALASKA NATIVE":"American Indian, Aleutian, Eskimo",1:"")
25 N AOE,IRE,PGS
26 D ENVIRON^ONCOES
27 S ONCOL=0,DA=ONCOD0
28 L +^ONCO(160,DA):0 I $T D ^ONCPAT L -^ONCO(160,DA) S ONCOL=1
29 I 'ONCOL W !,"Another user is editing this patient."
30 K ONCOL
31 ;
32HIS ;Patient History
33 K DIR W !
34 S DIR("A")=" Continue with Patient History",DIR(0)="Y",DIR("B")="Yes"
35 D ^DIR G CONT:Y[U,EX:Y="",CK:Y=0
36 S D0=ONCOD0 D PH^ONCPDI
37 S ONCOL=0,DA=ONCOD0
38 L +^ONCO(160,DA):0 I $T D ^ONCPTHST L -^ONCO(160,DA) S ONCOL=1
39 I 'ONCOL W !,"Another user is editing this patient"
40 K ONCOL
41 ;
42CK ;Check for existing primaries
43 S ONCOP0=$O(^ONCO(165.5,"C",ONCOD0,0)) I ONCOP0'="" S ONCOP=$S($D(^ONCO(165.5,ONCOP0,0)):^(0),1:"") I ONCOP'="" G PRIM2
44 ;
45PRIM1 ;Register a primary for this patient
46REG D KIL S DIR("B")="Yes",DIR(0)="Y",DIR("A")=" Register a Primary for this patient" W !! D ^DIR G AIP:Y,EX:Y="",CONT
47 ;
48PRIM2 ;patient in PRIMARY FILE
49 D SDD^ONCOCOM
50ASK K DIR,Y S DIR(0)="S^E:EDIT existing Primary;A:ADD another Primary;F:Follow-Up;Q:Quit Patient",DIR("A")=" EDIT/ADD primary for this patient",DIR("B")="Edit" D ^DIR G EDT:Y="E",AIP:Y="A",FOL:Y="F",CONT:Y="Q",CONT:U,EX
51 ;
52EDT ;Select primary to edit
53 S D="C",DIC(0)="EZ",DIC="^ONCO(165.5,",X=ONCONM D IX^DIC K D,DIC,X W ! G BEG:Y<0 I Y=" " W ?40,"Space bar not allowed!" G EDT
54 S ONCOD0P=+Y D EN^ONCOAIP G EX
55 ;
56AIP ;Abstract all Primary Data;Return with (D0,ONCOD0P)=Primary Record Number
57 D @($S(ONCOP0="":"EN^ONCOAIC",ONCOP'="":"EN^ONCOAIM",1:"ER")) G SET:Y,EX:Y="",CONT
58 ;
59SET S (SR,XD,MO,CS)=""
60 S SSPIEN=$O(^ONCO(160,ONCOD0,"SUS","C",DUZ(2),"")) I SSPIEN'="" D
61 .S XD=$P(^ONCO(160,ONCOD0,"SUS",SSPIEN,0),U,1)
62 .S SR=$P(^ONCO(160,ONCOD0,"SUS",SSPIEN,0),U,3)
63 .S CS=$S(SR="LS":20,SR="LC":20,SR="LE":20,SR="PT":21,SR="RA":26,1:"")
64 .S MO=$P(^ONCO(160,ONCOD0,"SUS",SSPIEN,0),U,11)
65 .S DA(1)=ONCOD0,DA=SSPIEN,DIK="^ONCO(160,"_DA(1)_",""SUS""," D ^DIK
66 S ONCOL=0
67 S DIE="^ONCO(165.5,"
68 S (D0,DA)=ONCOD0P
69 S DR="3///^S X=XD;91///0;95///2;21///^S X=CS"
70 L +^ONCO(165.5,DA):0 I $T D ^DIE L -^ONCO(165.5,DA) S ONCOL=1
71 I MO="" G SET1
72 I ((XD<3010000)&('$D(^ONCO(164.1,MO,0))))!((XD>3001231)&('$D(^ONCO(169.3,MO,0)))) D W ! K DIR S DIR(0)="E" D ^DIR G:Y=0 EX G SET1
73 .W !!,"WARNING:"
74 .W !,"The morphology code ",$E(MO,1,4)_"/"_$E(MO,5,6)," found by lab casefinding is not a valid ICD-O code."
75 .W !,"Enter the correct morphology code at the appropriate HISTOLOGY (ICD-O) prompt."
76 S:XD<3010000 $P(^ONCO(165.5,D0,2),U,3)=MO,$P(^ONCO(165.5,D0,2.2),U,3)=MO
77 S:XD>3001231 $P(^ONCO(165.5,D0,2.2),U,3)=MO
78SET1 D MS^ONCOCOM,EN^ONCOAIP
79 I 'ONCOL W !,"Another user is editing this patient data."
80 K ONCOL
81 ;
82CONT ;Continue another patient
83 K DIR W !! S DIR("A")=" Abstract another patient",DIR(0)="Y",DIR("B")="Yes" D ^DIR G BEG:Y,EX
84 Q
85FOL ;Follow-Up
86 S ONCOAI=1 D EN^ONCOAIF
87 Q
88 ;
89KILL ;Kill variables
90 K ONCOACN,ONCO,ONCOD0,ONCOD0P,ONCOMR,ONCONM,ONCOOUT,ONCOP,ONCOP0,ONCOSN
91 K ONCOSX,ONCOEDIT,ONCOPB,ONCOSIT,ONCONAM,ONCOPN,ONCOVP,ONCOVS,ONCOX
92 K ONCOAI,ONCOANS,ONCOT,ONCOYR,COC,IIN
93KIL K D1,DI,DN,DIR,DIC,DIE,COB,D,DA,D0,DIR,DR,NM,R,RC,RCC,SEX,SX,POB,SN,TL,X
94 K A,AG,ABS,AN,ANS,C,CC,CT,CTY,DEF,DLAYGO,I2,I9,PT0,PTR,ST,SDD,VP0,VPR,XN
95 K DXS,FIL,G,I,J,K,L,M,N,N2,NM,O2,VAERR,D0P,ICD,OT,R1,R2,RIPD0,XDT,XS
96 K XTS,ZP,ZIP,RY,FG,P,MC,MO,KK,OD,ONCOAD,ONCODD,ONCOICD,OS,PR,Q,S,SC,SR
97 K T,TS,UF,XDA,XLC,XY,%ZISOS
98 Q
99ER ;Error
100 W !!?5,"Something is wrong with database!! - See SiteManger" S Y="" Q
101EX D KILL
102 K ONCOANS,D0,DA,DIC,DIE,DIR,DQ,DR,MS,PR,R1,R2,RS,RIP,SR,ST,SY,T,S,Z,ER,TM,CS,XD0,XD1
103 K A,AG,D0,D1,DA,DXS,FIL,G,I,J,K,L,M,N,NM,O2,TD,TX,OT,DOP,ICD,C,XX,ONCOYR
104 K ONCOAD,ONCODD,VAERR,ONCO,ONCOD0P,ONCONM,OP,ONCOD0,%W,%X,%Y,%ZISOS
105 K STAT
106 Q
107 ;
108WRTSDC ;CALLED BY [ONCO XDEATH INFO] PRINT TEMPLATE
109 N DI,DIC,DA
110 K DIQ S DIC="^ONCO(160,",DR="19.1",DA=D0,DIQ="ONCSDC" D EN^DIQ1
111 W !?4,"State Death Cert: ",ONCSDC(160,D0,19.1)
112 K ONCSDC
113 Q
114 ;
115CON ;ADD CONTACTS
116 ;G BEG:$P($G(^ONCO(160,ONCOD0,1)),U)=0,BEG:$D(^ONCO(160,"APC",ONCOD0)) S,EX:Y="" DIR("A")=" ADD CONTACTS at this time",DIR(0)="Y" W !! D ^DIR G BEG:'Y,CONT:Y[U D DCL^ONCOFUL
Note: See TracBrowser for help on using the repository browser.