ONCOAIQ ;WASH ISC/SRR,MLH-CHECK REQUIRED FIELDS & EDIT ;7/20/93 10:26
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
CK ;Check data
Q ;Q ;QUIT UNTIL PATCHED
K DR S P=1,ER=0 F I=0:1:3 S X(I)=$G(^ONCO(165.5,D0,I))
;node 0
S X0=X(0),XD0=$P(X0,U,2),DR=""
X0 F J=3:1:7 I $P(X0,U,J)="" S DR=DR_".0"_J_";",ER=ER+1
I $P(X0,U,11)="" S DR=DR_2_";",ER=ER+1
F J=12:1:15 I $P(X0,U,J)="" S DR=DR_"2."_(J-11)_";",ER=ER+1
F J=16:1:19 I $P(X0,U,J)="" S DR=DR_$S(J=16:3,1:J-12)_";",ER=ER+1
X1 S X1=X(1) F J=1:1:5 I $P(X1,U,J)="" S ER=ER+1 S:J<4 DR=DR_(J+7)_";" I J>3 S DR=DR_$S(J=4:16,1:11)_";"
X2 S X2=X(2),X=18 F J=1,3,5,6,8 S X=X+2 I $P(X2,U,J)="" S DR=DR_X_";",ER=ER+1
F J=9:1:14 I $P(X2,U,J)="" S DR=DR_(J+20)_";",ER=ER+1
F J=15,16 I $P(X2,U,J)="" S DR=DR_$S(J=15:34.1,1:34.2)_";",ER=ER+1
F J=17,18,20 I $P(X2,U,J)="" S DR=DR_(J+18)_";",ER=ER+1
S X=37 F J=25:1:27 S X=X+.1 I $P(X2,U,J)="" S DR=DR_X_";",ER=ER+1
X3 S X3=X(3) F J=27,28,26 I $P(X3,U,J)="" S DR=DR_$S(J=27:58.1,J=28:59,1:58)_";",ER=ER+1
S X=50.2 F J=6,7,10,13,16,19,25 S X=X+1 I $P(X3,U,J)="" S DR=DR_$S(J'=7:X,1:51.3)_";",ER=ER+1
I 'ER R !?30,"Data OK=",Z:3 G EX
W !?25,"Empty PRIMARY fields = ",ER,!!
IF P D G EX:$D(Y),X0
. N X S DIE="^ONCO(165.5,",DA=D0,ONCOL=0
. L +^ONCO(165.5,DA):0 I $T D ^DIE L -^ONCO(165.5,DA) S P=0,ER=0,DR="",ONCOL=1
. I 'ONCOL W !,"This primary is being edited by another user."
. K ONCOL
. Q
;END IF
;
CK1 ;Check Patient data
S ER=0,P=1 F I=0,1 S X(I)=$G(^ONCO(160,XD0,I))
S X0=X(0),X1=X(1)
XP0 F J=5:1:8 I $P(X0,U,J)="" S DR=DR_(J+2)_";",ER=ER+1
I $P(X1,U)=0 F J=3:1:5 I $P(X1,U,J)="" S DR=DR_(J+16)_";",ER=ER+1
I ER,P D
.W !?25,"Patient file Errors: = ",ER
.S DIE="^ONCO(160,",DA=XD0,ONCOL=0
.L +^ONCO(160,DA):0 I $T D ^DIE L -^ONCO(160,DA) S ONCOL=1
.I 'ONCOL W !,"This primary being edited by another user."
.K ONCOL
.G EX:$D(Y)=0 S ER=0,P=0 G XP0
S ER=0,FU=$P($G(^ONCO(160,XD0,"F",0)),U,3) I FU="" S ER=1 W !?15,"You must register at least ONE Last Contact/Followup",! G EX
S XX=$O(^ONCO(160,XD0,"F","AA",0)) I XX'="" S XD1=$O(^(XX,0)),LC=^ONCO(160,XD0,"F",XD1,0) F J=1:1:6 I $P(LC,U,J)="" S ER=ER+1
I ER W !,?10,"Errors in Oncology Patient/Follow-up: ",ER
EX ;EXIT
I ER S $P(^ONCO(165.5,D0,7),U,2)=0 W !?20,"ABSTRACT Status RESET to Incomplete ",!!
K DR,DIE,J,C,DA,ER,P,ONCOD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOAIQ 2356 printed Apr 09, 2024@21:25:43 Page 2
ONCOAIQ ;WASH ISC/SRR,MLH-CHECK REQUIRED FIELDS & EDIT ;7/20/93 10:26
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
CK ;Check data
Q ;Q ;QUIT UNTIL PATCHED
+1 KILL DR
SET P=1
SET ER=0
FOR I=0:1:3
SET X(I)=$GET(^ONCO(165.5,D0,I))
+2 ;node 0
+3 SET X0=X(0)
SET XD0=$PIECE(X0,U,2)
SET DR=""
X0 FOR J=3:1:7
IF $PIECE(X0,U,J)=""
SET DR=DR_".0"_J_";"
SET ER=ER+1
+1 IF $PIECE(X0,U,11)=""
SET DR=DR_2_";"
SET ER=ER+1
+2 FOR J=12:1:15
IF $PIECE(X0,U,J)=""
SET DR=DR_"2."_(J-11)_";"
SET ER=ER+1
+3 FOR J=16:1:19
IF $PIECE(X0,U,J)=""
SET DR=DR_$SELECT(J=16:3,1:J-12)_";"
SET ER=ER+1
X1 SET X1=X(1)
FOR J=1:1:5
IF $PIECE(X1,U,J)=""
SET ER=ER+1
if J<4
SET DR=DR_(J+7)_";"
IF J>3
SET DR=DR_$SELECT(J=4:16,1:11)_";"
X2 SET X2=X(2)
SET X=18
FOR J=1,3,5,6,8
SET X=X+2
IF $PIECE(X2,U,J)=""
SET DR=DR_X_";"
SET ER=ER+1
+1 FOR J=9:1:14
IF $PIECE(X2,U,J)=""
SET DR=DR_(J+20)_";"
SET ER=ER+1
+2 FOR J=15,16
IF $PIECE(X2,U,J)=""
SET DR=DR_$SELECT(J=15:34.1,1:34.2)_";"
SET ER=ER+1
+3 FOR J=17,18,20
IF $PIECE(X2,U,J)=""
SET DR=DR_(J+18)_";"
SET ER=ER+1
+4 SET X=37
FOR J=25:1:27
SET X=X+.1
IF $PIECE(X2,U,J)=""
SET DR=DR_X_";"
SET ER=ER+1
X3 SET X3=X(3)
FOR J=27,28,26
IF $PIECE(X3,U,J)=""
SET DR=DR_$SELECT(J=27:58.1,J=28:59,1:58)_";"
SET ER=ER+1
+1 SET X=50.2
FOR J=6,7,10,13,16,19,25
SET X=X+1
IF $PIECE(X3,U,J)=""
SET DR=DR_$SELECT(J'=7:X,1:51.3)_";"
SET ER=ER+1
+2 IF 'ER
READ !?30,"Data OK=",Z:3
GOTO EX
+3 WRITE !?25,"Empty PRIMARY fields = ",ER,!!
+4 IF P
Begin DoDot:1
+5 NEW X
SET DIE="^ONCO(165.5,"
SET DA=D0
SET ONCOL=0
+6 LOCK +^ONCO(165.5,DA):0
IF $TEST
DO ^DIE
LOCK -^ONCO(165.5,DA)
SET P=0
SET ER=0
SET DR=""
SET ONCOL=1
+7 IF 'ONCOL
WRITE !,"This primary is being edited by another user."
+8 KILL ONCOL
+9 QUIT
End DoDot:1
if $DATA(Y)
GOTO EX
GOTO X0
+10 ;END IF
+11 ;
CK1 ;Check Patient data
+1 SET ER=0
SET P=1
FOR I=0,1
SET X(I)=$GET(^ONCO(160,XD0,I))
+2 SET X0=X(0)
SET X1=X(1)
XP0 FOR J=5:1:8
IF $PIECE(X0,U,J)=""
SET DR=DR_(J+2)_";"
SET ER=ER+1
+1 IF $PIECE(X1,U)=0
FOR J=3:1:5
IF $PIECE(X1,U,J)=""
SET DR=DR_(J+16)_";"
SET ER=ER+1
+2 IF ER
IF P
Begin DoDot:1
+3 WRITE !?25,"Patient file Errors: = ",ER
+4 SET DIE="^ONCO(160,"
SET DA=XD0
SET ONCOL=0
+5 LOCK +^ONCO(160,DA):0
IF $TEST
DO ^DIE
LOCK -^ONCO(160,DA)
SET ONCOL=1
+6 IF 'ONCOL
WRITE !,"This primary being edited by another user."
+7 KILL ONCOL
+8 if $DATA(Y)=0
GOTO EX
SET ER=0
SET P=0
GOTO XP0
End DoDot:1
+9 SET ER=0
SET FU=$PIECE($GET(^ONCO(160,XD0,"F",0)),U,3)
IF FU=""
SET ER=1
WRITE !?15,"You must register at least ONE Last Contact/Followup",!
GOTO EX
+10 SET XX=$ORDER(^ONCO(160,XD0,"F","AA",0))
IF XX'=""
SET XD1=$ORDER(^(XX,0))
SET LC=^ONCO(160,XD0,"F",XD1,0)
FOR J=1:1:6
IF $PIECE(LC,U,J)=""
SET ER=ER+1
+11 IF ER
WRITE !,?10,"Errors in Oncology Patient/Follow-up: ",ER
EX ;EXIT
+1 IF ER
SET $PIECE(^ONCO(165.5,D0,7),U,2)=0
WRITE !?20,"ABSTRACT Status RESET to Incomplete ",!!
+2 KILL DR,DIE,J,C,DA,ER,P,ONCOD
+3 QUIT
