source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD61.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1RAORD61 ;HISC/GJC-Print A Request Cont. ;2/2/98 15:28
2 ;;5.0;Radiology/Nuclear Medicine;**45,68**;Mar 16, 1998
3 ;11/18/05 KAM Remedy Call 100930 Remove extra dash lines
4 ;
5TC ;technologist information & comment (called from RAORD6)
6 N RA18FL,RA18ARR,RA18EX,RA18CNI,RA18DTI,RA18PRC,RA18ND,RA18TC S RA18EX=0,RA18CNI=0
7 ;11/18/05 KAM Modified next line - was G:RA18DTI="" DASHLN^RAORD6
8 S RA18DTI=$O(^RADPT("AO",RAOIFN,RADFN,0)) Q:RA18DTI=""
9 F S RA18CNI=$O(^TMP($J,"RAE2",RADFN,RA18CNI)) Q:+RA18CNI=0 D Q:RAX["^"
10 . S RA18PRC=""
11 . F S RA18PRC=$O(^TMP($J,"RAE2",RADFN,RA18CNI,RA18PRC)) Q:RA18PRC="" D Q:RAX["^"
12 .. ;case info
13 .. W !,"Case No: "_$P($G(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,0)),"^")
14 .. S RA18FL=0,RA18ARR("FT")=""
15 .. S RA18TC=0 F S RA18TC=$O(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"F",RA18TC)) Q:RA18TC="" S RA18ARR("F")=$G(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"F",RA18TC,0),0) D Q:$L(RA18ARR("FT"))>32
16 ... I RA18ARR("F")'=0 S RA18ARR("FT")=RA18ARR("FT")_$P($G(RA18ARR("F")),"^",2)_"-"_$P($G(^RA(78.4,$P($G(RA18ARR("F")),"^",1),0)),"^",1)_";"
17 .. S RA18TC=0 F S RA18TC=$O(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"TC",RA18TC)) Q:RA18TC="" S RA18ARR("T",RA18TC,0)=$G(^RADPT(RADFN,"DT",RA18DTI,"P",RA18CNI,"TC",RA18TC,0),0) D
18 ... I RA18ARR("T",RA18TC,0)'=0 W:RA18FL>0 ! W ?14,"Tech: " I RA18ARR("T",RA18TC,0)'="" S RA18ARR("N")=$$GET1^DIQ(200,RA18ARR("T",RA18TC,0),.01) W $E($P(RA18ARR("N"),"^",1),1,18)
19 ... W:(RA18FL'>0) ?38," Film: "_$E(RA18ARR("FT"),1,32)
20 ... S RA18FL=RA18FL+1
21 .. I '$D(RA18ARR("T")) W ?14,"Tech: ",?38," Film: "_$E(RA18ARR("FT"),1,32)
22 .. K RA18ARR("T"),RA18ARR("F"),RA18ARR("N")
23 .. I $O(^TMP($J,"RAE2",RADFN,RA18CNI,RA18PRC,"TCOM",0))>0 D Q
24 ... ;tech comm
25 ... W !
26 ... S RA18EX=$$TXTOUT^RAUTL11(^TMP($J,"RAE2",RADFN,RA18CNI,RA18PRC,"TCOM",1),1,70,-1,"",4,1,1,1)
27 ... D HD^RAORD6:($Y+6)>IOSL
28 Q
29 ;
Note: See TracBrowser for help on using the repository browser.