RABAR ;HISC/GJC-Procedure & CPT Code barcode output (part 1 of 2) ;7/31/96 08:57
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
EN1 ; Entry point for RA BARPROCPRINT (Barcoded Procedure List)
; variable list:
; 'RADIC' : namespaced DIC input variables passed to EN1^RASELCT
; 'RAPRNT': data elements to print i.e, CPT Code, Procedure or both
; 'RASORT': data elements to sort by i.e, CPT Code or Procedure
; '^TMP($J,"RA I-TYPE")': Imaging Type(s) selected by the user
; '^TMP($J,"RA PROC")' : Procedure(s) selected by the user
;
K ^TMP($J,"RA BARDEV"),^TMP($J,"RA I-TYPE"),^TMP($J,"RA PROC")
N RADIC,RADT,RADX,RADY,RAPRNT,RASORT,RAVHI,RAXIT
S RADT=$$FMTE^XLFDT(DT,"1D"),RAXIT=0
S RATEST=$$TEST^RABAR1() I RATEST<0 D KILL Q
I RATEST D DEV ; obtain proc test print
K RATEST
S RAVHI=$$HI() ; vertical height (in lines) of the barcode
I RAVHI<0 D KILL Q
D KILLDIR S DIR(0)="SO^C:CPT barcode;P:Procedure barcode;B:Both barcodes"
S DIR("A")="Which of the above would you like to print?"
S DIR("?",1)="Enter 'B' to print both the Procedure and CPT Code in a"
S DIR("?",2)="barcode format. 'C' to print only the CPT Code barcode,"
S DIR("?")="or 'P' to print only the procedure in a barcode format."
D ^DIR S:$D(DIRUT) RAXIT=1
D KILLDIR G:RAXIT KILL S RAPRNT=Y(0)
I $E(RAPRNT,1)="B" D BOTH G:RAXIT KILL ; sort by CPT or Procedure?
S RAXIT=$$ITYPE() G:RAXIT KILL
S RAXIT=$$PROC^RABAR1() G:RAXIT KILL
I '$D(^TMP($J,"RA PROC")) D KILL Q
DEV ; Device selection
W ! S %ZIS="QM",%ZIS("A")="Select a printer with barcode setup: "
S %ZIS("B")=$S($D(^TMP($J,"RA BARDEV"))\10:$O(^("RA BARDEV","")),1:"")
S %ZIS("S")="I $$DSCR^RABAR(+Y)" D ^%ZIS
I POP D KILL Q
I $D(RATEST) S ^TMP($J,"RA BARDEV",ION)=""
I $D(IO("Q")) D G KILL
. S ZTRTN="START^RABAR"
. S ZTDESC="Rad Nuc/Med Print procedure/CPT code in a barcode format."
. D ZTSAVE^RABAR1,^%ZTLOAD
. I +$G(ZTSK("D"))>0 W !?5,"Request Queued, Task #: ",$G(ZTSK)
. D HOME^%ZIS
. K %X,%XX,%Y,%YY,IO("Q"),X,Y
. Q
START ; Start processing data & printing to the device here
S:$D(ZTQUEUED) ZTREQ="@" U IO
I '$D(RATEST) D
. S RAHD1="Barcode print of Imaging "
. S:$E(RAPRNT,1)="B" RAHD1=RAHD1_"Procedures & CPT Codes"
. S:$E(RAPRNT,1)="C" RAHD1=RAHD1_"CPT Codes"
. S:$E(RAPRNT,1)="P" RAHD1=RAHD1_"Procedures"
. Q
S:$D(RATEST) RAHD1="Barcode test print"
S RAHD2="Printed on: "_RADT,RAPG=0
S $P(RALINE,"-",(IOM+1))="",RA1=""
I $D(RATEST) D
. D HDR Q:RAXIT D PRINT1^RABAR1
. Q
E D
. N RAEOS S RAEOS=$S($D(RAVHI):RAVHI,1:6) D HDR Q:RAXIT
. F S RA1=$O(^TMP($J,"RA PROC",RA1)) Q:RA1="" D Q:RAXIT
.. S RA2=0 F S RA2=$O(^TMP($J,"RA PROC",RA1,RA2)) Q:RA2'>0 D Q:RAXIT
... D PRINT^RABAR1
... Q
.. Q
. Q
W ! D ^%ZISC
D KILL
Q
BOTH ; Ask the user which to sort by i.e, CPT Code -or- Procedure
W ! D KILLDIR S DIR(0)="SOA^C:CPT Code;P:Procedure"
S DIR("A")="Select the data element you wish to sort by: "
S DIR("?",1)="Enter 'C' to sort by the CPT Code, or 'P' to sort by the"
S DIR("?")="procedure."
D ^DIR S:$D(DIRUT) RAXIT=1
D KILLDIR Q:RAXIT S RASORT=Y(0)
Q
DOLLARY ; Caculate the new value of $Y for formatting purposes.
S RADX=$X,RADY=($Y+RAVHI) D ZOSF^RABAR1(RADX,RADY)
Q
DSCR(Y) ; Device screen logic, select only barcode capable devices.
N RABAR0,RABAR1,RATERMTY S RATERMTY=+$G(^%ZIS(1,+Y,"SUBTYPE"))
Q:'RATERMTY 0 ; missing pointer to Terminal Type file!
S RABAR0=$G(^%ZIS(2,RATERMTY,"BAR0")) ; barcode off node
S RABAR1=$G(^%ZIS(2,RATERMTY,"BAR1")) ; barcode on node
Q:(RABAR0]"")&(RABAR1]"") 1 ; barcoding capability
Q 0
HDR ; Header
W:$Y @IOF S RAPG=RAPG+1
W !?(IOM-$L(RAHD1)\2),RAHD1
W !?(IOM-$L(RAHD2)\2),RAHD2
W ?$S(IOM=132:116,1:64),"Page: ",RAPG
W !,RALINE
; Check if user stops the task.
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
Q
HELP ; Help message for barcode height prompt
W !,"If you don't know how to answer this prompt, first determine which printer",!,"you are going to use. Then exit this option and re-select it from your menu."
W !,"When you are asked if you want to print a sample barcode, enter 'Yes'."
W !,"Enter your printer selection at the 'DEVICE' prompt, then retrieve your",!,"sample printout. If no barcode has printed, contact your IRM and ask them"
W !,"to set up the printer for barcode printing. If a barcode has printed, use",!,"the line counts printed above and below the barcode to determine how many"
W !,"vertical lines the barcode occupies (include the procedure name line printed",!,"below the barcode)."
Q
HI() ; user input of height (in lines) of the barcode
; returns the height (in lines) of the barcode, OR -1 if user chooses
; to exit without inputting a number.
N RALOW,RAHI S RALOW=1,RAHI=10
W ! D KILLDIR S DIR(0)="NA^"_RALOW_":"_RAHI
S DIR("A")="Enter the height of the barcode: "
S DIR("?",1)="Enter the height of the barcode in terms of vertical text lines ("_RALOW_" to "_RAHI_")"
S DIR("?")="for your printer, or '^' to exit."
S DIR("??")="^D HELP^RABAR"
D ^DIR S Y=$S($D(DIRUT):-1,1:+Y) D KILLDIR
Q Y
INA(Y) ; Determines if the procedure is inactive
; Input : IEN of file 71
; Output: 1 if active, 0 if inactive
Q:+$G(^RAMIS(71,+Y,"I"))=0 1
Q $S(+$G(^RAMIS(71,+Y,"I"))>DT:1,1:0)
;
ITYPE() ; Select the Imaging Type(s)
N RADIC,RAINPUT,RAQUIT,RAUTIL
S RADIC="^RA(79.2,",RADIC(0)="QEAMZ",RADIC("A")="Select Imaging Type: "
S RAUTIL="RA I-TYPE",RAINPUT=1 D EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
Q RAQUIT
KILL ; Kill all other variables [ includes ^TMP($J) ]
K:'$D(RATEST) ^TMP($J,"RA BARDEV")
K ^TMP($J,"RA I-TYPE"),^TMP($J,"RA PROC")
K %X,%XX,%Y,%YY,RA1,RA2,RAHD1,RAHD2,RALINE,RAPG,RAPG1,RATEST,X,Y
K ZTDESC,ZTRTN,ZTSAVE
K DDH,I,POP
Q
KILLDIR ; Kill off variables from DIR call
K DIR,DIROUT,DIRUT,DTOUT,DUOUT
Q
LINE ; Print ten lines of text
N I F I=1:1:10 W !,"LINE ",I
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRABAR 5939 printed Sep 23, 2025@20:09:45 Page 2
RABAR ;HISC/GJC-Procedure & CPT Code barcode output (part 1 of 2) ;7/31/96 08:57
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
EN1 ; Entry point for RA BARPROCPRINT (Barcoded Procedure List)
+1 ; variable list:
+2 ; 'RADIC' : namespaced DIC input variables passed to EN1^RASELCT
+3 ; 'RAPRNT': data elements to print i.e, CPT Code, Procedure or both
+4 ; 'RASORT': data elements to sort by i.e, CPT Code or Procedure
+5 ; '^TMP($J,"RA I-TYPE")': Imaging Type(s) selected by the user
+6 ; '^TMP($J,"RA PROC")' : Procedure(s) selected by the user
+7 ;
+8 KILL ^TMP($JOB,"RA BARDEV"),^TMP($JOB,"RA I-TYPE"),^TMP($JOB,"RA PROC")
+9 NEW RADIC,RADT,RADX,RADY,RAPRNT,RASORT,RAVHI,RAXIT
+10 SET RADT=$$FMTE^XLFDT(DT,"1D")
SET RAXIT=0
+11 SET RATEST=$$TEST^RABAR1()
IF RATEST<0
DO KILL
QUIT
+12 ; obtain proc test print
IF RATEST
DO DEV
+13 KILL RATEST
+14 ; vertical height (in lines) of the barcode
SET RAVHI=$$HI()
+15 IF RAVHI<0
DO KILL
QUIT
+16 DO KILLDIR
SET DIR(0)="SO^C:CPT barcode;P:Procedure barcode;B:Both barcodes"
+17 SET DIR("A")="Which of the above would you like to print?"
+18 SET DIR("?",1)="Enter 'B' to print both the Procedure and CPT Code in a"
+19 SET DIR("?",2)="barcode format. 'C' to print only the CPT Code barcode,"
+20 SET DIR("?")="or 'P' to print only the procedure in a barcode format."
+21 DO ^DIR
if $DATA(DIRUT)
SET RAXIT=1
+22 DO KILLDIR
if RAXIT
GOTO KILL
SET RAPRNT=Y(0)
+23 ; sort by CPT or Procedure?
IF $EXTRACT(RAPRNT,1)="B"
DO BOTH
if RAXIT
GOTO KILL
+24 SET RAXIT=$$ITYPE()
if RAXIT
GOTO KILL
+25 SET RAXIT=$$PROC^RABAR1()
if RAXIT
GOTO KILL
+26 IF '$DATA(^TMP($JOB,"RA PROC"))
DO KILL
QUIT
DEV ; Device selection
+1 WRITE !
SET %ZIS="QM"
SET %ZIS("A")="Select a printer with barcode setup: "
+2 SET %ZIS("B")=$SELECT($DATA(^TMP($JOB,"RA BARDEV"))\10:$ORDER(^("RA BARDEV","")),1:"")
+3 SET %ZIS("S")="I $$DSCR^RABAR(+Y)"
DO ^%ZIS
+4 IF POP
DO KILL
QUIT
+5 IF $DATA(RATEST)
SET ^TMP($JOB,"RA BARDEV",ION)=""
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTRTN="START^RABAR"
+8 SET ZTDESC="Rad Nuc/Med Print procedure/CPT code in a barcode format."
+9 DO ZTSAVE^RABAR1
DO ^%ZTLOAD
+10 IF +$GET(ZTSK("D"))>0
WRITE !?5,"Request Queued, Task #: ",$GET(ZTSK)
+11 DO HOME^%ZIS
+12 KILL %X,%XX,%Y,%YY,IO("Q"),X,Y
+13 QUIT
End DoDot:1
GOTO KILL
START ; Start processing data & printing to the device here
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
+2 IF '$DATA(RATEST)
Begin DoDot:1
+3 SET RAHD1="Barcode print of Imaging "
+4 if $EXTRACT(RAPRNT,1)="B"
SET RAHD1=RAHD1_"Procedures & CPT Codes"
+5 if $EXTRACT(RAPRNT,1)="C"
SET RAHD1=RAHD1_"CPT Codes"
+6 if $EXTRACT(RAPRNT,1)="P"
SET RAHD1=RAHD1_"Procedures"
+7 QUIT
End DoDot:1
+8 if $DATA(RATEST)
SET RAHD1="Barcode test print"
+9 SET RAHD2="Printed on: "_RADT
SET RAPG=0
+10 SET $PIECE(RALINE,"-",(IOM+1))=""
SET RA1=""
+11 IF $DATA(RATEST)
Begin DoDot:1
+12 DO HDR
if RAXIT
QUIT
DO PRINT1^RABAR1
+13 QUIT
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 NEW RAEOS
SET RAEOS=$SELECT($DATA(RAVHI):RAVHI,1:6)
DO HDR
if RAXIT
QUIT
+16 FOR
SET RA1=$ORDER(^TMP($JOB,"RA PROC",RA1))
if RA1=""
QUIT
Begin DoDot:2
+17 SET RA2=0
FOR
SET RA2=$ORDER(^TMP($JOB,"RA PROC",RA1,RA2))
if RA2'>0
QUIT
Begin DoDot:3
+18 DO PRINT^RABAR1
+19 QUIT
End DoDot:3
if RAXIT
QUIT
+20 QUIT
End DoDot:2
if RAXIT
QUIT
+21 QUIT
End DoDot:1
+22 WRITE !
DO ^%ZISC
+23 DO KILL
+24 QUIT
BOTH ; Ask the user which to sort by i.e, CPT Code -or- Procedure
+1 WRITE !
DO KILLDIR
SET DIR(0)="SOA^C:CPT Code;P:Procedure"
+2 SET DIR("A")="Select the data element you wish to sort by: "
+3 SET DIR("?",1)="Enter 'C' to sort by the CPT Code, or 'P' to sort by the"
+4 SET DIR("?")="procedure."
+5 DO ^DIR
if $DATA(DIRUT)
SET RAXIT=1
+6 DO KILLDIR
if RAXIT
QUIT
SET RASORT=Y(0)
+7 QUIT
DOLLARY ; Caculate the new value of $Y for formatting purposes.
+1 SET RADX=$X
SET RADY=($Y+RAVHI)
DO ZOSF^RABAR1(RADX,RADY)
+2 QUIT
DSCR(Y) ; Device screen logic, select only barcode capable devices.
+1 NEW RABAR0,RABAR1,RATERMTY
SET RATERMTY=+$GET(^%ZIS(1,+Y,"SUBTYPE"))
+2 ; missing pointer to Terminal Type file!
if 'RATERMTY
QUIT 0
+3 ; barcode off node
SET RABAR0=$GET(^%ZIS(2,RATERMTY,"BAR0"))
+4 ; barcode on node
SET RABAR1=$GET(^%ZIS(2,RATERMTY,"BAR1"))
+5 ; barcoding capability
if (RABAR0]"")&(RABAR1]"")
QUIT 1
+6 QUIT 0
HDR ; Header
+1 if $Y
WRITE @IOF
SET RAPG=RAPG+1
+2 WRITE !?(IOM-$LENGTH(RAHD1)\2),RAHD1
+3 WRITE !?(IOM-$LENGTH(RAHD2)\2),RAHD2
+4 WRITE ?$SELECT(IOM=132:116,1:64),"Page: ",RAPG
+5 WRITE !,RALINE
+6 ; Check if user stops the task.
+7 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
+8 QUIT
HELP ; Help message for barcode height prompt
+1 WRITE !,"If you don't know how to answer this prompt, first determine which printer",!,"you are going to use. Then exit this option and re-select it from your menu."
+2 WRITE !,"When you are asked if you want to print a sample barcode, enter 'Yes'."
+3 WRITE !,"Enter your printer selection at the 'DEVICE' prompt, then retrieve your",!,"sample printout. If no barcode has printed, contact your IRM and ask them"
+4 WRITE !,"to set up the printer for barcode printing. If a barcode has printed, use",!,"the line counts printed above and below the barcode to determine how many"
+5 WRITE !,"vertical lines the barcode occupies (include the procedure name line printed",!,"below the barcode)."
+6 QUIT
HI() ; user input of height (in lines) of the barcode
+1 ; returns the height (in lines) of the barcode, OR -1 if user chooses
+2 ; to exit without inputting a number.
+3 NEW RALOW,RAHI
SET RALOW=1
SET RAHI=10
+4 WRITE !
DO KILLDIR
SET DIR(0)="NA^"_RALOW_":"_RAHI
+5 SET DIR("A")="Enter the height of the barcode: "
+6 SET DIR("?",1)="Enter the height of the barcode in terms of vertical text lines ("_RALOW_" to "_RAHI_")"
+7 SET DIR("?")="for your printer, or '^' to exit."
+8 SET DIR("??")="^D HELP^RABAR"
+9 DO ^DIR
SET Y=$SELECT($DATA(DIRUT):-1,1:+Y)
DO KILLDIR
+10 QUIT Y
INA(Y) ; Determines if the procedure is inactive
+1 ; Input : IEN of file 71
+2 ; Output: 1 if active, 0 if inactive
+3 if +$GET(^RAMIS(71,+Y,"I"))=0
QUIT 1
+4 QUIT $SELECT(+$GET(^RAMIS(71,+Y,"I"))>DT:1,1:0)
+5 ;
ITYPE() ; Select the Imaging Type(s)
+1 NEW RADIC,RAINPUT,RAQUIT,RAUTIL
+2 SET RADIC="^RA(79.2,"
SET RADIC(0)="QEAMZ"
SET RADIC("A")="Select Imaging Type: "
+3 SET RAUTIL="RA I-TYPE"
SET RAINPUT=1
DO EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
+4 QUIT RAQUIT
KILL ; Kill all other variables [ includes ^TMP($J) ]
+1 if '$DATA(RATEST)
KILL ^TMP($JOB,"RA BARDEV")
+2 KILL ^TMP($JOB,"RA I-TYPE"),^TMP($JOB,"RA PROC")
+3 KILL %X,%XX,%Y,%YY,RA1,RA2,RAHD1,RAHD2,RALINE,RAPG,RAPG1,RATEST,X,Y
+4 KILL ZTDESC,ZTRTN,ZTSAVE
+5 KILL DDH,I,POP
+6 QUIT
KILLDIR ; Kill off variables from DIR call
+1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+2 QUIT
LINE ; Print ten lines of text
+1 NEW I
FOR I=1:1:10
WRITE !,"LINE ",I
+2 QUIT
