[613] | 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
|
---|