74 lines
2.4 KiB
Mathematica
74 lines
2.4 KiB
Mathematica
ABSVLBL2 ;VAMC ALTOONA/CTB - GENERIC LABEL PRINTING ROUTINE ;1/11/01 10:16 AM
|
|
V ;;4.0;VOLUNTARY SERVICE;**23**;JULY 6, 1994
|
|
;GIVEN LIST OF RECORDS IN ^TMP($J,"VLABEL",N)=DA
|
|
;PRINT MULTI COLUMN LABEL
|
|
;NLABEL=NUMBER OF LABELS/ROW
|
|
;NLINES=NUMBER OF LINES/LABEL
|
|
;NPAGE=NUMBER OF LABELS/PAGE
|
|
;NSETS=NUMBER OF SETS/LABEL
|
|
;COLL=COLLATED/UNCOLLATED
|
|
;LOFFSET=LEFT OFFSET
|
|
;DIC=GLOBAL REFERENCE OF FILE
|
|
;DR=FIELD NUMBERS TO BE INCLUDED IN LABEL
|
|
;BLANKS=NUMBER OF BLANK LABELS
|
|
LABEL(DIC,DR,PARAMS) ;
|
|
Q:$G(DIC)="" Q:$G(DR)=""
|
|
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)
|
|
S NSETS=$P(PARAMS,"^",11),COLL=$P(PARAMS,"^",12)
|
|
I +$G(NLABEL)=0 S NLABEL=1
|
|
I +$G(NLINES)=0 S NLINES=6
|
|
I +$G(NPAGE)=0 S NPAGE=99999
|
|
D REBUILD
|
|
I TOFFSET1>0 F I=0:1:TOFFSET1 W !
|
|
I BLANKS D
|
|
. S BLNKROW=BLANKS\NLABEL I BLNKROW>0 F I=1:1:(BLNKROW*NLINES) W !
|
|
. S BLANKS=BLANKS#NLABEL
|
|
S NEXT=0 F D Q:NEXT="" W @IOF,! I TOFFSET2>0 F I=0:1:TOFFSET2 W !
|
|
. F NNPAGE=$S(BLANKS:BLNKROW+1,1:1):1:NPAGE D Q:NEXT=""
|
|
. . 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)
|
|
. . F I=1:1:NLINES D ONELINE
|
|
. . K LINE
|
|
. . QUIT
|
|
. QUIT
|
|
QUIT
|
|
ONELINE ;
|
|
F J=1:1:NLABEL W ?(((J-1)*(IOM\NLABEL+1))+LOFFSET),$E($G(LINE(J,I)),1,(IOM\NLABEL-1))
|
|
I NNPAGE=NPAGE,I=NLINES QUIT
|
|
W !
|
|
QUIT
|
|
ONELABEL(DA) ;
|
|
N X
|
|
F I=1:1:$L(DR,";") S X=$G(X)_"LAB("_I_");"
|
|
D EXT^ABSVU2(DIC,DA,DR,X)
|
|
D COMPRESS
|
|
K LAB
|
|
QUIT
|
|
COMPRESS NEW A,B
|
|
S B=1
|
|
I $G(LAB(1))="" S COL=COL-1 QUIT
|
|
F A=1:1:I I $G(LAB(A))]"" S LINE(COL,B)=$$REMPUNC^ABSVU2(LAB(A)),B=B+1
|
|
QUIT
|
|
BLANKS ;BUILD BLANK LABELS
|
|
F D Q:BLANKS=0
|
|
. F I=1:1:NLINES S $P(LINE(COL,I)," ",30)=""
|
|
. S COL=COL+1
|
|
. S BLANKS=BLANKS-1 Q:'BLANKS
|
|
. I COL>NLABEL D ONELINE K LINE S COL=1
|
|
QUIT
|
|
REBUILD ;REBUILD LIST FOR # OF PATIENTS
|
|
IF NSETS>1 D QUIT
|
|
. I COLL=1 D COLL QUIT
|
|
. D UNCOLL QUIT
|
|
. QUIT
|
|
S N=0 F S N=$O(^TMP($J,"VLABEL",N)) Q:'N S ^TMP($J,"XVLABEL",COUNT)=^(N),COUNT=COUNT+1
|
|
QUIT
|
|
COLL ;REBUILD LIST - COLLATED 1,2,3,4,5,1,2,3,4,5
|
|
S COUNT=1 D
|
|
. F I=1:1:NSETS D
|
|
. .S N="" F S N=$O(^TMP($J,"VLABEL",N)) Q:'N S ^TMP($J,"XVLABEL",COUNT)=^(N),COUNT=COUNT+1
|
|
. QUIT
|
|
QUIT
|
|
UNCOLL ;REBUILD LIST - UNCOLLATED 1,1,2,2,3,3,4,4,5,5
|
|
N X
|
|
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
|