- 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 Mar 13, 2025@21:38:29 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
