| [613] | 1 | ONCOCKI ;Hines OIFO/GWB - EDIT CHECKS/INPUT TRANSFORM EDIT CHECKS ;12/15/99
|
|---|
| 2 | ;;2.11;ONCOLOGY;**1,6,16,25,37,42**;Mar 07, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | 11 S Y=$P(^ONCO(165.5,D0,0),U,2),Y=$S($D(^ONCO(160,+Y,1)):$P(^(1),U,2),1:"") Q:(Y=""!(X<Y)!(X=Y))
|
|---|
| 5 | S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700) W !!,"*****DATE DX is after LAST DATE CONTACT***** ",Y,! K X,Y
|
|---|
| 6 | Q
|
|---|
| 7 | ACN ;Accession Number check
|
|---|
| 8 | Q:$D(^ONCO(165.5,"AE",X,$P(^ONCO(165.5,D0,0),U,2))) Q:'$D(^ONCO(165.5,"AE",X)) W *7,?50,"Number is already assigned!!" K X
|
|---|
| 9 | Q
|
|---|
| 10 | SGAN ;SET GREATEST ACCESSION NUMBER @ ACCESSION YEAR
|
|---|
| 11 | S YR=$E(X,1,2) I '$D(^ONCO(165.5,"AGAN",YR)) S ^ONCO(165.5,"AGAN",YR)=X G EX
|
|---|
| 12 | S:X>^ONCO(165.5,"AGAN",YR) ^(YR)=X G EX
|
|---|
| 13 | KGAN ;RESET GREATEST ACCESSION NUMBER @YEAR
|
|---|
| 14 | S YR=$E(X,1,2) G RE:'$D(^ONCO(165.5,"AGAN",YR)),EX:X<^(YR),GN:X=^(YR)
|
|---|
| 15 | RE W !?10,"NEED TO RE-INITIALIAZE FILE" G EX
|
|---|
| 16 | GN ;GET NEXT GREATEST ACCESSION NUMBER
|
|---|
| 17 | F AC=X-1:-1:YR_"0001" I $D(^ONCO(165.5,"AE",X)) S ^ONCO(165.5,"AGAN",YR)=AC G EX
|
|---|
| 18 | K ^ONCO(165.5,"AGAN",YR) G EX
|
|---|
| 19 | KACD ;CHECK DELETED NUMBER
|
|---|
| 20 | S ^ONCO(165.5,"ACD",YR,$E(X,3,6))="" G EX ;THIS WILL LEAVE LARGE NUMBER IN DELGLED LIST IF NOT CHECKED
|
|---|
| 21 | ;
|
|---|
| 22 | SEQ ;SEQUENCE NUMBER (165.5,.06)
|
|---|
| 23 | S XX=$P(^ONCO(165.5,D0,0),U,5)
|
|---|
| 24 | I XX="" K X,XX W *7,?50,"No ACCESSION NUMBER assigned",!! Q
|
|---|
| 25 | ;S XX=$E(XX,1,4)_"-"_$E(XX,5,9)_"/"_X Q:'$D(^ONCO(165.5,"D",XX))
|
|---|
| 26 | ;W *7,?40,XX," is assigned.",! D SDP^ONCOCOM K X,XX Q
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | PSEX ;PATIENT NAME (165.5,.02) INPUT TRANSFORM
|
|---|
| 30 | S XX=$P(^ONCO(165.5,D0,0),U,1),XD0=X
|
|---|
| 31 | SEX Q:(XX<43!(XX>52))
|
|---|
| 32 | S SX=$P(^ONCO(160,XD0,0),U,8)
|
|---|
| 33 | I SX=1 Q:((XX>49)&(XX<53)) D K X Q
|
|---|
| 34 | .S SG=$P($G(^ONCO(164.2,XX,0)),U,1)
|
|---|
| 35 | .W !!?10,"SEX = Male. SITE/GP ",SG," is inappropriate."
|
|---|
| 36 | I SX=2 Q:((XX>42)&(XX<49)) D K X Q
|
|---|
| 37 | .S SG=$P($G(^ONCO(164.2,XX,0)),U,1)
|
|---|
| 38 | .W !!?10,"SEX = Female. SITE/GP ",SG," is inappropriate."
|
|---|
| 39 | ;
|
|---|
| 40 | EX ;Kill variables and Exit
|
|---|
| 41 | K AC,YR,XX,XD0,SX
|
|---|
| 42 | Q
|
|---|
