source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD7A.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: 5.4 KB
Line 
1RAORD7A ;HISC/CAH-Log of Scheduled Requests by Procedure ;11/5/01 15:19
2 ;;5.0;Radiology/Nuclear Medicine;**15,31**;Mar 16, 1998
3 ;;This routine looks at orders in file 75.1 with field 23 (Scheduled date) within the date range selected. User also selects order statuses to include.
4 ; if sort by procedure:
5 ;^TMP($J,"RA7",Img loc name,Img loc IEN, proc name, sched day, sched time, AMIS ien, PATIENT ien, Rad Order ien)
6 ; if sort by date:
7 ;^TMP($J,"RA7",Img loc name,Img loc IEN, sched day, sched time, proc name, AMIS ien, PATIENT ien, Rad Order ien)
8 ;
9START ;Entry point for Scheduled Request Log task
10 S RAZERO="0000"
11 U IO K ^TMP($J,"RA7") S RAPGE=0,$P(RALNE,"-",79)="",$P(RALNE1,"=",79)="",(RAX,RAHI)="",RABEGDT=RALDTE1-.0001,RAENDDT=+$P(RALDTE2,".",1)+.9999
12 S Y=RALDTE1 D D^RAUTL S RALDTE1=Y S Y=RALDTE2 D D^RAUTL S RALDTE2=Y,X="NOW",%DT="T" D ^%DT D D^RAUTL S RARUNDTE=Y
13 S RALOCNM="" F S RALOCNM=$O(RALOC(RALOCNM)) Q:RALOCNM="" S RA791IEN="" F S RA791IEN=$O(RALOC(RALOCNM,RA791IEN)) Q:RA791IEN="" S RALOC1(RA791IEN)=""
14 S RALOC("UNKNOWN",99999)="",RALOC1(99999)="" ;Setup if loc is missing
15 S RA791IEN="" F S RA791IEN=$O(RALOC1(RA791IEN)) Q:'RA791IEN!(RA791IEN=99999) S RALOC2(+$P(^RA(79.1,RA791IEN,0),U,6))=""
16 K RALOCNM,RA791IEN
17 F RAOSCH=RABEGDT:0 S RAOSCH=$O(^RAO(75.1,"AD",RAOSCH)) Q:'RAOSCH!(RAOSCH>RAENDDT) S RADFN=0 F S RADFN=$O(^RAO(75.1,"AD",RAOSCH,RADFN)) Q:'RADFN D
18 .S RAOIFN=0 F S RAOIFN=$O(^RAO(75.1,"AD",RAOSCH,RADFN,RAOIFN)) Q:'RAOIFN I $D(^RAO(75.1,RAOIFN,0)) S RAORD0=^(0) I $D(RALOC1(+$P(RAORD0,U,20)))!($P(RAORD0,U,20)="") D
19 ..I $P(RAORD0,U,20)="",'$D(RALOC2(+$P(RAORD0,U,3))) Q ;UNK is dif imgtyp
20 ..S RAPRI=+$P(RAORD0,"^",2) D S RAPRC=$S($P($G(^RAMIS(71,RAPRI,0)),U)]"":$E($P(^(0),U),1,21),1:"UNKNOWN")
21 ...S RAI=0,RAI=$O(^RAMIS(71,RAPRI,2,RAI)) S:'RAI RAMIS=0 Q:'RAI S RAMIS=+$G(^(RAI,0))
22 ..S RADAY=$P(RAOSCH,".",1),RATIME=$P(RAOSCH,".",2) S:RATIME="" RATIME=0
23 ..S RAZTIME=RATIME S:$L(RAZTIME)<4 RAZTIME=RATIME_$E(RAZERO,1,(4-$L(RATIME))) S RAZTIME=+RAZTIME ;append trailing zero(s), then remove leading zero(s)
24 ..S RALIEN=$S($P(RAORD0,"^",20):$P(RAORD0,"^",20),1:99999)
25 ..S RALNM=$S(RALIEN=99999:"UNKNOWN",1:$P(^SC($P($G(^RA(79.1,+RALIEN,0)),U),0),U))
26 ..S:$E(RASORT)="P" ^TMP($J,"RA7",RALNM,RALIEN,RAPRC,RADAY,RAZTIME,RAMIS,RADFN,RAOIFN)=RATIME
27 ..S:$E(RASORT)="D" ^TMP($J,"RA7",RALNM,RALIEN,RADAY,RAZTIME,RAPRC,RAMIS,RADFN,RAOIFN)=RATIME
28 Q:$G(RAX)["^" I '$D(^TMP($J,"RA7")) W !!," No scheduled requests are logged for ",RALDTE1," through ",RALDTE2,"." G Q
29 S I="" F S I=$O(RALOC(I)) Q:I="" I '$D(^TMP($J,"RA7",I)) S ^TMP($J,"RA7",I)="NONE"
30 S RALNM="" F S RALNM=$O(^TMP($J,"RA7",RALNM)) Q:RALNM=""!(RAX["^") D NEG D:'$G(RANEG) GET K RANEG
31 G Q
32GET S (RALIEN,RA5)="" F S RALIEN=$O(^TMP($J,"RA7",RALNM,RALIEN)) Q:'RALIEN!(RAX["^") I $D(RALOC1(RALIEN)) D HD F S RA5=$O(^TMP($J,"RA7",RALNM,RALIEN,RA5)) Q:(RA5="")!(RAX["^") W:(RAPGE)&($E(RASORT)="P") !,RALNE1 D
33 .S RA6="" F S RA6=$O(^TMP($J,"RA7",RALNM,RALIEN,RA5,RA6)) Q:RA6=""!(RAX["^") S RA7="" F S RA7=$O(^TMP($J,"RA7",RALNM,RALIEN,RA5,RA6,RA7)) Q:(RA7="")!(RAX["^") D
34 ..S RAMIS="" F S RAMIS=$O(^TMP($J,"RA7",RALNM,RALIEN,RA5,RA6,RA7,RAMIS)) Q:RAMIS=""!(RAX["^") S RADFN=0 F S RADFN=$O(^TMP($J,"RA7",RALNM,RALIEN,RA5,RA6,RA7,RAMIS,RADFN)) Q:RADFN=""!(RAX["^") D
35 ...S RAOIFN=0 F S RAOIFN=$O(^TMP($J,"RA7",RALNM,RALIEN,RA5,RA6,RA7,RAMIS,RADFN,RAOIFN)) Q:'RAOIFN!(RAX["^") S RATIME=^(RAOIFN),RAORD0=$G(^RAO(75.1,RAOIFN,0)) D GETDFN
36 Q
37GETDFN Q:RAX["^" S RANME=$P($G(^DPT(RADFN,0)),"^"),RAOSCH=$S($E(RASORT)="P":RA6,1:RA5)_"."_RATIME,RAOSCH=+RAOSCH,X=$P(RAORD0,U,5),RASTAT=$S(X=3:"HOL",X=5:"PEN",X=8:"SCH",X=11:"UNR",1:"???")
38 I $D(RANOSHOW),RASTAT'="SCH" Q
39 S RALIEN=RAHI K RARLOC,RARLOCN,RARIPOP,RACIPOP,RAIPLOC,RAIPLOCN,RADONE
40 D IPOP^RAUTL13,WRT
41 Q
42WRT S RAOURG=$P(RAORD0,"^",6)
43 D HD:($Y+4)>IOSL!('RAPGE)!(RALIEN'=RAHI) Q:RAX["^"
44 W !,$E(RANME,1,12),?14,$$SSN^RAUTL(RADFN,1),?21,$S($E(RASORT)="P":RA5,1:RA7),?44,$E(RALOCN,1,10),?56,$$FMTE^XLFDT(RAOSCH,2)
45 S C=$P(^DD(75.1,6,0),U,2),Y=RAOURG D Y^DIQ W ?71,$E(Y,1,7),!
46 I $L($G(RARLOCN)) W ?28,"Requesting Loc: ",RARLOCN
47 Q
48NEG ;Negative reporting
49 Q:$G(RAX)["^" K RANEG
50 I RALNM="UNKNOWN" Q
51 I $G(^TMP($J,"RA7",RALNM))="NONE" S RANEG=1 D HD Q:$G(RAX)["^" W !!," No scheduled requests are logged for ",RALDTE1," through ",RALDTE2,"."
52 Q
53Q K ^TMP($J,"RA7"),%DT,C,DIR,DTOUT,DUOUT,I,IOP,POP,RABEGDT,RACIPOP,RADAY,RADFN,RADLOCS,RADPT0,RAENDDT,RAHI,RAI,RAIN44,RAIPLOC,RAIPLOCN,RAIPOP
54 K RALDTE1,RALDTE2,RALIEN,RALNE,RALNE1,RALNM,RALOC,RALOC1,RALOC2,RALOCN,RALOCSAV,RAMES,RAMIS,RANEG,RANEWLOC,RANME,RANO,RANOSHOW,RAOIFN,RAORD0,RAORST,RAORSTS,RAOSCH,RAOURG,RAPGE,RAPOP,RAPRC,RAPRI,RAQUIT
55 K RARIPOP,RARLOC,RARLOCN,RARUNDTE,RASSN,RAST,RASTAT,RASTX,RATIME,RAUPDLOC,RAX,RAZERO,RAZTIME,VA200,VAIN,VAIP,X,X1,Y,ZTDESC,ZTRTN,ZTSAVE,RASORT,RA5,RA6,RA7
56 W ! D CLOSE^RAUTL
57 K DDH,DIRUT,DISYS,DFN
58 Q
59 ;
60HD D CRCHK Q:RAX["^" W:RAPGE!($E(IOST,1,2)="C-") @IOF W !,"Scheduled Request Log by Imaging Location, ",RASORT S RAPGE=RAPGE+1
61 W ?70,"Page: ",RAPGE,!?5,"Includes requests scheduled from ",RALDTE1," to ",RALDTE2
62 W !,"Run Date: ",RARUNDTE,?31,"Imaging Location: ",RALNM ;$S($D(^SC(+$P($G(^RA(79.1,+RALIEN,0)),"^"),0)):$P(^(0),"^"),1:"UNKNOWN")
63 W !?5,$S($D(RANOSHOW):"(no-show's only) ",1:"")
64 W !,"Patient",?14,"Pt ID",?22,"Procedure",?44,"Pt Loc",?56,"Sched. Date",?71,"Urgency",!,RALNE
65 S RAHI=RALIEN Q
66 ;
67CRCHK I RAPGE,$E(IOST)="C" W !!,$C(7),"Press RETURN to continue or '^' to stop " R X:DTIME S RAX=X
68 Q
Note: See TracBrowser for help on using the repository browser.