source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RABAR1.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: 2.9 KB
Line 
1RABAR1 ;HISC/GJC-Procedure & CPT Code barcode output (part 2 of 2)
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4PRINT ; Print the barcode(s) & CPT Code(s)
5 N RA71,RA792,D0,RASPACE S RASPACE=" "
6 S D0=RA2 ; D0 selected for FM compatibility
7 S RA71(0)=$G(^RAMIS(71,D0,0)),RA71(6)=$P(RA71(0),"^",6)
8 S RA71(9)=+$P(RA71(0),"^",9),RA71(12)=+$P(RA71(0),"^",12)
9 S RA71(6)=$$XTERNAL^RAUTL5(RA71(6),$P($G(^DD(71,6,0)),"^",2))
10 I RA71(9)>0 D
11 . S RA71(9)=$$XTERNAL^RAUTL5(RA71(9),$P($G(^DD(71,9,0)),"^",2))
12 . Q
13 E S RA71(9)="No CPT"
14 S RA792(3)=$P($G(^RA(79.2,+RA71(12),0)),"^",3)
15 I $E(RAPRNT,1)="B" D
16 . I $Y>(IOSL-RAEOS) D Q:RAXIT
17 .. S RAXIT=$$EOS^RAUTL5() Q:RAXIT
18 .. D HDR^RABAR
19 .. Q
20 . W !,$P(RA71(0),"^"),RASPACE,RA792(3),RASPACE,RA71(6),RASPACE,RA71(9)
21 . W ! X ^DD(71,15,9.1) D:$D(RAVHI) DOLLARY^RABAR
22 . I $Y>(IOSL-RAEOS) D Q:RAXIT
23 .. S RAXIT=$$EOS^RAUTL5() Q:RAXIT
24 .. D HDR^RABAR
25 .. Q
26 . W !?10 X ^DD(71,16,9.1) W !
27 . D:$D(RAVHI) DOLLARY^RABAR
28 . Q
29 E D
30 . I $Y>(IOSL-RAEOS) D Q:RAXIT
31 .. S RAXIT=$$EOS^RAUTL5() Q:RAXIT
32 .. D HDR^RABAR
33 .. Q
34 . I $E(RAPRNT,1)="C" D
35 .. W !,$P(RA71(0),"^"),RASPACE,RA792(3),RASPACE,RA71(6),RASPACE,RA71(9)
36 .. W !?10 X ^DD(71,16,9.1) W !
37 .. Q
38 . I $E(RAPRNT,1)="P" D
39 .. W !,$P(RA71(0),"^"),RASPACE,RA792(3),RASPACE,RA71(6),RASPACE,RA71(9)
40 .. W ! X ^DD(71,15,9.1) W !
41 .. Q
42 . D:$D(RAVHI) DOLLARY^RABAR
43 . Q
44 Q
45PRINT1 ; Print the test barcode
46 N X S X="TEST BARCODE PRINT"
47 D LINE^RABAR
48 D PSET^%ZISP
49 I IOBARON]"",(IOBAROFF]"") D
50 . W !,X
51 . W @IOBARON,X,@IOBAROFF
52 . Q
53 D PKILL^%ZISP
54 D LINE^RABAR
55 Q
56PROC() ; Select the Procedure(s)
57 N RADIC,RAINPUT,RAQUIT,RAUTIL
58 S RADIC="^RAMIS(71,",RADIC(0)="QEAMZ",RADIC("A")="Select Procedure: "
59 S RADIC("S1")="N RAI S RAI=+$P($G(^RAMIS(71,+Y,0)),""^"",12)"
60 S RADIC("S2")=",RAI(""DT"")=$$INA^RABAR(+Y) "
61 S RADIC("S3")="I RAI,(RAI(""DT"")),($D(^TMP($J,""RA I-TYPE"",$P($G(^RA(79.2,RAI,0)),""^""))))"
62 S RADIC("S")=RADIC("S1")_RADIC("S2")_RADIC("S3")
63 S RAUTIL="RA PROC",RAINPUT=1
64 D:$E($G(RASORT),1)'="C" EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
65 D:$E($G(RASORT),1)="C" EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT,9)
66 Q RAQUIT
67TEST() ; Does the user wish to print a test barcode.
68 ; Returns '1' if test print is requested, '0' if no test print
69 W !,"To print barcoded procedure list, you will need to know the height (in",!,"vertical lines) of the barcode output on the printer to be used."
70 W ! D KILLDIR^RABAR S DIR(0)="YA",DIR("A",1)="Do you wish to print a sample barcode for the purpose of determining the"
71 S DIR("?")="Enter 'Y'es to print a sample, 'N'o to continue without a sample."
72 S DIR("A")="height (in vertical lines) of the barcode? "
73 S DIR("B")="No" D ^DIR S Y=$S($D(DIRUT):-1,1:+Y)
74 D KILLDIR^RABAR
75 Q Y
76ZOSF(DX,DY) ; Called to execute ^%ZOSF("XY")
77 X ^%ZOSF("XY")
78 Q
79ZTSAVE ; Save off variable for ZTLOAD
80 N I
81 F I="RADT","RAPRNT","RAXIT","^TMP($J,""RA PROC""," D
82 . S ZTSAVE(I)=""
83 . Q
84 S:$D(RASORT) ZTSAVE("RASORT")=""
85 S:$D(RATEST) ZTSAVE("RATEST")=""
86 S:$D(RAVHI) ZTSAVE("RAVHI")=""
87 Q
Note: See TracBrowser for help on using the repository browser.