| 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 | 
|---|