ONCOCKI ;Hines OIFO/GWB - Edit checks/INPUT TRANSFORM edit checks ;06/23/10
;;2.2;ONCOLOGY;**1,4**;Jul 31, 2013;Build 5
;
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))
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
Q
ACN ;Accession Number check
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
Q
SGAN ;SET GREATEST ACCESSION NUMBER @ ACCESSION YEAR
S YR=$E(X,1,2) I '$D(^ONCO(165.5,"AGAN",YR)) S ^ONCO(165.5,"AGAN",YR)=X G EX
S:X>^ONCO(165.5,"AGAN",YR) ^(YR)=X G EX
KGAN ;RESET GREATEST ACCESSION NUMBER @YEAR
S YR=$E(X,1,2) G RE:'$D(^ONCO(165.5,"AGAN",YR)),EX:X<^(YR),GN:X=^(YR)
RE W !?10,"NEED TO RE-INITIALIAZE FILE" G EX
GN ;GET NEXT GREATEST ACCESSION NUMBER
F AC=X-1:-1:YR_"0001" I $D(^ONCO(165.5,"AE",X)) S ^ONCO(165.5,"AGAN",YR)=AC G EX
K ^ONCO(165.5,"AGAN",YR) G EX
KACD ;CHECK DELETED NUMBER
S ^ONCO(165.5,"ACD",YR,$E(X,3,6))="" G EX ;THIS WILL LEAVE LARGE NUMBER IN DELGLED LIST IF NOT CHECKED
;
SEQ ;SEQUENCE NUMBER (165.5,.06)
S XX=$P(^ONCO(165.5,D0,0),U,5)
I XX="" K X,XX W !?50,"No ACCESSION NUMBER assigned",!! Q
S XX=$E(XX,1,4)_"-"_$E(XX,5,9)_"/"_X Q:'$D(^ONCO(165.5,"D",XX))
W !?25,XX," is already assigned.",! D SDP^ONCOCOM K X,XX Q
Q
;
PSEX ;PATIENT NAME (165.5,.02) INPUT TRANSFORM
S XX=$P(^ONCO(165.5,D0,0),U,1),XD0=X
SEX Q:(XX<43!(XX>52))
N SG,SX
S SX=$P(^ONCO(160,XD0,0),U,8)
I SX=1 Q:((XX>49)&(XX<53)) D K X Q
.S SG=$P($G(^ONCO(164.2,XX,0)),U,1)
.W !!?10,"SEX = Male. SITE/GP ",SG," is inappropriate."
I SX=2 Q:((XX>42)&(XX<49)) D K X Q
.S SG=$P($G(^ONCO(164.2,XX,0)),U,1)
.W !!?10,"SEX = Female. SITE/GP ",SG," is inappropriate."
Q
;
EX ;Kill variables and Exit
K AC,YR,XX,XD0
Q
;
CLEANUP ;Cleanup
K D0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCKI 1909 printed Apr 09, 2024@21:27:41 Page 2
ONCOCKI ;Hines OIFO/GWB - Edit checks/INPUT TRANSFORM edit checks ;06/23/10
+1 ;;2.2;ONCOLOGY;**1,4**;Jul 31, 2013;Build 5
+2 ;
11 SET Y=$PIECE(^ONCO(165.5,D0,0),U,2)
SET Y=$SELECT($DATA(^ONCO(160,+Y,1)):$PIECE(^(1),U,2),1:"")
if (Y=""!(X<Y)!(X=Y))
QUIT
+1 SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_($EXTRACT(Y,1,3)+1700)
WRITE !!,"*****DATE DX is after LAST DATE CONTACT***** ",Y,!
KILL X,Y
+2 QUIT
ACN ;Accession Number check
+1 if $DATA(^ONCO(165.5,"AE",X,$PIECE(^ONCO(165.5,D0,0),U,2)))
QUIT
if '$DATA(^ONCO(165.5,"AE",X))
QUIT
WRITE *7,?50,"Number is already assigned!!"
KILL X
+2 QUIT
SGAN ;SET GREATEST ACCESSION NUMBER @ ACCESSION YEAR
+1 SET YR=$EXTRACT(X,1,2)
IF '$DATA(^ONCO(165.5,"AGAN",YR))
SET ^ONCO(165.5,"AGAN",YR)=X
GOTO EX
+2 if X>^ONCO(165.5,"AGAN",YR)
SET ^(YR)=X
GOTO EX
KGAN ;RESET GREATEST ACCESSION NUMBER @YEAR
+1 SET YR=$EXTRACT(X,1,2)
if '$DATA(^ONCO(165.5,"AGAN",YR))
GOTO RE
if X<^(YR)
GOTO EX
if X=^(YR)
GOTO GN
RE WRITE !?10,"NEED TO RE-INITIALIAZE FILE"
GOTO EX
GN ;GET NEXT GREATEST ACCESSION NUMBER
+1 FOR AC=X-1:-1:YR_"0001"
IF $DATA(^ONCO(165.5,"AE",X))
SET ^ONCO(165.5,"AGAN",YR)=AC
GOTO EX
+2 KILL ^ONCO(165.5,"AGAN",YR)
GOTO EX
KACD ;CHECK DELETED NUMBER
+1 ;THIS WILL LEAVE LARGE NUMBER IN DELGLED LIST IF NOT CHECKED
SET ^ONCO(165.5,"ACD",YR,$EXTRACT(X,3,6))=""
GOTO EX
+2 ;
SEQ ;SEQUENCE NUMBER (165.5,.06)
+1 SET XX=$PIECE(^ONCO(165.5,D0,0),U,5)
+2 IF XX=""
KILL X,XX
WRITE !?50,"No ACCESSION NUMBER assigned",!!
QUIT
+3 SET XX=$EXTRACT(XX,1,4)_"-"_$EXTRACT(XX,5,9)_"/"_X
if '$DATA(^ONCO(165.5,"D",XX))
QUIT
+4 WRITE !?25,XX," is already assigned.",!
DO SDP^ONCOCOM
KILL X,XX
QUIT
+5 QUIT
+6 ;
PSEX ;PATIENT NAME (165.5,.02) INPUT TRANSFORM
+1 SET XX=$PIECE(^ONCO(165.5,D0,0),U,1)
SET XD0=X
SEX if (XX<43!(XX>52))
QUIT
+1 NEW SG,SX
+2 SET SX=$PIECE(^ONCO(160,XD0,0),U,8)
+3 IF SX=1
if ((XX>49)&(XX<53))
QUIT
Begin DoDot:1
+4 SET SG=$PIECE($GET(^ONCO(164.2,XX,0)),U,1)
+5 WRITE !!?10,"SEX = Male. SITE/GP ",SG," is inappropriate."
End DoDot:1
KILL X
QUIT
+6 IF SX=2
if ((XX>42)&(XX<49))
QUIT
Begin DoDot:1
+7 SET SG=$PIECE($GET(^ONCO(164.2,XX,0)),U,1)
+8 WRITE !!?10,"SEX = Female. SITE/GP ",SG," is inappropriate."
End DoDot:1
KILL X
QUIT
+9 QUIT
+10 ;
EX ;Kill variables and Exit
+1 KILL AC,YR,XX,XD0
+2 QUIT
+3 ;
CLEANUP ;Cleanup
+1 KILL D0
