source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTL2.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1RTL2 ;MJK/TROY ISC;Routine to print labels; ; 1/30/87 10:08 AM ;
2 ;;v 2.0;Record Tracking;;10/22/91
3CMP 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 ;
9STORE 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 ;
14TEST 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)
17Q K RTEST,RTNUM,RTFMT,DUOUT
18 K A,DIC,J,K,POP,RTBC,Y Q
19BC ;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
Note: See TracBrowser for help on using the repository browser.