source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF2D1.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1IBDF2D1 ;ALB/CJM - ENCOUNTER FORM - PRINT SELECTION LIST (cont'd) ;NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3GETCOL(COL) ;finds next column
4 ;COL - array where output data stored,SHOULD BE PASSED BY REFERENCE
5 ;COL=last column number processed
6 ;COL("Y")=columns starting row relative to block
7 ;COL("X")=column's starting column relative to block
8 ;COL("H")=column's height, i.e., maximum # of selections
9 ;
10 S COL=$G(COL)+1
11 S NEEDUPR=0
12 I COL=1 S COL("H")=+IBLIST("H",1),COL("X")=+IBLIST("X",1),COL("Y")=+IBLIST("Y",1)
13 I COL>IBLIST("NUMCOL") S COL=0 Q
14 I $G(IBLIST("Y",COL))'=+$G(IBLIST("Y",COL)) D
15 .I COL=1 S COL("Y")=$S(IBBLK("HDR")="":BOX,1:2+BOX)
16 .I COL'=1 Q ;leave value from prior col
17 E S COL("Y")=$G(IBLIST("Y",COL))
18 I $G(IBLIST("X",COL))'=+$G(IBLIST("X",COL)) D
19 .Q:COL=1
20 .S COL("X")=COL("X")+CWIDTH+$S(IBLIST("SEP")=" ":2,IBLIST("SEP")=" ":4,1:0)
21 E S COL("X")=$G(IBLIST("X",COL))
22 I $G(IBLIST("H",COL))'=+$G(IBLIST("H",COL)) D
23 .I COL=1 S COL("H")=IBBLK("H")
24 .I COL'=1 Q ;leave value from prior col
25 E S COL("H")=$G(IBLIST("H",COL))
26 I BOX,'LINE,COL("X")=0 S COL("X")=1
27 I (COL("X")+CWIDTH+(('LINE)&BOX))>IBBLK("W") S COL=0 Q
28 I (COL("Y")+COL("H"))>(IBBLK("H")-(2*BOX)) S COL("H")=(IBBLK("H")-(COL("Y")+BOX))
29 S COL("ROWSLEFT")=COL("H"),COL("NEXTROW")=0
30 Q
31 ;
32DRWCOL(COL) ;draws one column of the selection list except for its contents and rows
33 N I,OFFSET,WIDTH
34 I LINE,(COL("X")'=0)!('BOX),ALL D DRWVLINE^IBDFU($$Y^IBDF2D,$$X^IBDF2D,COL("H"),"|")
35 I LINE,('BOX)!(COL("X")+CWIDTH'=IBBLK("W")),ALL D DRWVLINE^IBDFU($$Y^IBDF2D,$$X^IBDF2D+(CWIDTH-1),COL("H"),"|")
36 ;
37 ;draw the column header
38 I IBLIST("HDR")'="",(COL("ROWSLEFT")>0) D:ALL D DECREASE^IBDF2D(.COL)
39 .S IBLIST("DHDR")=$TR(IBLIST("DHDR"),"RS","rs")
40 .;only affects forms with big print - bold otherwise not available
41 .I (IBLIST("DHDR")["s")!(IBLIST("DHDR")["r"),IBLIST("DHDR")'["B",IBFORM("WIDTH")<100 S IBLIST("DHDR")=IBLIST("DHDR")_"B"
42 .I IBFORM("WIDTH")>100 S IBLIST("DHDR")=$TR(IBLIST("DHDR"),"B")
43 .;
44 .S WIDTH=CWIDTH-(2*LINE)
45 .S OFFSET=LINE
46 .I IBLIST("DHDR")["C",$L(IBLIST("HDR"))<WIDTH S OFFSET=OFFSET+((WIDTH-$L(IBLIST("HDR")))\2)
47 .D DRWSTR^IBDFU($$Y^IBDF2D,($$X^IBDF2D)+LINE,$J("",OFFSET)_IBLIST("HDR"),$TR(IBLIST("DHDR"),"C",""),WIDTH)
48 ;
49 ;draw the header line for the subcolumns
50 I COL("ROWSLEFT")>0,IBLIST("CHDR")]"" D:ALL D DECREASE^IBDF2D(.COL)
51 .S IBLIST("DSCHDR")=$TR(IBLIST("DSCHDR"),"R","r")
52 .;only affects forms with big print - bold otherwise not available
53 .I IBLIST("DSCHDR")["r",IBLIST("DSCHDR")'["B",IBFORM("WIDTH")<100 S IBLIST("DSCHDR")=IBLIST("DSCHDR")_"B"
54 .I IBFORM("WIDTH")>100 S IBLIST("DSCHDR")=$TR(IBLIST("DSCHDR"),"B")
55 .;
56 .;apply options across entire line?
57 .;if nothing else applies uderline SCs (maybe)
58 .I IBLIST("ULSLCTNS")!LINE!(BOX&(CWIDTH>(IBBLK("W")-3-(2*(IBLIST("SEP1")))))) D Q
59 ..I IBLIST("DSCHDR")="",IBLIST("ULSLCTNS") S IBLIST("DSCHDR")=IBLIST("DSCHDR")_"U"
60 ..D DRWSTR^IBDFU($$Y^IBDF2D,($$X^IBDF2D)+LINE,IBLIST("CHDR"),IBLIST("DSCHDR"),CWIDTH-(2*LINE))
61 .;
62 .;apply display options just to the text, not accross the column
63 .I IBLIST("DSCHDR")="" S IBLIST("DSCHDR")="U"
64 .F I=1-IBLIST("SC0"):1:8 I IBLIST("SCTYPE",I)'="",IBLIST("SCHDR",I)'="" D DRWSTR^IBDFU($$Y^IBDF2D,(($$X^IBDF2D)+IBLIST("SCOS",I)),IBLIST("SCHDR",I),IBLIST("DSCHDR"),$L(IBLIST("SCHDR",I)))
65 Q
66 ;
67CNVRTHT(HPLINES,LINES) ;changes HPLINES=number of handprint lines into LINES=print lines on the page
68 ;pass LINES by reference
69 S LINES=$FN(1.5*HPLINES,"",0)
70 Q
71 ;
72CNVRTLEN(HPWIDTH,WIDTH) ;changes HPWIDTH=width in terms of handprint characters into width in terms of columns(machine print characters)
73 ;pass WIDTH by reference
74 ;
75 N COLWIDTH
76 D
77 .I IBFORM("WIDTH")>96 S COLWIDTH=720/16.67 Q
78 .I IBFORM("WIDTH")>80 S COLWIDTH=60 Q
79 .S COLWIDTH=72
80 S WIDTH=$FN(.49+((HPWIDTH*103.65924)/COLWIDTH),"",0)
81 Q
Note: See TracBrowser for help on using the repository browser.