source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RABAR.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1RABAR ;HISC/GJC-Procedure & CPT Code barcode output (part 1 of 2) ;7/31/96 08:57
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3EN1 ; Entry point for RA BARPROCPRINT (Barcoded Procedure List)
4 ; variable list:
5 ; 'RADIC' : namespaced DIC input variables passed to EN1^RASELCT
6 ; 'RAPRNT': data elements to print i.e, CPT Code, Procedure or both
7 ; 'RASORT': data elements to sort by i.e, CPT Code or Procedure
8 ; '^TMP($J,"RA I-TYPE")': Imaging Type(s) selected by the user
9 ; '^TMP($J,"RA PROC")' : Procedure(s) selected by the user
10 ;
11 K ^TMP($J,"RA BARDEV"),^TMP($J,"RA I-TYPE"),^TMP($J,"RA PROC")
12 N RADIC,RADT,RADX,RADY,RAPRNT,RASORT,RAVHI,RAXIT
13 S RADT=$$FMTE^XLFDT(DT,"1D"),RAXIT=0
14 S RATEST=$$TEST^RABAR1() I RATEST<0 D KILL Q
15 I RATEST D DEV ; obtain proc test print
16 K RATEST
17 S RAVHI=$$HI() ; vertical height (in lines) of the barcode
18 I RAVHI<0 D KILL Q
19 D KILLDIR S DIR(0)="SO^C:CPT barcode;P:Procedure barcode;B:Both barcodes"
20 S DIR("A")="Which of the above would you like to print?"
21 S DIR("?",1)="Enter 'B' to print both the Procedure and CPT Code in a"
22 S DIR("?",2)="barcode format. 'C' to print only the CPT Code barcode,"
23 S DIR("?")="or 'P' to print only the procedure in a barcode format."
24 D ^DIR S:$D(DIRUT) RAXIT=1
25 D KILLDIR G:RAXIT KILL S RAPRNT=Y(0)
26 I $E(RAPRNT,1)="B" D BOTH G:RAXIT KILL ; sort by CPT or Procedure?
27 S RAXIT=$$ITYPE() G:RAXIT KILL
28 S RAXIT=$$PROC^RABAR1() G:RAXIT KILL
29 I '$D(^TMP($J,"RA PROC")) D KILL Q
30DEV ; Device selection
31 W ! S %ZIS="QM",%ZIS("A")="Select a printer with barcode setup: "
32 S %ZIS("B")=$S($D(^TMP($J,"RA BARDEV"))\10:$O(^("RA BARDEV","")),1:"")
33 S %ZIS("S")="I $$DSCR^RABAR(+Y)" D ^%ZIS
34 I POP D KILL Q
35 I $D(RATEST) S ^TMP($J,"RA BARDEV",ION)=""
36 I $D(IO("Q")) D G KILL
37 . S ZTRTN="START^RABAR"
38 . S ZTDESC="Rad Nuc/Med Print procedure/CPT code in a barcode format."
39 . D ZTSAVE^RABAR1,^%ZTLOAD
40 . I +$G(ZTSK("D"))>0 W !?5,"Request Queued, Task #: ",$G(ZTSK)
41 . D HOME^%ZIS
42 . K %X,%XX,%Y,%YY,IO("Q"),X,Y
43 . Q
44START ; Start processing data & printing to the device here
45 S:$D(ZTQUEUED) ZTREQ="@" U IO
46 I '$D(RATEST) D
47 . S RAHD1="Barcode print of Imaging "
48 . S:$E(RAPRNT,1)="B" RAHD1=RAHD1_"Procedures & CPT Codes"
49 . S:$E(RAPRNT,1)="C" RAHD1=RAHD1_"CPT Codes"
50 . S:$E(RAPRNT,1)="P" RAHD1=RAHD1_"Procedures"
51 . Q
52 S:$D(RATEST) RAHD1="Barcode test print"
53 S RAHD2="Printed on: "_RADT,RAPG=0
54 S $P(RALINE,"-",(IOM+1))="",RA1=""
55 I $D(RATEST) D
56 . D HDR Q:RAXIT D PRINT1^RABAR1
57 . Q
58 E D
59 . N RAEOS S RAEOS=$S($D(RAVHI):RAVHI,1:6) D HDR Q:RAXIT
60 . F S RA1=$O(^TMP($J,"RA PROC",RA1)) Q:RA1="" D Q:RAXIT
61 .. S RA2=0 F S RA2=$O(^TMP($J,"RA PROC",RA1,RA2)) Q:RA2'>0 D Q:RAXIT
62 ... D PRINT^RABAR1
63 ... Q
64 .. Q
65 . Q
66 W ! D ^%ZISC
67 D KILL
68 Q
69BOTH ; Ask the user which to sort by i.e, CPT Code -or- Procedure
70 W ! D KILLDIR S DIR(0)="SOA^C:CPT Code;P:Procedure"
71 S DIR("A")="Select the data element you wish to sort by: "
72 S DIR("?",1)="Enter 'C' to sort by the CPT Code, or 'P' to sort by the"
73 S DIR("?")="procedure."
74 D ^DIR S:$D(DIRUT) RAXIT=1
75 D KILLDIR Q:RAXIT S RASORT=Y(0)
76 Q
77DOLLARY ; Caculate the new value of $Y for formatting purposes.
78 S RADX=$X,RADY=($Y+RAVHI) D ZOSF^RABAR1(RADX,RADY)
79 Q
80DSCR(Y) ; Device screen logic, select only barcode capable devices.
81 N RABAR0,RABAR1,RATERMTY S RATERMTY=+$G(^%ZIS(1,+Y,"SUBTYPE"))
82 Q:'RATERMTY 0 ; missing pointer to Terminal Type file!
83 S RABAR0=$G(^%ZIS(2,RATERMTY,"BAR0")) ; barcode off node
84 S RABAR1=$G(^%ZIS(2,RATERMTY,"BAR1")) ; barcode on node
85 Q:(RABAR0]"")&(RABAR1]"") 1 ; barcoding capability
86 Q 0
87HDR ; Header
88 W:$Y @IOF S RAPG=RAPG+1
89 W !?(IOM-$L(RAHD1)\2),RAHD1
90 W !?(IOM-$L(RAHD2)\2),RAHD2
91 W ?$S(IOM=132:116,1:64),"Page: ",RAPG
92 W !,RALINE
93 ; Check if user stops the task.
94 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
95 Q
96HELP ; Help message for barcode height prompt
97 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."
98 W !,"When you are asked if you want to print a sample barcode, enter 'Yes'."
99 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"
100 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"
101 W !,"vertical lines the barcode occupies (include the procedure name line printed",!,"below the barcode)."
102 Q
103HI() ; user input of height (in lines) of the barcode
104 ; returns the height (in lines) of the barcode, OR -1 if user chooses
105 ; to exit without inputting a number.
106 N RALOW,RAHI S RALOW=1,RAHI=10
107 W ! D KILLDIR S DIR(0)="NA^"_RALOW_":"_RAHI
108 S DIR("A")="Enter the height of the barcode: "
109 S DIR("?",1)="Enter the height of the barcode in terms of vertical text lines ("_RALOW_" to "_RAHI_")"
110 S DIR("?")="for your printer, or '^' to exit."
111 S DIR("??")="^D HELP^RABAR"
112 D ^DIR S Y=$S($D(DIRUT):-1,1:+Y) D KILLDIR
113 Q Y
114INA(Y) ; Determines if the procedure is inactive
115 ; Input : IEN of file 71
116 ; Output: 1 if active, 0 if inactive
117 Q:+$G(^RAMIS(71,+Y,"I"))=0 1
118 Q $S(+$G(^RAMIS(71,+Y,"I"))>DT:1,1:0)
119 ;
120ITYPE() ; Select the Imaging Type(s)
121 N RADIC,RAINPUT,RAQUIT,RAUTIL
122 S RADIC="^RA(79.2,",RADIC(0)="QEAMZ",RADIC("A")="Select Imaging Type: "
123 S RAUTIL="RA I-TYPE",RAINPUT=1 D EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
124 Q RAQUIT
125KILL ; Kill all other variables [ includes ^TMP($J) ]
126 K:'$D(RATEST) ^TMP($J,"RA BARDEV")
127 K ^TMP($J,"RA I-TYPE"),^TMP($J,"RA PROC")
128 K %X,%XX,%Y,%YY,RA1,RA2,RAHD1,RAHD2,RALINE,RAPG,RAPG1,RATEST,X,Y
129 K ZTDESC,ZTRTN,ZTSAVE
130 K DDH,I,POP
131 Q
132KILLDIR ; Kill off variables from DIR call
133 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
134 Q
135LINE ; Print ten lines of text
136 N I F I=1:1:10 W !,"LINE ",I
137 Q
Note: See TracBrowser for help on using the repository browser.