- IBDF2D1 ;ALB/CJM - ENCOUNTER FORM - PRINT SELECTION LIST (cont'd) ;NOV 16,1992
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- GETCOL(COL) ;finds next column
- ;COL - array where output data stored,SHOULD BE PASSED BY REFERENCE
- ;COL=last column number processed
- ;COL("Y")=columns starting row relative to block
- ;COL("X")=column's starting column relative to block
- ;COL("H")=column's height, i.e., maximum # of selections
- ;
- S COL=$G(COL)+1
- S NEEDUPR=0
- I COL=1 S COL("H")=+IBLIST("H",1),COL("X")=+IBLIST("X",1),COL("Y")=+IBLIST("Y",1)
- I COL>IBLIST("NUMCOL") S COL=0 Q
- I $G(IBLIST("Y",COL))'=+$G(IBLIST("Y",COL)) D
- .I COL=1 S COL("Y")=$S(IBBLK("HDR")="":BOX,1:2+BOX)
- .I COL'=1 Q ;leave value from prior col
- E S COL("Y")=$G(IBLIST("Y",COL))
- I $G(IBLIST("X",COL))'=+$G(IBLIST("X",COL)) D
- .Q:COL=1
- .S COL("X")=COL("X")+CWIDTH+$S(IBLIST("SEP")=" ":2,IBLIST("SEP")=" ":4,1:0)
- E S COL("X")=$G(IBLIST("X",COL))
- I $G(IBLIST("H",COL))'=+$G(IBLIST("H",COL)) D
- .I COL=1 S COL("H")=IBBLK("H")
- .I COL'=1 Q ;leave value from prior col
- E S COL("H")=$G(IBLIST("H",COL))
- I BOX,'LINE,COL("X")=0 S COL("X")=1
- I (COL("X")+CWIDTH+(('LINE)&BOX))>IBBLK("W") S COL=0 Q
- I (COL("Y")+COL("H"))>(IBBLK("H")-(2*BOX)) S COL("H")=(IBBLK("H")-(COL("Y")+BOX))
- S COL("ROWSLEFT")=COL("H"),COL("NEXTROW")=0
- Q
- ;
- DRWCOL(COL) ;draws one column of the selection list except for its contents and rows
- N I,OFFSET,WIDTH
- I LINE,(COL("X")'=0)!('BOX),ALL D DRWVLINE^IBDFU($$Y^IBDF2D,$$X^IBDF2D,COL("H"),"|")
- I LINE,('BOX)!(COL("X")+CWIDTH'=IBBLK("W")),ALL D DRWVLINE^IBDFU($$Y^IBDF2D,$$X^IBDF2D+(CWIDTH-1),COL("H"),"|")
- ;
- ;draw the column header
- I IBLIST("HDR")'="",(COL("ROWSLEFT")>0) D:ALL D DECREASE^IBDF2D(.COL)
- .S IBLIST("DHDR")=$TR(IBLIST("DHDR"),"RS","rs")
- .;only affects forms with big print - bold otherwise not available
- .I (IBLIST("DHDR")["s")!(IBLIST("DHDR")["r"),IBLIST("DHDR")'["B",IBFORM("WIDTH")<100 S IBLIST("DHDR")=IBLIST("DHDR")_"B"
- .I IBFORM("WIDTH")>100 S IBLIST("DHDR")=$TR(IBLIST("DHDR"),"B")
- .;
- .S WIDTH=CWIDTH-(2*LINE)
- .S OFFSET=LINE
- .I IBLIST("DHDR")["C",$L(IBLIST("HDR"))<WIDTH S OFFSET=OFFSET+((WIDTH-$L(IBLIST("HDR")))\2)
- .D DRWSTR^IBDFU($$Y^IBDF2D,($$X^IBDF2D)+LINE,$J("",OFFSET)_IBLIST("HDR"),$TR(IBLIST("DHDR"),"C",""),WIDTH)
- ;
- ;draw the header line for the subcolumns
- I COL("ROWSLEFT")>0,IBLIST("CHDR")]"" D:ALL D DECREASE^IBDF2D(.COL)
- .S IBLIST("DSCHDR")=$TR(IBLIST("DSCHDR"),"R","r")
- .;only affects forms with big print - bold otherwise not available
- .I IBLIST("DSCHDR")["r",IBLIST("DSCHDR")'["B",IBFORM("WIDTH")<100 S IBLIST("DSCHDR")=IBLIST("DSCHDR")_"B"
- .I IBFORM("WIDTH")>100 S IBLIST("DSCHDR")=$TR(IBLIST("DSCHDR"),"B")
- .;
- .;apply options across entire line?
- .;if nothing else applies uderline SCs (maybe)
- .I IBLIST("ULSLCTNS")!LINE!(BOX&(CWIDTH>(IBBLK("W")-3-(2*(IBLIST("SEP1")))))) D Q
- ..I IBLIST("DSCHDR")="",IBLIST("ULSLCTNS") S IBLIST("DSCHDR")=IBLIST("DSCHDR")_"U"
- ..D DRWSTR^IBDFU($$Y^IBDF2D,($$X^IBDF2D)+LINE,IBLIST("CHDR"),IBLIST("DSCHDR"),CWIDTH-(2*LINE))
- .;
- .;apply display options just to the text, not accross the column
- .I IBLIST("DSCHDR")="" S IBLIST("DSCHDR")="U"
- .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)))
- Q
- ;
- CNVRTHT(HPLINES,LINES) ;changes HPLINES=number of handprint lines into LINES=print lines on the page
- ;pass LINES by reference
- S LINES=$FN(1.5*HPLINES,"",0)
- Q
- ;
- CNVRTLEN(HPWIDTH,WIDTH) ;changes HPWIDTH=width in terms of handprint characters into width in terms of columns(machine print characters)
- ;pass WIDTH by reference
- ;
- N COLWIDTH
- D
- .I IBFORM("WIDTH")>96 S COLWIDTH=720/16.67 Q
- .I IBFORM("WIDTH")>80 S COLWIDTH=60 Q
- .S COLWIDTH=72
- S WIDTH=$FN(.49+((HPWIDTH*103.65924)/COLWIDTH),"",0)
- Q
- IBDF2D1 ;ALB/CJM - ENCOUNTER FORM - PRINT SELECTION LIST (cont'd) ;NOV 16,1992
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- GETCOL(COL) ;finds next column
- +1 ;COL - array where output data stored,SHOULD BE PASSED BY REFERENCE
- +2 ;COL=last column number processed
- +3 ;COL("Y")=columns starting row relative to block
- +4 ;COL("X")=column's starting column relative to block
- +5 ;COL("H")=column's height, i.e., maximum # of selections
- +6 ;
- +7 SET COL=$GET(COL)+1
- +8 SET NEEDUPR=0
- +9 IF COL=1
- SET COL("H")=+IBLIST("H",1)
- SET COL("X")=+IBLIST("X",1)
- SET COL("Y")=+IBLIST("Y",1)
- +10 IF COL>IBLIST("NUMCOL")
- SET COL=0
- QUIT
- +11 IF $GET(IBLIST("Y",COL))'=+$GET(IBLIST("Y",COL))
- Begin DoDot:1
- +12 IF COL=1
- SET COL("Y")=$SELECT(IBBLK("HDR")="":BOX,1:2+BOX)
- +13 ;leave value from prior col
- IF COL'=1
- QUIT
- End DoDot:1
- +14 IF '$TEST
- SET COL("Y")=$GET(IBLIST("Y",COL))
- +15 IF $GET(IBLIST("X",COL))'=+$GET(IBLIST("X",COL))
- Begin DoDot:1
- +16 IF COL=1
- QUIT
- +17 SET COL("X")=COL("X")+CWIDTH+$SELECT(IBLIST("SEP")=" ":2,IBLIST("SEP")=" ":4,1:0)
- End DoDot:1
- +18 IF '$TEST
- SET COL("X")=$GET(IBLIST("X",COL))
- +19 IF $GET(IBLIST("H",COL))'=+$GET(IBLIST("H",COL))
- Begin DoDot:1
- +20 IF COL=1
- SET COL("H")=IBBLK("H")
- +21 ;leave value from prior col
- IF COL'=1
- QUIT
- End DoDot:1
- +22 IF '$TEST
- SET COL("H")=$GET(IBLIST("H",COL))
- +23 IF BOX
- IF 'LINE
- IF COL("X")=0
- SET COL("X")=1
- +24 IF (COL("X")+CWIDTH+(('LINE)&BOX))>IBBLK("W")
- SET COL=0
- QUIT
- +25 IF (COL("Y")+COL("H"))>(IBBLK("H")-(2*BOX))
- SET COL("H")=(IBBLK("H")-(COL("Y")+BOX))
- +26 SET COL("ROWSLEFT")=COL("H")
- SET COL("NEXTROW")=0
- +27 QUIT
- +28 ;
- DRWCOL(COL) ;draws one column of the selection list except for its contents and rows
- +1 NEW I,OFFSET,WIDTH
- +2 IF LINE
- IF (COL("X")'=0)!('BOX)
- IF ALL
- DO DRWVLINE^IBDFU($$Y^IBDF2D,$$X^IBDF2D,COL("H"),"|")
- +3 IF LINE
- IF ('BOX)!(COL("X")+CWIDTH'=IBBLK("W"))
- IF ALL
- DO DRWVLINE^IBDFU($$Y^IBDF2D,$$X^IBDF2D+(CWIDTH-1),COL("H"),"|")
- +4 ;
- +5 ;draw the column header
- +6 IF IBLIST("HDR")'=""
- IF (COL("ROWSLEFT")>0)
- IF ALL
- Begin DoDot:1
- +7 SET IBLIST("DHDR")=$TRANSLATE(IBLIST("DHDR"),"RS","rs")
- +8 ;only affects forms with big print - bold otherwise not available
- +9 IF (IBLIST("DHDR")["s")!(IBLIST("DHDR")["r")
- IF IBLIST("DHDR")'["B"
- IF IBFORM("WIDTH")<100
- SET IBLIST("DHDR")=IBLIST("DHDR")_"B"
- +10 IF IBFORM("WIDTH")>100
- SET IBLIST("DHDR")=$TRANSLATE(IBLIST("DHDR"),"B")
- +11 ;
- +12 SET WIDTH=CWIDTH-(2*LINE)
- +13 SET OFFSET=LINE
- +14 IF IBLIST("DHDR")["C"
- IF $LENGTH(IBLIST("HDR"))<WIDTH
- SET OFFSET=OFFSET+((WIDTH-$LENGTH(IBLIST("HDR")))\2)
- +15 DO DRWSTR^IBDFU($$Y^IBDF2D,($$X^IBDF2D)+LINE,$JUSTIFY("",OFFSET)_IBLIST("HDR"),$TRANSLATE(IBLIST("DHDR"),"C",""),WIDTH)
- End DoDot:1
- DO DECREASE^IBDF2D(.COL)
- +16 ;
- +17 ;draw the header line for the subcolumns
- +18 IF COL("ROWSLEFT")>0
- IF IBLIST("CHDR")]""
- IF ALL
- Begin DoDot:1
- +19 SET IBLIST("DSCHDR")=$TRANSLATE(IBLIST("DSCHDR"),"R","r")
- +20 ;only affects forms with big print - bold otherwise not available
- +21 IF IBLIST("DSCHDR")["r"
- IF IBLIST("DSCHDR")'["B"
- IF IBFORM("WIDTH")<100
- SET IBLIST("DSCHDR")=IBLIST("DSCHDR")_"B"
- +22 IF IBFORM("WIDTH")>100
- SET IBLIST("DSCHDR")=$TRANSLATE(IBLIST("DSCHDR"),"B")
- +23 ;
- +24 ;apply options across entire line?
- +25 ;if nothing else applies uderline SCs (maybe)
- +26 IF IBLIST("ULSLCTNS")!LINE!(BOX&(CWIDTH>(IBBLK("W")-3-(2*(IBLIST("SEP1"))))))
- Begin DoDot:2
- +27 IF IBLIST("DSCHDR")=""
- IF IBLIST("ULSLCTNS")
- SET IBLIST("DSCHDR")=IBLIST("DSCHDR")_"U"
- +28 DO DRWSTR^IBDFU($$Y^IBDF2D,($$X^IBDF2D)+LINE,IBLIST("CHDR"),IBLIST("DSCHDR"),CWIDTH-(2*LINE))
- End DoDot:2
- QUIT
- +29 ;
- +30 ;apply display options just to the text, not accross the column
- +31 IF IBLIST("DSCHDR")=""
- SET IBLIST("DSCHDR")="U"
- +32 FOR I=1-IBLIST("SC0"):1:8
- IF IBLIST("SCTYPE",I)'=""
- IF IBLIST("SCHDR",I)'=""
- DO DRWSTR^IBDFU($$Y^IBDF2D,(($$X^IBDF2D)+IBLIST("SCOS",I)),IBLIST("SCHDR",I),IBLIST("DSCHDR"),$LENGTH(IBLIST("SCHDR",I)))
- End DoDot:1
- DO DECREASE^IBDF2D(.COL)
- +33 QUIT
- +34 ;
- CNVRTHT(HPLINES,LINES) ;changes HPLINES=number of handprint lines into LINES=print lines on the page
- +1 ;pass LINES by reference
- +2 SET LINES=$FNUMBER(1.5*HPLINES,"",0)
- +3 QUIT
- +4 ;
- CNVRTLEN(HPWIDTH,WIDTH) ;changes HPWIDTH=width in terms of handprint characters into width in terms of columns(machine print characters)
- +1 ;pass WIDTH by reference
- +2 ;
- +3 NEW COLWIDTH
- +4 Begin DoDot:1
- +5 IF IBFORM("WIDTH")>96
- SET COLWIDTH=720/16.67
- QUIT
- +6 IF IBFORM("WIDTH")>80
- SET COLWIDTH=60
- QUIT
- +7 SET COLWIDTH=72
- End DoDot:1
- +8 SET WIDTH=$FNUMBER(.49+((HPWIDTH*103.65924)/COLWIDTH),"",0)
- +9 QUIT
