ONCTEXT ;Hines OIFO/GWB - ONCOLOGY TEXT EDITS ;09/29/00
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
;Maximum NAACCR length text edit
S FIELD=$P(^DD(165.5,FLDNUM,0),U,1)
S (LENGTH,WPIEN)=0
F S WPIEN=$O(^ONCO(165.5,D0,NODE,WPIEN)) Q:WPIEN'>0 D
.S LENGTH=LENGTH+$L(^ONCO(165.5,D0,NODE,WPIEN,0))
I LENGTH>LIMIT D
.W !,*7
.W !," WARNING: ",FIELD," too long: ",LENGTH," characters"
.W !?10,"Text should not exceed NAACCR length of ",LIMIT," characters"
.W !
.N DIR,X S SAVEY=Y
.S DIR("A")=" Do you want to re-edit this field"
.S DIR(0)="Y",DIR("B")="No" D ^DIR
.I (Y=0)!(Y="") S Y=SAVEY Q
.I Y[U S Y="@0" Q
.S Y=FLDNUM
K FIELD,FLDNUM,LENGTH,LIMIT,NODE,SAVEY,WPIEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCTEXT 703 printed Nov 22, 2024@17:38:59 Page 2
ONCTEXT ;Hines OIFO/GWB - ONCOLOGY TEXT EDITS ;09/29/00
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
+3 ;Maximum NAACCR length text edit
+4 SET FIELD=$PIECE(^DD(165.5,FLDNUM,0),U,1)
+5 SET (LENGTH,WPIEN)=0
+6 FOR
SET WPIEN=$ORDER(^ONCO(165.5,D0,NODE,WPIEN))
if WPIEN'>0
QUIT
Begin DoDot:1
+7 SET LENGTH=LENGTH+$LENGTH(^ONCO(165.5,D0,NODE,WPIEN,0))
End DoDot:1
+8 IF LENGTH>LIMIT
Begin DoDot:1
+9 WRITE !,*7
+10 WRITE !," WARNING: ",FIELD," too long: ",LENGTH," characters"
+11 WRITE !?10,"Text should not exceed NAACCR length of ",LIMIT," characters"
+12 WRITE !
+13 NEW DIR,X
SET SAVEY=Y
+14 SET DIR("A")=" Do you want to re-edit this field"
+15 SET DIR(0)="Y"
SET DIR("B")="No"
DO ^DIR
+16 IF (Y=0)!(Y="")
SET Y=SAVEY
QUIT
+17 IF Y[U
SET Y="@0"
QUIT
+18 SET Y=FLDNUM
End DoDot:1
+19 KILL FIELD,FLDNUM,LENGTH,LIMIT,NODE,SAVEY,WPIEN
+20 QUIT