RTL1 ;TROY ISC/MJK-Routine to Print Labels ; 5/1/87 11:55 AM ; 4/10/03 3:28pm
;;2.0;Record Tracking;**27,35**;10/22/91
RTQ Q:'$D(^RTV(190.1,RTQ,0)) S RTIFN=RTQ I $D(^RT(+^(0),0)) S X=+$P(^(0),"^",3),T=6,RTMES="W !?3,""...notice for request #"_RTIFN_" has been queued to print on device "",$E(RTION,1,15)",RTNUM=1
REC I '$D(RTIFN) Q:'$D(^RT(RT,0)) S RTIFN=RT,X=+$P(^(0),"^",3),T=5,RTMES="W !?3,""...label for record #"_RTIFN_" has been queued to print on device "",$E(RTION,1,15)",RTNUM=1
D FMT,Q:RTFMT K RTMES,RTNUM,RTIFN,RTFMT,T Q
;
FMT S RTFMT=$S('$D(^DIC(195.2,X,0)):"",$D(^DIC(194.4,+$P(^(0),"^",T),0)):$P(^DIC(195.2,X,0),"^",T),1:"") Q
;
PRT K RTBAR,RTQ,RTBC Q:'$D(^DIC(194.4,RTFMT,0)) S T=$P(^(0),"^",4)
I $D(RTEST) F RTI=0:0 S RTI=$O(^DIC(194.4,RTFMT,1,RTI)) Q:RTI'>0 I $D(^(RTI,0)),$D(^DIC(194.5,+^(0),0)) S @$P(^(0),"^",5)=$P(^(0),"^",4) S:$P(^(0),"^",6)="y" RTBC=$P(^(0),"^",5)
I '$D(RTEST) D TYPE G EXIT:RT0="" F RTI=0:0 S RTI=$O(^DIC(194.4,RTFMT,1,RTI)) Q:RTI'>0 I $D(^(RTI,0)) S RTJ=+^(0) I $D(^DIC(194.5,RTJ,0)) S:$P(^(0),"^",6)="y" RTBC=$P(^(0),"^",5) I $D(^("E")) X ^("E")
F RTII=1:1:RTNUM W @IOF F RTI=0:0 S RTI=$O(^DIC(194.4,RTFMT,"E",RTI)) Q:RTI'>0 X ^DIC(194.4,RTFMT,"E",RTI,0)
;reverse video
;
;"bar1,bar0,barx"; flush for intermec RD
I $D(RTBC) S RTON=$S($D(^%ZIS(2,IOST(0),"BAR1")):^("BAR1"),1:""),RTON=$S(RTON]"":RTON,1:"*0"),RTOFF=$S($D(^("BAR0")):^("BAR0"),1:""),RTOFF=$S(RTOFF]"":RTOFF,1:"*0"),X=@RTBC W @RTON,X,@RTOFF K RTON,RTOFF
EXIT F RTI=0:0 S RTI=$O(^DIC(194.4,RTFMT,1,RTI)) Q:RTI'>0 I $D(^(RTI,0)),$D(^DIC(194.5,+^(0),0)) K @$P(^(0),"^",5)
I $D(RTBAR) S T=5,RTIFN=+RTQ,X=+$P(RT0,"^",3) D FMT G PRT:RTFMT
RD I $D(ION),ION["INTERMEC" F ZQ=0:0 R ZQ:0 Q:'$T
K ZQ,RTCL,RT0,RTQ,T,RTI,RTII,RTIFN,RTNUM,RTFMT D:'$D(RTTASK) CLOSE^RTUTL Q
;
TYPE I T="r",$D(^RT(RTIFN,0)) D NOW^%DTC S $P(^(0),"^",8)=%,RT0=^(0),RTCL=$S($D(^RT(RTIFN,"CL")):^("CL"),1:"") Q
I T="q",$D(^RTV(190.1,RTIFN,0)),$P(^(0),"^",6)'="x" D NOW^%DTC S $P(^(0),"^",13)=%,RTQ=^(0),RT0=$S($D(^RT(+RTQ,0)):^(0),1:0),RTCL=$S($D(^RT(+RTQ,"CL")):^("CL"),1:"") S:$S($P(RT0,"^",8):0,1:$D(^RTV(195.9,"AC",ION))>0) RTBAR="" Q
I T="b",$D(^RTV(195.9,RTIFN,0)) S RT0=^(0) Q
S RT0="" Q
;
;
Q I $S('$D(RTION):1,RTION']"":1,'$D(^%ZIS(1,"B",RTION)):1,'$D(^%ZIS(1,+$O(^(RTION,0)),0)):1,1:0) Q:$D(RTBKGRD) D ZIS Q:POP S RTION=ION,RTA=$O(^%ZIS(1,"B",ION,0)) N RTERR D CHKDEV G Q:RTERR I (^%ZIS(1,RTA,"TYPE")="VTRM") D ER G Q
S RTVAR="RTIFN^RTNUM^RTFMT",RTVAL=RTIFN_"^"_RTNUM_"^"_RTFMT,RTW=$H
X ^%ZOSF("UCI") S ZTRTN="DQ^RTL1",ZTUCI=Y,ZTDTH=$H,ZTSAVE("RTVAR")="",ZTSAVE("RTVAL")="" S:$D(DUZ(0)) ZTSAVE("DUZ(0)")=""
;
S ZTDESC="Record Tracking Label Print"
I '$D(RTTASK) S RTHG=$E(RTION,$L(RTION)-5,99),RTION=$S(RTHG'["RTHG":RTION,1:$E(RTION,1,$L(RTION)-1)_(1+($S($D(RTE):$S(RTE[";DPT(":+$P(^DPT(+RTE,0),"^",9)#2,1:+RTE#2),1:0)))) K RTHG
S ZTIO=RTION
D ^%ZTLOAD
D HOME^%ZIS ;returns io to home device
X:$D(RTMES)&('$D(RTBKGRD))&('$D(RTIRE)) RTMES H:$D(RTMES) 1 K RTW,RTVAR,RTVAL,ZTSK Q
;
DQ S IO(0)=IO
F I=1:1 Q:$P(RTVAR,"^",I)']"" S @($P(RTVAR,"^",I))=$P(RTVAL,"^",I)
S U="^" S X="T",%DT="" D ^%DT S DT=Y G PRT
Q
;
ER W !!,*7,"You can not queue to a virtual terminal, try again."
S RTION=""
Q
;
ZIS S %ZIS("A")="Select Label Device: ",%ZIS="NQ" D ^%ZIS K %ZIS,IO("Q")
Q
CHKDEV ; check that device can be queued to
N RTDEV,RTSUB
S RTERR=0
S RTDEV=$G(^%ZIS(1,RTA,0))
I $P(RTDEV,U,12)=2 S RTERR=1
I $P(RTDEV,U)["SLAVE" S RTERR=1
S RTSUB=+$G(^%ZIS(1,RTA,"SUBTYPE"))
I RTSUB S RTSUB=$G(^%ZIS(2,RTSUB,0),U)
I RTSUB["SLAVE" S RTERR=1
I RTERR S RTION="" W !!,*7,"You cannot queue to this device, try again."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTL1 3689 printed Dec 13, 2024@02:33:57 Page 2
RTL1 ;TROY ISC/MJK-Routine to Print Labels ; 5/1/87 11:55 AM ; 4/10/03 3:28pm
+1 ;;2.0;Record Tracking;**27,35**;10/22/91
RTQ if '$DATA(^RTV(190.1,RTQ,0))
QUIT
SET RTIFN=RTQ
IF $DATA(^RT(+^(0),0))
SET X=+$PIECE(^(0),"^",3)
SET T=6
SET RTMES="W !?3,""...notice for request #"_RTIFN_" has been queued to print on device "",$E(RTION,1,15)"
SET RTNUM=1
REC IF '$DATA(RTIFN)
if '$DATA(^RT(RT,0))
QUIT
SET RTIFN=RT
SET X=+$PIECE(^(0),"^",3)
SET T=5
SET RTMES="W !?3,""...label for record #"_RTIFN_" has been queued to print on device "",$E(RTION,1,15)"
SET RTNUM=1
+1 DO FMT
if RTFMT
DO Q
KILL RTMES,RTNUM,RTIFN,RTFMT,T
QUIT
+2 ;
FMT SET RTFMT=$SELECT('$DATA(^DIC(195.2,X,0)):"",$DATA(^DIC(194.4,+$PIECE(^(0),"^",T),0)):$PIECE(^DIC(195.2,X,0),"^",T),1:"")
QUIT
+1 ;
PRT KILL RTBAR,RTQ,RTBC
if '$DATA(^DIC(194.4,RTFMT,0))
QUIT
SET T=$PIECE(^(0),"^",4)
+1 IF $DATA(RTEST)
FOR RTI=0:0
SET RTI=$ORDER(^DIC(194.4,RTFMT,1,RTI))
if RTI'>0
QUIT
IF $DATA(^(RTI,0))
IF $DATA(^DIC(194.5,+^(0),0))
SET @$PIECE(^(0),"^",5)=$PIECE(^(0),"^",4)
if $PIECE(^(0),"^",6)="y"
SET RTBC=$PIECE(^(0),"^",5)
+2 IF '$DATA(RTEST)
DO TYPE
if RT0=""
GOTO EXIT
FOR RTI=0:0
SET RTI=$ORDER(^DIC(194.4,RTFMT,1,RTI))
if RTI'>0
QUIT
IF $DATA(^(RTI,0))
SET RTJ=+^(0)
IF $DATA(^DIC(194.5,RTJ,0))
if $PIECE(^(0),"^",6)="y"
SET RTBC=$PIECE(^(0),"^",5)
IF $DATA(^("E"))
XECUTE ^("E")
+3 FOR RTII=1:1:RTNUM
WRITE @IOF
FOR RTI=0:0
SET RTI=$ORDER(^DIC(194.4,RTFMT,"E",RTI))
if RTI'>0
QUIT
XECUTE ^DIC(194.4,RTFMT,"E",RTI,0)
+4 ;reverse video
+5 ;
+6 ;"bar1,bar0,barx"; flush for intermec RD
+7 IF $DATA(RTBC)
SET RTON=$SELECT($DATA(^%ZIS(2,IOST(0),"BAR1")):^("BAR1"),1:"")
SET RTON=$SELECT(RTON]"":RTON,1:"*0")
SET RTOFF=$SELECT($DATA(^("BAR0")):^("BAR0"),1:"")
SET RTOFF=$SELECT(RTOFF]"":RTOFF,1:"*0")
SET X=@RTBC
WRITE @RTON,X,@RTOFF
KILL RTON,RTOFF
EXIT FOR RTI=0:0
SET RTI=$ORDER(^DIC(194.4,RTFMT,1,RTI))
if RTI'>0
QUIT
IF $DATA(^(RTI,0))
IF $DATA(^DIC(194.5,+^(0),0))
KILL @$PIECE(^(0),"^",5)
+1 IF $DATA(RTBAR)
SET T=5
SET RTIFN=+RTQ
SET X=+$PIECE(RT0,"^",3)
DO FMT
if RTFMT
GOTO PRT
RD IF $DATA(ION)
IF ION["INTERMEC"
FOR ZQ=0:0
READ ZQ:0
if '$TEST
QUIT
+1 KILL ZQ,RTCL,RT0,RTQ,T,RTI,RTII,RTIFN,RTNUM,RTFMT
if '$DATA(RTTASK)
DO CLOSE^RTUTL
QUIT
+2 ;
TYPE IF T="r"
IF $DATA(^RT(RTIFN,0))
DO NOW^%DTC
SET $PIECE(^(0),"^",8)=%
SET RT0=^(0)
SET RTCL=$SELECT($DATA(^RT(RTIFN,"CL")):^("CL"),1:"")
QUIT
+1 IF T="q"
IF $DATA(^RTV(190.1,RTIFN,0))
IF $PIECE(^(0),"^",6)'="x"
DO NOW^%DTC
SET $PIECE(^(0),"^",13)=%
SET RTQ=^(0)
SET RT0=$SELECT($DATA(^RT(+RTQ,0)):^(0),1:0)
SET RTCL=$SELECT($DATA(^RT(+RTQ,"CL")):^("CL"),1:"")
if $SELECT($PIECE(RT0,"^",8)
SET RTBAR=""
QUIT
+2 IF T="b"
IF $DATA(^RTV(195.9,RTIFN,0))
SET RT0=^(0)
QUIT
+3 SET RT0=""
QUIT
+4 ;
+5 ;
Q IF $SELECT('$DATA(RTION):1,RTION']"":1,'$DATA(^%ZIS(1,"B",RTION)):1,'$DATA(^%ZIS(1,+$ORDER(^(RTION,0)),0)):1,1:0)
if $DATA(RTBKGRD)
QUIT
DO ZIS
if POP
QUIT
SET RTION=ION
SET RTA=$ORDER(^%ZIS(1,"B",ION,0))
NEW RTERR
DO CHKDEV
if RTERR
GOTO Q
IF (^%ZIS(1,RTA,"TYPE")="VTRM")
DO ER
GOTO Q
+1 SET RTVAR="RTIFN^RTNUM^RTFMT"
SET RTVAL=RTIFN_"^"_RTNUM_"^"_RTFMT
SET RTW=$HOROLOG
+2 XECUTE ^%ZOSF("UCI")
SET ZTRTN="DQ^RTL1"
SET ZTUCI=Y
SET ZTDTH=$HOROLOG
SET ZTSAVE("RTVAR")=""
SET ZTSAVE("RTVAL")=""
if $DATA(DUZ(0))
SET ZTSAVE("DUZ(0)")=""
+3 ;
+4 SET ZTDESC="Record Tracking Label Print"
+5 IF '$DATA(RTTASK)
SET RTHG=$EXTRACT(RTION,$LENGTH(RTION)-5,99)
SET RTION=$SELECT(RTHG'["RTHG":RTION,1:$EXTRACT(RTION,1,$LENGTH(RTION)-1)_(1+($SELECT($DATA(RTE):$SELECT(RTE[";DPT(":+$PIECE(^DPT(+RTE,0),"^",9)#2,1:+RTE#2),1:0))))
KILL RTHG
+6 SET ZTIO=RTION
+7 DO ^%ZTLOAD
+8 ;returns io to home device
DO HOME^%ZIS
+9 if $DATA(RTMES)&('$DATA(RTBKGRD))&('$DATA(RTIRE))
XECUTE RTMES
if $DATA(RTMES)
HANG 1
KILL RTW,RTVAR,RTVAL,ZTSK
QUIT
+10 ;
DQ SET IO(0)=IO
+1 FOR I=1:1
if $PIECE(RTVAR,"^",I)']""
QUIT
SET @($PIECE(RTVAR,"^",I))=$PIECE(RTVAL,"^",I)
+2 SET U="^"
SET X="T"
SET %DT=""
DO ^%DT
SET DT=Y
GOTO PRT
+3 QUIT
+4 ;
ER WRITE !!,*7,"You can not queue to a virtual terminal, try again."
+1 SET RTION=""
+2 QUIT
+3 ;
ZIS SET %ZIS("A")="Select Label Device: "
SET %ZIS="NQ"
DO ^%ZIS
KILL %ZIS,IO("Q")
+1 QUIT
CHKDEV ; check that device can be queued to
+1 NEW RTDEV,RTSUB
+2 SET RTERR=0
+3 SET RTDEV=$GET(^%ZIS(1,RTA,0))
+4 IF $PIECE(RTDEV,U,12)=2
SET RTERR=1
+5 IF $PIECE(RTDEV,U)["SLAVE"
SET RTERR=1
+6 SET RTSUB=+$GET(^%ZIS(1,RTA,"SUBTYPE"))
+7 IF RTSUB
SET RTSUB=$GET(^%ZIS(2,RTSUB,0),U)
+8 IF RTSUB["SLAVE"
SET RTERR=1
+9 IF RTERR
SET RTION=""
WRITE !!,*7,"You cannot queue to this device, try again."
+10 QUIT
