1 | ABSVLBL2 ;VAMC ALTOONA/CTB - GENERIC LABEL PRINTING ROUTINE ;1/11/01 10:16 AM
|
---|
2 | V ;;4.0;VOLUNTARY SERVICE;**23**;JULY 6, 1994
|
---|
3 | ;GIVEN LIST OF RECORDS IN ^TMP($J,"VLABEL",N)=DA
|
---|
4 | ;PRINT MULTI COLUMN LABEL
|
---|
5 | ;NLABEL=NUMBER OF LABELS/ROW
|
---|
6 | ;NLINES=NUMBER OF LINES/LABEL
|
---|
7 | ;NPAGE=NUMBER OF LABELS/PAGE
|
---|
8 | ;NSETS=NUMBER OF SETS/LABEL
|
---|
9 | ;COLL=COLLATED/UNCOLLATED
|
---|
10 | ;LOFFSET=LEFT OFFSET
|
---|
11 | ;DIC=GLOBAL REFERENCE OF FILE
|
---|
12 | ;DR=FIELD NUMBERS TO BE INCLUDED IN LABEL
|
---|
13 | ;BLANKS=NUMBER OF BLANK LABELS
|
---|
14 | LABEL(DIC,DR,PARAMS) ;
|
---|
15 | Q:$G(DIC)="" Q:$G(DR)=""
|
---|
16 | S NLABEL=$P(PARAMS,"^",2),NLINES=$P(PARAMS,"^",4),NPAGE=$P(PARAMS,"^",3),NCOL=$P(PARAMS,"^",5),LOFFSET=$P(PARAMS,"^",6),TOFFSET1=+$P(PARAMS,"^",7),TOFFSET2=+$P(PARAMS,"^",8),BLANKS=+$P(PARAMS,"^",10)
|
---|
17 | S NSETS=$P(PARAMS,"^",11),COLL=$P(PARAMS,"^",12)
|
---|
18 | I +$G(NLABEL)=0 S NLABEL=1
|
---|
19 | I +$G(NLINES)=0 S NLINES=6
|
---|
20 | I +$G(NPAGE)=0 S NPAGE=99999
|
---|
21 | D REBUILD
|
---|
22 | I TOFFSET1>0 F I=0:1:TOFFSET1 W !
|
---|
23 | I BLANKS D
|
---|
24 | . S BLNKROW=BLANKS\NLABEL I BLNKROW>0 F I=1:1:(BLNKROW*NLINES) W !
|
---|
25 | . S BLANKS=BLANKS#NLABEL
|
---|
26 | S NEXT=0 F D Q:NEXT="" W @IOF,! I TOFFSET2>0 F I=0:1:TOFFSET2 W !
|
---|
27 | . F NNPAGE=$S(BLANKS:BLNKROW+1,1:1):1:NPAGE D Q:NEXT=""
|
---|
28 | . . K LINE F COL=1:1:NLABEL D:BLANKS BLANKS S NEXT=$O(^TMP($J,"XVLABEL",NEXT)) Q:NEXT="" S DA=^(NEXT) D:DA'="" ONELABEL(DA)
|
---|
29 | . . F I=1:1:NLINES D ONELINE
|
---|
30 | . . K LINE
|
---|
31 | . . QUIT
|
---|
32 | . QUIT
|
---|
33 | QUIT
|
---|
34 | ONELINE ;
|
---|
35 | F J=1:1:NLABEL W ?(((J-1)*(IOM\NLABEL+1))+LOFFSET),$E($G(LINE(J,I)),1,(IOM\NLABEL-1))
|
---|
36 | I NNPAGE=NPAGE,I=NLINES QUIT
|
---|
37 | W !
|
---|
38 | QUIT
|
---|
39 | ONELABEL(DA) ;
|
---|
40 | N X
|
---|
41 | F I=1:1:$L(DR,";") S X=$G(X)_"LAB("_I_");"
|
---|
42 | D EXT^ABSVU2(DIC,DA,DR,X)
|
---|
43 | D COMPRESS
|
---|
44 | K LAB
|
---|
45 | QUIT
|
---|
46 | COMPRESS NEW A,B
|
---|
47 | S B=1
|
---|
48 | I $G(LAB(1))="" S COL=COL-1 QUIT
|
---|
49 | F A=1:1:I I $G(LAB(A))]"" S LINE(COL,B)=$$REMPUNC^ABSVU2(LAB(A)),B=B+1
|
---|
50 | QUIT
|
---|
51 | BLANKS ;BUILD BLANK LABELS
|
---|
52 | F D Q:BLANKS=0
|
---|
53 | . F I=1:1:NLINES S $P(LINE(COL,I)," ",30)=""
|
---|
54 | . S COL=COL+1
|
---|
55 | . S BLANKS=BLANKS-1 Q:'BLANKS
|
---|
56 | . I COL>NLABEL D ONELINE K LINE S COL=1
|
---|
57 | QUIT
|
---|
58 | REBUILD ;REBUILD LIST FOR # OF PATIENTS
|
---|
59 | IF NSETS>1 D QUIT
|
---|
60 | . I COLL=1 D COLL QUIT
|
---|
61 | . D UNCOLL QUIT
|
---|
62 | . QUIT
|
---|
63 | S N=0 F S N=$O(^TMP($J,"VLABEL",N)) Q:'N S ^TMP($J,"XVLABEL",COUNT)=^(N),COUNT=COUNT+1
|
---|
64 | QUIT
|
---|
65 | COLL ;REBUILD LIST - COLLATED 1,2,3,4,5,1,2,3,4,5
|
---|
66 | S COUNT=1 D
|
---|
67 | . F I=1:1:NSETS D
|
---|
68 | . .S N="" F S N=$O(^TMP($J,"VLABEL",N)) Q:'N S ^TMP($J,"XVLABEL",COUNT)=^(N),COUNT=COUNT+1
|
---|
69 | . QUIT
|
---|
70 | QUIT
|
---|
71 | UNCOLL ;REBUILD LIST - UNCOLLATED 1,1,2,2,3,3,4,4,5,5
|
---|
72 | N X
|
---|
73 | S COUNT=1,N=0 F S N=$O(^TMP($J,"VLABEL",N)) Q:'N S X=^(N) F I=1:1:NSETS S ^TMP($J,"XVLABEL",COUNT)=X,COUNT=COUNT+1
|
---|