source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOAIM.m@ 703

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1ONCOAIM ;Hines OIFO/GWB - CREATE ADDITIONAL PRIMARY RECORDS ;10/1/93
2 ;;2.11;ONCOLOGY;**1,5,6,25,27,36,37,44,45,46**;Mar 07, 1995;Build 39
3 ;
4EN D KILL
5 W @IOF
6 W !!?5,"******** ADD PRIMARY RECORD FOR THIS PATIENT********",!!
7 W:$D(ONCONM) ?5,"PATIENT: ",ONCONM
8 ;
9 ;Get next ACESSION NUMBER (165.5,.05)/SEQUENCE NUMBER (165.5,.06)
10 ;Loop thru 165.5 "D" cross-reference
11 ;Set up 2 ^TMP arrays: 1 for malignants, 1 for benigns
12 S (KKM,KKB)=0,AC=$P(ONCOP,U,5),ACN=$E(AC,1,4)_"-"_$E(AC,5,9),ACS=ACN
13 F KK=1:1 S ACSL=ACS,ACS=$O(^ONCO(165.5,"D",ACS)) S SQN=$P(ACS,"/",2) D Q:$P(ACS,"/")'=ACN
14 .Q:$P(ACS,"/")'=ACN
15 .S RECNUM=0
16 .F LL=1:1 S RECNUM=$O(^ONCO(165.5,"D",ACS,RECNUM)) Q:RECNUM="" D
17 ..S PRIMIEN=$P(^ONCO(165.5,RECNUM,0),U)
18 ..S PRIM=$P(^ONCO(164.2,PRIMIEN,0),U,1)
19 ..S SEQDIV=$$GET1^DIQ(165.5,RECNUM,2000)
20 ..I ((+SQN>0)&(+SQN<60))!(SQN="00")!(SQN=99) S KKM=KKM+1,^TMP($J,"MAL",KKM)=SQN_U_ACS_U_PRIM_U_RECNUM_U_SEQDIV
21 ..E S KKB=KKB+1,^TMP($J,"BEN",KKB)=SQN_U_ACS_U_PRIM_U_RECNUM_U_SEQDIV
22 ;Find last malignant/benign (if any) and determine SEQUENCE NUMBER
23 K LASTBEN,LASTMAL,NEXTBEN,NEXTMAL
24 S ALPHA=0 F S BEN=ALPHA,ALPHA=$O(^TMP($J,"BEN",ALPHA)) Q:ALPHA'>0
25 S NUM=0 F S MAL=NUM,NUM=$O(^TMP($J,"MAL",NUM)) Q:NUM'>0
26 S LASTBEN=$P($G(^TMP($J,"BEN",BEN)),U,1)
27 S LASTMAL=$P($G(^TMP($J,"MAL",MAL)),U,1)
28 S NEXTBEN=$S(LASTBEN=60:62,LASTBEN'="":LASTBEN+1,1:60)
29 S NEXTMAL=$S(LASTMAL'="":LASTMAL+1,1:"NULL")
30 S NEXTMAL=$S(NEXTMAL=1!(NEXTMAL>99):2,NEXTMAL="NULL":"00^99",1:NEXTMAL)
31 S NEXTMAL=$S($L(NEXTMAL)<2:"0"_NEXTMAL,1:NEXTMAL)
32 ;
33 W !!?5,"ACCESSION NUMBER: ",ACN
34 ;
35PROMPT S DEF=$S(NEXTMAL["00":"00",1:NEXTMAL)
36 K DIR S DIR(0)="F^2:2",DIR("A")=" SEQUENCE NUMBER.",DIR("B")=DEF
37 S DIR("?")="Enter the next SEQUENCE NUMBER. Enter ?? for additional HELP"
38 S DIR("??")="^D HLP^ONCOAIM2" D ^DIR I "^^"[Y D KILL Q
39 I (Y'?2N)!((Y>88)&(Y<99)) W " Allowable Values: 00-88, 99" G PROMPT
40 S DIEN=ACN_"/"_Y
41 S SN=Y,SEQ=SN,AY=$E(DT,1)+17,AY=AY_$E(DT,2,3)
42 I SN="02",$D(^TMP($J,"MAL",1)),$P(^TMP($J,"MAL",1),U,1)="00" D
43 .S ACS=$P(^TMP($J,"MAL",1),U,2)
44 .S REC00=$P(^TMP($J,"MAL",1),U,4)
45 .W !!?5,"You are adding the second malignant or in-situ primary for this patient"
46 .W !!?5,ACS," ","will be changed to ",ACN,"/01",!
47 I SN="02",$D(^TMP($J,"MAL",2)),$P(^TMP($J,"MAL",2),U,1)'="01" D
48 .S REC002=$P(^TMP($J,"MAL",2),U,4)
49 I SN>59,SN<88,SN'=NEXTBEN W ?32,"Next Non-Malignant SEQUENCE NUMBER is",NEXTBEN G PROMPT
50 I SN=62,$D(^TMP($J,"BEN",1)),$P(^TMP($J,"BEN",1),U)=60 D
51 .S ACS=$P(^TMP($J,"BEN",1),U,2)
52 .S REC00=$P(^TMP($J,"BEN",1),U,4)
53 .W !!?5,"You are adding the second Non-Malignant primary for this patient"
54 .W !!?5,ACS," ","will be changed to ",ACN,"/61",!
55 ;
56LOOK2 ;Select Primary Site
57 K DIC
58 S DIC="^ONCO(164.2,",DIC(0)="AEQM"
59 S DIC("A")=" Select Primary 'SITE/GP': "
60 S DIC("S")="I '$P(^(0),U,3)"
61 D ^DIC K DIC G EX:Y<0
62 S (XX,X,ONCOSIT)=+Y,ONCOPN=$P(Y,U,2),XD0=ONCOD0
63 D SEX^ONCOCKI G LOOK2:'$D(X)
64 K DIR
65 S DIR("A")=" Ok to add:",DIR("B")="Y",DIR(0)="Y" D ^DIR
66 G CR:Y,EN:Y=0 Q
67 ;
68CR ;Create Primary
69 K DIC,DO,DTOUT
70 W !,?5,"Creating another primary record for ",ONCONM_" "_ACN_"..."
71 S DIC="^ONCO(165.5,",X=ONCOSIT,DIC(0)="Z"
72 S DIC("DR")="2000////^S X=DUZ(2)"
73 D FILE^DICN K DIC,X G EX:Y<0
74 S ONCOD0P=+Y
75 S $P(^ONCO(165.5,+Y,0),U,2)=ONCOD0,$P(^(7),U,2)=0
76 S ^ONCO(165.5,"C",ONCOD0,ONCOD0P)=""
77 S ACAY=$E(DT,1)+17_$E(DT,2,3)
78 L +^ONCO(165.5,ONCOD0P,0)
79 S DIE="^ONCO(165.5,"
80 S DR="W !;.05////^S X=AC;.06////^S X=SEQ;.07//^S X=ACAY"
81 S ACN=AC_"/"_SEQ,DA=ONCOD0P
82 D ^DIE
83 L -^ONCO(165.5,ONCOD0P,0)
84 G PID:$D(Y)=0 D KLN G EX
85 ;
86PID ;Continue defining Primary Record
87 I SN="02",$D(^TMP($J,"MAL",1)),$P(^TMP($J,"MAL",1),U,1)="00" S UPDATE="01" D UPDT
88 I SN=62,$D(^TMP($J,"BEN",1)),$P(^TMP($J,"BEN",1),U,1)=60 S UPDATE=61 D UPDT
89 S ONCOACN=AC_"/"_SEQ,Y=1 D KILL Q
90 ;
91UPDT ;Update 00 to 01, update 60 to 61
92 S SN=UPDATE,DIE="^ONCO(165.5,",DA=REC00,DR=".06///^S X=SN"
93 D ^DIE S D0=ONCOD0P
94 I $D(REC002) S SN=UPDATE,DIE="^ONCO(165.5,",DA=REC002,DR=".06///^S X=SN" D ^DIE S D0=ONCOD0P
95 W !!?5,"The following up-dating has occurred:",!! D SDA^ONCOCOM H 2
96 Q
97 ;
98KLN ;KILL entry
99 S DA=ONCOD0P,DIK="^ONCO(165.5," D ^DIK,KILL
100 R !?5,"<ENTRY DELETED> - press RETURN to continue->",DA:DTIME
101 Q:'$T!(DA=U)
102 W !
103 Q
104 ;
105KILL ;KILL variables
106 K AC,ACAY,ACN,ACS,ACSL,AY,DA,DIC,DIE,DIK,DIR,D0,DR,DUOUT,DTOUT
107 K KK,KKM,KKB,REC00,SN,SEQ,X,XX,XD0
108 K ALPHA,BEN,LASTBEN,LASTMAL,MAL,NEXTBEN,NEXTMAL
109 K NUM,PRIM,PRIMIEN,RECNUM,SQN,UPDATE
110 K ^TMP($J,"BEN"),^TMP($J,"MAL")
111 Q
112 ;
113EX ;Exit
114 D KILL S Y=0
115 Q
Note: See TracBrowser for help on using the repository browser.