IBDFBKS2 ;ALB/CJM/AAS - Create form spec for scanning ; 6-JUN-95
;;3.0;AUTOMATED INFO COLLECTION SYS;**3,25**;APR 24, 1997
;
HANDPRNT(IEN,NAME,PAGE,ROW,COL,WIDTH,LINES,READTYPE,PAPKEY,PI) ;
;
Q:($P($G(^IBE(357.6,+PI,0)),"^",6)'=1)
;
N X1,X2,Y1,Y2,W,PICTURE,TYPEDATA,NODE0,LENGTH,LINENUM,PKDICT,CONF,L,SUBPICS,FORMAT,XYSMALL
S TYPEDATA="ALPHA",PICTURE=""
;
; -- get info associated with DHCP Data Element
I PAPKEY D
.S NODE0=$G(^IBE(359.1,PAPKEY,0)),NODE10=$G(^(10))
.S TYPEDATA=$P(NODE10,"^",1)
.S TYPEDATA=$S(TYPEDATA="a":"ALPHA",TYPEDATA="i":"INT",TYPEDATA="f":"FLOAT",TYPEDATA="t":"TIME",TYPEDATA="d":"DATE",1:"ALPHA")
.S PICTURE=$P(NODE10,"^",2)
.S FORMAT=$P(NODE0,"^",5) ;don't set year in format, needed as is for recognition
.S LENGTH=$P(NODE0,"^",2)
.S CONF=$P(NODE0,"^",7)
.S PKDICT=$P(NODE10,"^",3)
.S SUBPICS=$P(NODE10,"^",4)
;
;find top left-hand corner
S X1=((COL*COLWIDTH)+XOFFSET)*CONVERT,X1=$FN(X1,"",0)
S Y1=((ROW*ROWHT)+YOFFSET+YHANDOS)*CONVERT,Y1=$FN(Y1,"",0)
S XYSMALL=$P(^IBD(357.09,1,0),"^",12)
I XYSMALL'=+XYSMALL S XYSMALL=5 ;default
;
I READTYPE=3 D
.;define some marksense fields - if any marked it means there is print!
.S FIELD=FIELD+1
.D BLDARY^IBDFBKS("FIELD ' "_FIELD)
.D BLDARY^IBDFBKS(" NAME = """_NAME_"?"";")
.D BLDARY^IBDFBKS(" ELEMTYPE = RECT;")
.D BLDARY^IBDFBKS(" METRIC = 40 40 0 0 0 0 1 0 1;")
.D BLDARY^IBDFBKS(" TYPEDATA = INT;")
.D BLDARY^IBDFBKS(" LENGTH = ",LENGTH,";")
.D BLDARY^IBDFBKS(" POINTS =")
.F L=1:1:LINES F W=1:1:WIDTH D
..S X2=X1+((((W-1)*172.7645)+30)*CONVERT),X2=$FN(X2,"",0)
..S Y2=Y1+(((L*180)-39)*CONVERT),Y2=$FN(Y2,"",0)
..S IBDFSA(IBLC)=IBDFSA(IBLC)_" "_Y2+1_" "_X2+1
.S IBDFSA(IBLC)=IBDFSA(IBLC)_";"
.D BLDARY^IBDFBKS(" PAGE = ",PAGE,";")
.D BLDARY^IBDFBKS(" CONFIDENCE = "" 0"";")
.D BLDARY^IBDFBKS(" END = {if (FIELDSTATUS != FIELD_BLANK){")
.D BLDARY^IBDFBKS(" hasprint=1;")
.D BLDARY^IBDFBKS(" FIELDSTATUS=FIELD_BAD;")
.D BLDARY^IBDFBKS(" }")
.D BLDARY^IBDFBKS(" else {")
.D BLDARY^IBDFBKS(" hasprint=0;")
.D BLDARY^IBDFBKS(" NEXTFIELD=NEXTFIELD+1;")
.D BLDARY^IBDFBKS(" }};")
.D BLDARY^IBDFBKS(" EXFORMAT = ""NOEXPORT"";")
.D BLDARY^IBDFBKS(" HIDDEN = ""1"";")
;
;field is narrative that needs to be broken into single lines
I (LINES>1)&(READTYPE=2) D Q
.F LINENUM=1:1:LINES S:LINENUM>1 Y1=$FN(Y1+(2*ROWHT*CONVERT),"",0) D
..S X2=X1+(172.7654*WIDTH*CONVERT),X2=$FN(X2,"",0)
..S Y2=Y1+(180*CONVERT),Y2=$FN(Y2,"",0)
..D PRINTEND^IBDFBKS3
..D PKFIELD(X1+2,Y1+2,X2-2,Y2-2,2,PICTURE,0,CONF,PKDICT,WIDTH,TYPEDATA,NAME_" LINE "_LINENUM,2)
..;for handprint fields,must prefix data exported with field info - for bubbles the XMAP has the field info
..S @FIELDS@(PAGE,FIELD)="H:"_IEN_":",@FIELDS@(PAGE,FIELD,"DATATYPE")=TYPEDATA S:LINENUM=1 @FIELDS@(PAGE,FIELD,"START")=1 S:LINENUM=LINES @FIELDS@(PAGE,FIELD,"END")=1 S @FIELDS@(PAGE,FIELD,"MULT")=1
;
;field needs to be broken into subfields due to the print format
I (READTYPE=2)&(FORMAT'="") D Q
.N SUBFIELD,I1,I2,PREFIX,SX1,SX2,SPICTURE,LEN,FOUNDEND
.S PREFIX=$P(FORMAT,"_"),I1=$L(PREFIX)+1
.S Y2=Y1+(180*CONVERT),Y2=$FN(Y2,"",0)
.F Q:(I1>WIDTH) D
..S I2=I1
..S FOUNDEND=0 F D Q:FOUNDEND
...I $E(FORMAT,I2+1)="_" S I2=I2+1
...E S FOUNDEND=1 Q
..;so at this point I1=beginning of the subfield, I2=the end
..S SX1=$FN(X1+(172.7654*(I1-1)*CONVERT),"",0)
..S SX2=$FN(X1+(172.7654*(I2)*CONVERT),"",0)
..S SPICTURE=$E(SUBPICS,I1,I2)
..S LEN=(I2-I1)+1
..D PRINTEND^IBDFBKS3
..D PKFIELD(SX1+2,Y1+2,SX2-2,Y2-2,2,SPICTURE,1,0,"",LEN,"ALPHA",NAME_" Char:"_I1_" to "_I2)
..S SUBFIELD(FIELD)=""
..S (I1,I2)=I2+1
..S FOUNDEND=0 F D Q:FOUNDEND
...I $E(FORMAT,I2+1)="_" S FOUNDEND=1 Q
...I I2>WIDTH S FOUNDEND=1 Q
...S I2=I2+1 Q
..I $E(FORMAT,I1,I2)'="" S SUBFIELD(FIELD)=$E(FORMAT,I1,I2)
..S I1=I2+1
.;
.;now create a field to concatenate the subfields together
.S X2=X1+(172.7654*WIDTH*CONVERT),X2=$FN(X2,"",0)
.S Y2=Y1+(180*CONVERT),Y2=$FN(Y2,"",0)
.D PKFIELD(X1,Y1,X2,Y2,1,PICTURE,0,CONF,PKDICT,WIDTH,TYPEDATA,NAME,1)
.D
..D BLDARY^IBDFBKS("BEGIN = {ALPHA sfstr;")
..D BLDARY^IBDFBKS("ALPHA str;")
..D BLDARY^IBDFBKS("INT sfconf;")
..D BLDARY^IBDFBKS("INT conf;")
..D BLDARY^IBDFBKS("INT found;")
..D BLDARY^IBDFBKS("INT ret;")
..D BLDARY^IBDFBKS("INT position;") ; patch 25 code
..D BLDARY^IBDFBKS("INT delfield;") ; patch 25 code
..D BLDARY^IBDFBKS("found=0;")
..D BLDARY^IBDFBKS("conf=10;")
..I PREFIX'="" D BLDARY^IBDFBKS(" str=\"""_PREFIX_"\"";")
..N SUB S SUB=0 F S SUB=$O(SUBFIELD(SUB)) Q:'SUB D
...D BLDARY^IBDFBKS(" sfstr=STRIP(GETAVALUE("_SUB_"));")
...D BLDARY^IBDFBKS("str=STRCAT(str,sfstr);")
...D BLDARY^IBDFBKS("if (sfstr!=\""\"") found=1;")
...I SUBFIELD(SUB)'="" D BLDARY^IBDFBKS("str=STRCAT(sfstr,\"""_SUBFIELD(SUB)_"\"");")
...D BLDARY^IBDFBKS("sfconf=GETCONF("_SUB_");")
...D BLDARY^IBDFBKS("if (sfconf<conf) conf=sfconf;")
..;
..; patch 25 code starts here, remove dashes and dots
..D BLDARY^IBDFBKS("")
..D BLDARY^IBDFBKS("delfield = 0;")
..D BLDARY^IBDFBKS("position = STRFIND(str,\"".\"",1);")
..D BLDARY^IBDFBKS("if (position == 1) delfield = 1;")
..D BLDARY^IBDFBKS("position = STRFIND(\"" . -----.. -....-----.-.--.../////--/.@.\"",str,1);")
..D BLDARY^IBDFBKS("if (position != 0 || delfield == 1) {")
..D BLDARY^IBDFBKS(" if (str != \"".\"") LOG(STRCAT(\""The following handprint field "_FIELD_" value was deleted: \"",str));")
..D BLDARY^IBDFBKS(" str = \""\"";")
..D BLDARY^IBDFBKS(" conf = 10;")
..D BLDARY^IBDFBKS(" found = 0;}")
..D BLDARY^IBDFBKS("")
..;
..D BLDARY^IBDFBKS("if (found) ret=SETTEXT("_FIELD_",str,ITOA(conf-1),FIELD_OK);")
..D BLDARY^IBDFBKS("if (found == 0) ret=SETTEXT("_FIELD_",\""\"",ITOA(conf-1),FIELD_BLANK);")
..D BLDARY^IBDFBKS("};")
.;
.;for handprint fields,must prefix data exported with field info - for bubbles the XMAP has the field info
.S @FIELDS@(PAGE,FIELD)="H:"_IEN_":",@FIELDS@(PAGE,FIELD,"DATATYPE")=TYPEDATA
;
;following are handprint fields that don't need to be broken into subfields
;
I READTYPE=1 D ;not printed in ICR format
.D CNVRTHT^IBDF2D1(LINES,.LINES)
.S X2=X1+(103.65924*WIDTH*CONVERT),X2=$FN(X2,"",0)
.S Y2=Y1+(ROWHT*LINES*CONVERT),Y2=$FN(Y2,"",0)
;
I READTYPE'=1 D ;printed in ICR format
.S X2=X1+(172.7654*WIDTH*CONVERT),X2=$FN(X2,"",0)
.S Y2=Y1+(180*LINES*CONVERT),Y2=$FN(Y2,"",0)
;
D PRINTEND^IBDFBKS3
D:READTYPE=2 PKFIELD(X1+2,Y1+2,X2-2,Y2-2,READTYPE,PICTURE,0,CONF,PKDICT,WIDTH,TYPEDATA,NAME,2)
;
D:READTYPE'=2 PKFIELD(X1,Y1,X2,Y2,READTYPE,PICTURE,0,"","",LENGTH,TYPEDATA,NAME)
S @FIELDS@(PAGE,FIELD)="H:"_IEN_":",@FIELDS@(PAGE,FIELD,"DATATYPE")=TYPEDATA
;
;** END STUFF **
I READTYPE'=2 D ;test the results of the marksense fields that were laid on top of the operator fill field
.D ADDTOEND^IBDFBKS3(" if ((hasprint)&&(FIELDACCEPTED==0)){")
.D ADDTOEND^IBDFBKS3(" FIELDSTATUS=FIELD_BAD;}")
Q
;
PKFIELD(X1,Y1,X2,Y2,READTYPE,PICTURE,HIDDEN,CONF,PKDICT,LENGTH,TYPEDATA,NAME,ENDPGM) ;
; -- now for the handprint field
S FIELD=FIELD+1
D BLDARY^IBDFBKS("FIELD ' "_FIELD)
D BLDARY^IBDFBKS(" NAME = """_NAME_""";")
;
I READTYPE=2 D
.D BLDARY^IBDFBKS(" ELEMTYPE = ELEM_OT;")
.D BLDARY^IBDFBKS(" METRIC = 2;")
;
E D
.D BLDARY^IBDFBKS(" ELEMTYPE = ELEM_OT;")
.D BLDARY^IBDFBKS(" METRIC = 1;")
;
D BLDARY^IBDFBKS(" DATATYPE ="_TYPEDATA_";")
D BLDARY^IBDFBKS(" LENGTH = "_LENGTH_";")
D BLDARY^IBDFBKS(" POINTS = "_(Y1+XYSMALL)_" "_(X1+XYSMALL)_" "_(Y2-XYSMALL)_" "_(X2-XYSMALL)_";")
D BLDARY^IBDFBKS(" PAGE = "_PAGE_";")
I CONF'="" D BLDARY^IBDFBKS(" CONFIDENCE = """_CONF_""";")
I HIDDEN D BLDARY^IBDFBKS(" HIDDEN = ""1"";")
I $G(ENDPGM) D HPSKIP
;
;** IMAGE PROCESSING **
I READTYPE=2 D
.D BLDARY^IBDFBKS(" ImageProcessing = {")
.D BLDARY^IBDFBKS(" IMAGEPROC=1")
.D BLDARY^IBDFBKS(" DESKEW=0")
.D BLDARY^IBDFBKS(" DESHADE=0")
.D BLDARY^IBDFBKS(" SMOOTH=1")
.D BLDARY^IBDFBKS(" REMOVE_BORDER=1")
.D BLDARY^IBDFBKS(" REMOVE_NOISE=0")
.D BLDARY^IBDFBKS(" PROC_MIN_VERT_LINE_LEN=70")
.D BLDARY^IBDFBKS(" PROC_MIN_HORZ_LINE_LEN=70")
.D BLDARY^IBDFBKS(" FATTYPE=0")
.D BLDARY^IBDFBKS(" FATTEN=0};")
.D BLDARY^IBDFBKS(" Recognition = {FIXED_WIDTH=1")
.D BLDARY^IBDFBKS(" OT_RECOGTYPE=HP")
.D BLDARY^IBDFBKS(" };")
;
;** begin program **
I $G(ENDPGM)=2 D
.D BLDARY^IBDFBKS("BEGIN = {ALPHA str;")
.D BLDARY^IBDFBKS("INT conf;")
.D BLDARY^IBDFBKS("INT ret;")
.D BLDARY^IBDFBKS(" conf = GETCONF("_FIELD_");")
.D BLDARY^IBDFBKS(" if (GETSTATUS("_FIELD_") == FIELD_BLANK) {")
.D BLDARY^IBDFBKS(" ret=SETTEXT("_FIELD_",\""\"",ITOA(conf-1),FIELD_BLANK); }")
.D BLDARY^IBDFBKS("if (ret) FIELDSTATUS = FIELD_ERROR;")
.D BLDARY^IBDFBKS("};")
.;
I PKDICT'="" D BLDARY^IBDFBKS(" DICTIONARY = """_PKDICT_""";")
I PICTURE'="",TYPEDATA="ALPHA" D BLDARY^IBDFBKS(" PICTURE = """_PICTURE_""";")
Q
HPSKIP ; If hand print field blank, skip it
D ADDTOEND^IBDFBKS3(" if ((GETSTATUS(FIELDNAME) != FIELD_BLANK) && (FIELDACCEPTED == 0)) {")
D ADDTOEND^IBDFBKS3(" FIELDSTATUS = FIELD_BAD;")
D ADDTOEND^IBDFBKS3(" saveunrf = "_FIELD_";}")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFBKS2 9336 printed Apr 09, 2024@21:04:49 Page 2
IBDFBKS2 ;ALB/CJM/AAS - Create form spec for scanning ; 6-JUN-95
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**3,25**;APR 24, 1997
+2 ;
HANDPRNT(IEN,NAME,PAGE,ROW,COL,WIDTH,LINES,READTYPE,PAPKEY,PI) ;
+1 ;
+2 if ($PIECE($GET(^IBE(357.6,+PI,0)),"^",6)'=1)
QUIT
+3 ;
+4 NEW X1,X2,Y1,Y2,W,PICTURE,TYPEDATA,NODE0,LENGTH,LINENUM,PKDICT,CONF,L,SUBPICS,FORMAT,XYSMALL
+5 SET TYPEDATA="ALPHA"
SET PICTURE=""
+6 ;
+7 ; -- get info associated with DHCP Data Element
+8 IF PAPKEY
Begin DoDot:1
+9 SET NODE0=$GET(^IBE(359.1,PAPKEY,0))
SET NODE10=$GET(^(10))
+10 SET TYPEDATA=$PIECE(NODE10,"^",1)
+11 SET TYPEDATA=$SELECT(TYPEDATA="a":"ALPHA",TYPEDATA="i":"INT",TYPEDATA="f":"FLOAT",TYPEDATA="t":"TIME",TYPEDATA="d":"DATE",1:"ALPHA")
+12 SET PICTURE=$PIECE(NODE10,"^",2)
+13 ;don't set year in format, needed as is for recognition
SET FORMAT=$PIECE(NODE0,"^",5)
+14 SET LENGTH=$PIECE(NODE0,"^",2)
+15 SET CONF=$PIECE(NODE0,"^",7)
+16 SET PKDICT=$PIECE(NODE10,"^",3)
+17 SET SUBPICS=$PIECE(NODE10,"^",4)
End DoDot:1
+18 ;
+19 ;find top left-hand corner
+20 SET X1=((COL*COLWIDTH)+XOFFSET)*CONVERT
SET X1=$FNUMBER(X1,"",0)
+21 SET Y1=((ROW*ROWHT)+YOFFSET+YHANDOS)*CONVERT
SET Y1=$FNUMBER(Y1,"",0)
+22 SET XYSMALL=$PIECE(^IBD(357.09,1,0),"^",12)
+23 ;default
IF XYSMALL'=+XYSMALL
SET XYSMALL=5
+24 ;
+25 IF READTYPE=3
Begin DoDot:1
+26 ;define some marksense fields - if any marked it means there is print!
+27 SET FIELD=FIELD+1
+28 DO BLDARY^IBDFBKS("FIELD ' "_FIELD)
+29 DO BLDARY^IBDFBKS(" NAME = """_NAME_"?"";")
+30 DO BLDARY^IBDFBKS(" ELEMTYPE = RECT;")
+31 DO BLDARY^IBDFBKS(" METRIC = 40 40 0 0 0 0 1 0 1;")
+32 DO BLDARY^IBDFBKS(" TYPEDATA = INT;")
+33 DO BLDARY^IBDFBKS(" LENGTH = ",LENGTH,";")
+34 DO BLDARY^IBDFBKS(" POINTS =")
+35 FOR L=1:1:LINES
FOR W=1:1:WIDTH
Begin DoDot:2
+36 SET X2=X1+((((W-1)*172.7645)+30)*CONVERT)
SET X2=$FNUMBER(X2,"",0)
+37 SET Y2=Y1+(((L*180)-39)*CONVERT)
SET Y2=$FNUMBER(Y2,"",0)
+38 SET IBDFSA(IBLC)=IBDFSA(IBLC)_" "_Y2+1_" "_X2+1
End DoDot:2
+39 SET IBDFSA(IBLC)=IBDFSA(IBLC)_";"
+40 DO BLDARY^IBDFBKS(" PAGE = ",PAGE,";")
+41 DO BLDARY^IBDFBKS(" CONFIDENCE = "" 0"";")
+42 DO BLDARY^IBDFBKS(" END = {if (FIELDSTATUS != FIELD_BLANK){")
+43 DO BLDARY^IBDFBKS(" hasprint=1;")
+44 DO BLDARY^IBDFBKS(" FIELDSTATUS=FIELD_BAD;")
+45 DO BLDARY^IBDFBKS(" }")
+46 DO BLDARY^IBDFBKS(" else {")
+47 DO BLDARY^IBDFBKS(" hasprint=0;")
+48 DO BLDARY^IBDFBKS(" NEXTFIELD=NEXTFIELD+1;")
+49 DO BLDARY^IBDFBKS(" }};")
+50 DO BLDARY^IBDFBKS(" EXFORMAT = ""NOEXPORT"";")
+51 DO BLDARY^IBDFBKS(" HIDDEN = ""1"";")
End DoDot:1
+52 ;
+53 ;field is narrative that needs to be broken into single lines
+54 IF (LINES>1)&(READTYPE=2)
Begin DoDot:1
+55 FOR LINENUM=1:1:LINES
if LINENUM>1
SET Y1=$FNUMBER(Y1+(2*ROWHT*CONVERT),"",0)
Begin DoDot:2
+56 SET X2=X1+(172.7654*WIDTH*CONVERT)
SET X2=$FNUMBER(X2,"",0)
+57 SET Y2=Y1+(180*CONVERT)
SET Y2=$FNUMBER(Y2,"",0)
+58 DO PRINTEND^IBDFBKS3
+59 DO PKFIELD(X1+2,Y1+2,X2-2,Y2-2,2,PICTURE,0,CONF,PKDICT,WIDTH,TYPEDATA,NAME_" LINE "_LINENUM,2)
+60 ;for handprint fields,must prefix data exported with field info - for bubbles the XMAP has the field info
+61 SET @FIELDS@(PAGE,FIELD)="H:"_IEN_":"
SET @FIELDS@(PAGE,FIELD,"DATATYPE")=TYPEDATA
if LINENUM=1
SET @FIELDS@(PAGE,FIELD,"START")=1
if LINENUM=LINES
SET @FIELDS@(PAGE,FIELD,"END")=1
SET @FIELDS@(PAGE,FIELD,"MULT")=1
End DoDot:2
End DoDot:1
QUIT
+62 ;
+63 ;field needs to be broken into subfields due to the print format
+64 IF (READTYPE=2)&(FORMAT'="")
Begin DoDot:1
+65 NEW SUBFIELD,I1,I2,PREFIX,SX1,SX2,SPICTURE,LEN,FOUNDEND
+66 SET PREFIX=$PIECE(FORMAT,"_")
SET I1=$LENGTH(PREFIX)+1
+67 SET Y2=Y1+(180*CONVERT)
SET Y2=$FNUMBER(Y2,"",0)
+68 FOR
if (I1>WIDTH)
QUIT
Begin DoDot:2
+69 SET I2=I1
+70 SET FOUNDEND=0
FOR
Begin DoDot:3
+71 IF $EXTRACT(FORMAT,I2+1)="_"
SET I2=I2+1
+72 IF '$TEST
SET FOUNDEND=1
QUIT
End DoDot:3
if FOUNDEND
QUIT
+73 ;so at this point I1=beginning of the subfield, I2=the end
+74 SET SX1=$FNUMBER(X1+(172.7654*(I1-1)*CONVERT),"",0)
+75 SET SX2=$FNUMBER(X1+(172.7654*(I2)*CONVERT),"",0)
+76 SET SPICTURE=$EXTRACT(SUBPICS,I1,I2)
+77 SET LEN=(I2-I1)+1
+78 DO PRINTEND^IBDFBKS3
+79 DO PKFIELD(SX1+2,Y1+2,SX2-2,Y2-2,2,SPICTURE,1,0,"",LEN,"ALPHA",NAME_" Char:"_I1_" to "_I2)
+80 SET SUBFIELD(FIELD)=""
+81 SET (I1,I2)=I2+1
+82 SET FOUNDEND=0
FOR
Begin DoDot:3
+83 IF $EXTRACT(FORMAT,I2+1)="_"
SET FOUNDEND=1
QUIT
+84 IF I2>WIDTH
SET FOUNDEND=1
QUIT
+85 SET I2=I2+1
QUIT
End DoDot:3
if FOUNDEND
QUIT
+86 IF $EXTRACT(FORMAT,I1,I2)'=""
SET SUBFIELD(FIELD)=$EXTRACT(FORMAT,I1,I2)
+87 SET I1=I2+1
End DoDot:2
+88 ;
+89 ;now create a field to concatenate the subfields together
+90 SET X2=X1+(172.7654*WIDTH*CONVERT)
SET X2=$FNUMBER(X2,"",0)
+91 SET Y2=Y1+(180*CONVERT)
SET Y2=$FNUMBER(Y2,"",0)
+92 DO PKFIELD(X1,Y1,X2,Y2,1,PICTURE,0,CONF,PKDICT,WIDTH,TYPEDATA,NAME,1)
+93 Begin DoDot:2
+94 DO BLDARY^IBDFBKS("BEGIN = {ALPHA sfstr;")
+95 DO BLDARY^IBDFBKS("ALPHA str;")
+96 DO BLDARY^IBDFBKS("INT sfconf;")
+97 DO BLDARY^IBDFBKS("INT conf;")
+98 DO BLDARY^IBDFBKS("INT found;")
+99 DO BLDARY^IBDFBKS("INT ret;")
+100 ; patch 25 code
DO BLDARY^IBDFBKS("INT position;")
+101 ; patch 25 code
DO BLDARY^IBDFBKS("INT delfield;")
+102 DO BLDARY^IBDFBKS("found=0;")
+103 DO BLDARY^IBDFBKS("conf=10;")
+104 IF PREFIX'=""
DO BLDARY^IBDFBKS(" str=\"""_PREFIX_"\"";")
+105 NEW SUB
SET SUB=0
FOR
SET SUB=$ORDER(SUBFIELD(SUB))
if 'SUB
QUIT
Begin DoDot:3
+106 DO BLDARY^IBDFBKS(" sfstr=STRIP(GETAVALUE("_SUB_"));")
+107 DO BLDARY^IBDFBKS("str=STRCAT(str,sfstr);")
+108 DO BLDARY^IBDFBKS("if (sfstr!=\""\"") found=1;")
+109 IF SUBFIELD(SUB)'=""
DO BLDARY^IBDFBKS("str=STRCAT(sfstr,\"""_SUBFIELD(SUB)_"\"");")
+110 DO BLDARY^IBDFBKS("sfconf=GETCONF("_SUB_");")
+111 DO BLDARY^IBDFBKS("if (sfconf<conf) conf=sfconf;")
End DoDot:3
+112 ;
+113 ; patch 25 code starts here, remove dashes and dots
+114 DO BLDARY^IBDFBKS("")
+115 DO BLDARY^IBDFBKS("delfield = 0;")
+116 DO BLDARY^IBDFBKS("position = STRFIND(str,\"".\"",1);")
+117 DO BLDARY^IBDFBKS("if (position == 1) delfield = 1;")
+118 DO BLDARY^IBDFBKS("position = STRFIND(\"" . -----.. -....-----.-.--.../////--/.@.\"",str,1);")
+119 DO BLDARY^IBDFBKS("if (position != 0 || delfield == 1) {")
+120 DO BLDARY^IBDFBKS(" if (str != \"".\"") LOG(STRCAT(\""The following handprint field "_FIELD_" value was deleted: \"",str));")
+121 DO BLDARY^IBDFBKS(" str = \""\"";")
+122 DO BLDARY^IBDFBKS(" conf = 10;")
+123 DO BLDARY^IBDFBKS(" found = 0;}")
+124 DO BLDARY^IBDFBKS("")
+125 ;
+126 DO BLDARY^IBDFBKS("if (found) ret=SETTEXT("_FIELD_",str,ITOA(conf-1),FIELD_OK);")
+127 DO BLDARY^IBDFBKS("if (found == 0) ret=SETTEXT("_FIELD_",\""\"",ITOA(conf-1),FIELD_BLANK);")
+128 DO BLDARY^IBDFBKS("};")
End DoDot:2
+129 ;
+130 ;for handprint fields,must prefix data exported with field info - for bubbles the XMAP has the field info
+131 SET @FIELDS@(PAGE,FIELD)="H:"_IEN_":"
SET @FIELDS@(PAGE,FIELD,"DATATYPE")=TYPEDATA
End DoDot:1
QUIT
+132 ;
+133 ;following are handprint fields that don't need to be broken into subfields
+134 ;
+135 ;not printed in ICR format
IF READTYPE=1
Begin DoDot:1
+136 DO CNVRTHT^IBDF2D1(LINES,.LINES)
+137 SET X2=X1+(103.65924*WIDTH*CONVERT)
SET X2=$FNUMBER(X2,"",0)
+138 SET Y2=Y1+(ROWHT*LINES*CONVERT)
SET Y2=$FNUMBER(Y2,"",0)
End DoDot:1
+139 ;
+140 ;printed in ICR format
IF READTYPE'=1
Begin DoDot:1
+141 SET X2=X1+(172.7654*WIDTH*CONVERT)
SET X2=$FNUMBER(X2,"",0)
+142 SET Y2=Y1+(180*LINES*CONVERT)
SET Y2=$FNUMBER(Y2,"",0)
End DoDot:1
+143 ;
+144 DO PRINTEND^IBDFBKS3
+145 if READTYPE=2
DO PKFIELD(X1+2,Y1+2,X2-2,Y2-2,READTYPE,PICTURE,0,CONF,PKDICT,WIDTH,TYPEDATA,NAME,2)
+146 ;
+147 if READTYPE'=2
DO PKFIELD(X1,Y1,X2,Y2,READTYPE,PICTURE,0,"","",LENGTH,TYPEDATA,NAME)
+148 SET @FIELDS@(PAGE,FIELD)="H:"_IEN_":"
SET @FIELDS@(PAGE,FIELD,"DATATYPE")=TYPEDATA
+149 ;
+150 ;** END STUFF **
+151 ;test the results of the marksense fields that were laid on top of the operator fill field
IF READTYPE'=2
Begin DoDot:1
+152 DO ADDTOEND^IBDFBKS3(" if ((hasprint)&&(FIELDACCEPTED==0)){")
+153 DO ADDTOEND^IBDFBKS3(" FIELDSTATUS=FIELD_BAD;}")
End DoDot:1
+154 QUIT
+155 ;
PKFIELD(X1,Y1,X2,Y2,READTYPE,PICTURE,HIDDEN,CONF,PKDICT,LENGTH,TYPEDATA,NAME,ENDPGM) ;
+1 ; -- now for the handprint field
+2 SET FIELD=FIELD+1
+3 DO BLDARY^IBDFBKS("FIELD ' "_FIELD)
+4 DO BLDARY^IBDFBKS(" NAME = """_NAME_""";")
+5 ;
+6 IF READTYPE=2
Begin DoDot:1
+7 DO BLDARY^IBDFBKS(" ELEMTYPE = ELEM_OT;")
+8 DO BLDARY^IBDFBKS(" METRIC = 2;")
End DoDot:1
+9 ;
+10 IF '$TEST
Begin DoDot:1
+11 DO BLDARY^IBDFBKS(" ELEMTYPE = ELEM_OT;")
+12 DO BLDARY^IBDFBKS(" METRIC = 1;")
End DoDot:1
+13 ;
+14 DO BLDARY^IBDFBKS(" DATATYPE ="_TYPEDATA_";")
+15 DO BLDARY^IBDFBKS(" LENGTH = "_LENGTH_";")
+16 DO BLDARY^IBDFBKS(" POINTS = "_(Y1+XYSMALL)_" "_(X1+XYSMALL)_" "_(Y2-XYSMALL)_" "_(X2-XYSMALL)_";")
+17 DO BLDARY^IBDFBKS(" PAGE = "_PAGE_";")
+18 IF CONF'=""
DO BLDARY^IBDFBKS(" CONFIDENCE = """_CONF_""";")
+19 IF HIDDEN
DO BLDARY^IBDFBKS(" HIDDEN = ""1"";")
+20 IF $GET(ENDPGM)
DO HPSKIP
+21 ;
+22 ;** IMAGE PROCESSING **
+23 IF READTYPE=2
Begin DoDot:1
+24 DO BLDARY^IBDFBKS(" ImageProcessing = {")
+25 DO BLDARY^IBDFBKS(" IMAGEPROC=1")
+26 DO BLDARY^IBDFBKS(" DESKEW=0")
+27 DO BLDARY^IBDFBKS(" DESHADE=0")
+28 DO BLDARY^IBDFBKS(" SMOOTH=1")
+29 DO BLDARY^IBDFBKS(" REMOVE_BORDER=1")
+30 DO BLDARY^IBDFBKS(" REMOVE_NOISE=0")
+31 DO BLDARY^IBDFBKS(" PROC_MIN_VERT_LINE_LEN=70")
+32 DO BLDARY^IBDFBKS(" PROC_MIN_HORZ_LINE_LEN=70")
+33 DO BLDARY^IBDFBKS(" FATTYPE=0")
+34 DO BLDARY^IBDFBKS(" FATTEN=0};")
+35 DO BLDARY^IBDFBKS(" Recognition = {FIXED_WIDTH=1")
+36 DO BLDARY^IBDFBKS(" OT_RECOGTYPE=HP")
+37 DO BLDARY^IBDFBKS(" };")
End DoDot:1
+38 ;
+39 ;** begin program **
+40 IF $GET(ENDPGM)=2
Begin DoDot:1
+41 DO BLDARY^IBDFBKS("BEGIN = {ALPHA str;")
+42 DO BLDARY^IBDFBKS("INT conf;")
+43 DO BLDARY^IBDFBKS("INT ret;")
+44 DO BLDARY^IBDFBKS(" conf = GETCONF("_FIELD_");")
+45 DO BLDARY^IBDFBKS(" if (GETSTATUS("_FIELD_") == FIELD_BLANK) {")
+46 DO BLDARY^IBDFBKS(" ret=SETTEXT("_FIELD_",\""\"",ITOA(conf-1),FIELD_BLANK); }")
+47 DO BLDARY^IBDFBKS("if (ret) FIELDSTATUS = FIELD_ERROR;")
+48 DO BLDARY^IBDFBKS("};")
+49 ;
End DoDot:1
+50 IF PKDICT'=""
DO BLDARY^IBDFBKS(" DICTIONARY = """_PKDICT_""";")
+51 IF PICTURE'=""
IF TYPEDATA="ALPHA"
DO BLDARY^IBDFBKS(" PICTURE = """_PICTURE_""";")
+52 QUIT
HPSKIP ; If hand print field blank, skip it
+1 DO ADDTOEND^IBDFBKS3(" if ((GETSTATUS(FIELDNAME) != FIELD_BLANK) && (FIELDACCEPTED == 0)) {")
+2 DO ADDTOEND^IBDFBKS3(" FIELDSTATUS = FIELD_BAD;")
+3 DO ADDTOEND^IBDFBKS3(" saveunrf = "_FIELD_";}")
+4 QUIT
