source: FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RART3.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1RART3 ;HISC/GJC,SWM-Reporting Menu (Part 2) ;8/31/99 13:57
2 ;;5.0;Radiology/Nuclear Medicine;**8,10,18,27,35,45,75**;Mar 16, 1998;Build 4
3 ; continue from RART1
4 ; last modif by SS for P18
5QRPT ; Queue the report to run
6 N X K IOP,%ZIS S %ZIS="Q",%ZIS("B")=""
7 S %ZIS("S")="I $E($P($G(^%ZIS(2,+$P($G(^(""SUBTYPE"")),""^""),0)),""^""),1,2)=""P-"""
8 W ! D ^%ZIS
9 I POP D Q6^RART1 Q
10 I $E(IOST,1,2)="P-",('$D(IO("Q"))) D
11 . D PRT^RARTR
12 . Q
13 I $D(IO("Q")) D
14 . K RANME,RAPRC,Y S U="^",DT=$S($G(DT)]"":DT,1:$$DT^XLFDT())
15 . S ZTDESC="Rad/Nuc Med Abnormal Report Alert",ZTRTN="PRT^RARTR"
16 . S:$D(RARTMES) ZTSAVE("RARTMES")=""
17 . F I="DT","RARPT","U" S ZTSAVE(I)=""
18 . D ^%ZTLOAD W:$D(ZTSK) " Task # ",ZTSK
19 . K IO("Q"),ZTDESC,ZTRTN,ZTSAVE
20 . Q
21 W ! D ^%ZISC,HOME^%ZIS
22 D Q6^RART1,EXIT^RART
23 Q
24PHYS N RA2ND,R1,R2,RASTR
25 S (R1,R2)=0 F S R2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",R2)) Q:'R2 S:+$G(^(R2,0)) R1=R1+1,RA2ND("SRR",R1)=+^(0),RA2ND("SRR",R1)=$E($P($G(^VA(200,RA2ND("SRR",R1),0)),"^"),1,20)
26 S (R1,R2)=0 F S R2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",R2)) Q:'R2 S:+$G(^(R2,0)) R1=R1+1,RA2ND("SSR",R1)=+^(0),RA2ND("SSR",R1)=$E($P($G(^VA(200,RA2ND("SSR",R1),0)),"^"),1,20)
27 S R1=$E($P($G(^VA(200,+$P(R3,"^",15),0)),"^"),1,15)
28 S RASTR="Staff Phys: "_R1 S:R1]"" RASTR=RASTR_" (P)"
29PHYS1 I '$O(RA2ND("SSR",0)) W !,RASTR G PHYS2
30 S R1=0
31PHYS11 S R1=$O(RA2ND("SSR",R1)) G:R1="" PHYS19
32 I $L(RASTR)+$L(RA2ND("SSR",R1))>79 W !,RASTR,";" S RASTR=" "
33 S:RASTR]" " RASTR=RASTR_"; " S RASTR=RASTR_RA2ND("SSR",R1) G PHYS11
34PHYS19 W:RASTR]"" !,RASTR
35PHYS2 S R1=$E($P($G(^VA(200,+$P(R3,"^",12),0)),"^"),1,15)
36 S RASTR="Residents : "_R1 S:R1]"" RASTR=RASTR_" (P)"
37 I '$O(RA2ND("SRR",0)) W !,RASTR Q
38 S R1=0
39PHYS21 S R1=$O(RA2ND("SRR",R1)) G:R1="" PHYS29
40 I $L(RASTR)+$L(RA2ND("SRR",R1))>79 W !,RASTR,";" S RASTR=" "
41 S:RASTR]" " RASTR=RASTR_"; " S RASTR=RASTR_RA2ND("SRR",R1) G PHYS21
42PHYS29 W:RASTR]"" !,RASTR
43 Q
44MODSET ; print modifiers of all cases of print set
45 N RACDIS,RALDIS,RACNISAV,RAMEMARR,R1
46 D EN2^RAUTL20(.RAMEMARR) Q:'$O(RAMEMARR(0))
47 S RACNISAV=RACNI,RACNI=0
48 D CDIS^RAPROD S (RAREZON,RACNI)=0
49 ;for printsets print the REASON FOR STUDY along with the lead procedure
50 ;(avoid duplicate printing of the same data)
51 F S RACNI=$O(RAMEMARR(RACNI)) Q:'RACNI D Q:$L($G(X)) I $G(RAXIT) S X="^" Q
52 . S R1=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
53 . D MODS^RAUTL2
54 . ; If printing page at a time we need to check the length - RA*5*8
55 . I $Y>(IOSL-6),'$D(RARTVERF) S RAP="" D WAIT^RART1 I X="^"!(X="P")!(X="T") Q
56 . K X
57 . D OUT1 S RAREZON=1
58 . S:+$P(R1,"^",28) X=$$RDIO1^RARTUTL1(+$P(R1,"^",28)) Q:$L($G(X))
59 . S:+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) X=$$PHARM1^RARTUTL(RACNI_","_RADTI_","_RADFN_",")
60 . W:$O(RAMEMARR(RACNI)) !
61 . Q
62 S RACNI=RACNISAV
63 W ! K RAREZON
64 Q
65OUT1 ; print Procedure name, CPT code, Procedure modifier, and CPT Modifiers
66 ; $O(RAMEMARR(0)) may be defined, if previously called MODSET^RART3
67 ; RALDIS flags long display wanted, comes from certain output options
68 ; RACDIS(n) exists if case n is to be displayed
69 ; RACDIS(n) not set for dupl proc+pmod+cptmod so don't display
70 ; If printset, skip if not long format or case not marked for cond.displ
71 I $O(RAMEMARR(0)),'$G(RALDIS),'$D(RACDIS(RACNI)) Q
72 N I,J,RACRF S RACRF=1
73 N RA18RET S RA18RET=0 ;P18
74 S R1=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
75 S RASTUDY=$P($G(^RAO(75.1,+$P(R1,U,11),.1)),U) ;Convey 'Reason for Study' P75
76 ; Check if cancelled and not part of this report
77 I $P(^RA(72,+$P(R1,"^",3),0),"^",3)=0,($P(R1,"^",17)="") Q
78 I $P(^RA(72,+$P(R1,"^",3),0),"^",3)=0 D
79 .W !,$S($G(RALDIS):"",'$D(RACDIS):"",$G(RACDIS(RACNI))=1:"",1:RACDIS(RACNI)_"x"),?4,$E($P($G(^RAMIS(71,+$P(R1,"^",2),0)),"^"),1,42)_" (cancelled)"
80 E W !,$S($G(RALDIS):"",'$D(RACDIS):"",$G(RACDIS(RACNI))=1:"",1:RACDIS(RACNI)_"x"),?4,$P($G(^RAMIS(71,+$P(R1,"^",2),0)),"^")
81 D PRCCPT^RAPROD ;disp proc. abbr, proc type, & CPT
82 ;check for contrast media; display if CM data exists (patch 45)
83 S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RACNI)
84 I $L(RACMDATA) D
85 .W !?5,"Contrast Media :"
86 .F RAIZ=1:1 Q:$P(RACMDATA,", ",RAIZ)="" D
87 ..W ?22,$P(RACMDATA,", ",RAIZ) W:$P(RACMDATA,", ",RAIZ+1)'="" !
88 ..I '$D(RARTVERF),$Y>(IOSL-5) S RAXIT=$$EOS^RAUTL5() S:RAXIT RA18RET=-1 Q:RAXIT W @IOF W !
89 ..Q
90 .K RAIZ
91 .QUIT
92 K RACMDATA Q:RA18RET=-1 ;P18
93 W:Y'="None" !?5,"Proc Modifiers : ",Y
94 W:Y(1)'="None" !?5,"CPT Modifiers :"
95 I Y(1)'="None" S RACRF=0 D
96 .F I=1:1 Q:$P(Y(2),", ",I)']"" S J=$P(Y(2),", ",I),J=$$BASICMOD^RACPTMSC(J,DT) W ?22,$P(J,"^",2)," ",$P(J,"^",3) W:$P(Y(2),", ",I+1)]"" ! I '$D(RARTVERF),$Y>(IOSL-5) S RAXIT=$$EOS^RAUTL5() S:RAXIT RA18RET=-1 Q:RAXIT W @IOF W !
97 Q:RA18RET=-1
98 I $L(RASTUDY),$G(RAREZON,0)=0 W:RACRF ! S RACRF=0 D DIWP^RAUTL5(5,68,"Reason for Study: "_RASTUDY) ;P75
99 K RASTUDY
100 ;RATECHCO is defined in OPTION FILE's ENTRY/EXIT ACTION
101 I $D(RATECHCO) W:RACRF ! S RA18RET=$$PUTTCOM^RAUTL11(RADFN,RADTI,RACNI," Tech.Comment : ",22,70,7,0,0,2,0) S:RA18RET=-1 RAXIT=1 Q:RA18RET=-1 ;P18
102 Q
Note: See TracBrowser for help on using the repository browser.