1 | RTL2 ;MJK/TROY ISC;Routine to print labels; ; 1/30/87 10:08 AM ;
|
---|
2 | ;;v 2.0;Record Tracking;;10/22/91
|
---|
3 | CMP Q:'$D(^DIC(194.4,RTFMT,0)) S RTROW=$S($P(^(0),"^",2):$P(^(0),"^",2),1:6) K ^DIC(194.4,RTFMT,"E")
|
---|
4 | F RTI=0:0 S RTI=$O(^DIC(194.4,RTFMT,1,RTI)) Q:RTI'>0 I $D(^(RTI,0)) S ^TMP($J,"FORM",+$P(^(0),"^",2),+$P(^(0),"^",3),$P(^(0),"^",1))=$P(^(0),"^",4,5)
|
---|
5 | S RTN=1 F RTI=1:1:RTROW S RTFL=1 S:'$D(^TMP($J,"FORM",RTI)) ^DIC(194.4,RTFMT,"E",RTN,0)="W !",RTN=RTN+1 I $D(^(RTI)) F RTCOL=0:0 S RTCOL=$O(^TMP($J,"FORM",RTI,RTCOL)) Q:RTCOL'>0 S %="",%=$O(^(RTCOL,%)) S J=^(%) D STORE
|
---|
6 | W !!?5,"...format '",$P(^DIC(194.4,RTFMT,0),"^",1),"' has been compiled."
|
---|
7 | K RTROW,RTI,RTII,RTIV,RTDEF,J,RTITL,RTCOL,RTN,^TMP($J,"FORM") Q
|
---|
8 | ;
|
---|
9 | STORE S RTIV="DT",RTDEF="" S:$D(^DIC(194.5,+%,0)) RTIV=$P(^(0),"^",5),RTDEF=$P(^(0),"^",3)
|
---|
10 | S RTITLE=$S(RTIV="RTV(1)":"",$P(J,"^",1)="NONE":"",$P(J,"^",1)]"":$P(J,"^",1),1:RTDEF)
|
---|
11 | S ^DIC(194.4,RTFMT,"E",RTN,0)="W "_$S(RTFL:"!",1:"")_"?"_(RTCOL-1)_","""_RTITLE_""","_$S(RTIV="RTV(1)":""""_$P(J,"^",2)_"""",1:RTIV) S RTN=RTN+1,RTFL=0
|
---|
12 | Q
|
---|
13 | ;
|
---|
14 | TEST S RTEST="",RTNUM=1
|
---|
15 | W ! S DIC="^DIC(194.4,",DIC("S")="I $P(^(0),U,3)=+RTAPL",DIC("A")="Select Label Format: ",DIC(0)="IAEMQ" D ^DIC K DIC G Q:Y<0 S RTFMT=+Y
|
---|
16 | D ^%ZIS I 'POP U IO D PRT^RTL1 D ^%ZISC U IO(0)
|
---|
17 | Q K RTEST,RTNUM,RTFMT,DUOUT
|
---|
18 | K A,DIC,J,K,POP,RTBC,Y Q
|
---|
19 | BC ;DIC("S") for print fields multiple of 194.4 (LABEL FORMAT file)
|
---|
20 | ; Z1 = type of label from 194.4
|
---|
21 | ; Z2 = " " " from 194.5 (LABEL PRINT FIELD file)
|
---|
22 | ; Z3 = 1 or 0 depending is Z1 and Z2 are compatible
|
---|
23 | ; AND if the field is a barcode field, that it is
|
---|
24 | ; the ONLY barcode field for the label format
|
---|
25 | ;
|
---|
26 | S Z1=$P(^DIC(194.4,D0,0),U,4),Z2=$P(^DIC(194.5,+Y,0),U,2),Z3=$S(Z2="a"!(Z1=Z2):1,Z1="q"&(Z2="r"):1,1:0)
|
---|
27 | I Z3,$P(^DIC(194.5,+Y,0),U,6)="y" F RAI=0:0 S RAI=$O(^DIC(194.4,D0,1,RAI)) Q:'RAI I $D(^(RAI,0)),+Y'=+^(0),$D(^DIC(194.5,+^(0),0)),$P(^(0),U,6)="y" S Z3=0 Q
|
---|
28 | I Z3
|
---|
29 | K Z1,Z2,Z3,RAI Q
|
---|