source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD8.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1RAORD8 ;HISC/CAH,FPT AISC/RMO-Ward/Clinic Scheduled Request Log ;9/9/94 10:05
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 K DIC S DIC("A")="Select Ward/Clinic: ",DIC="^SC(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q:Y<0 S RALIFN=+Y,RALNM=$P(Y,"^",2)
4DATE S %DT("A")="Starting Imaging Exam Scheduled Date: ",%DT="EXA" W ! D ^%DT K %DT G Q^RAORD8:Y<0 S RALDTE1=Y
5 S %DT("A")="Ending Imaging Exam Scheduled Date: ",%DT="EXA" W ! D ^%DT K %DT G Q^RAORD8:Y<0 S RALDTE2=Y
6 I RALDTE2<RALDTE1 W !?5," ?? Starting date must be before ending date. Please try again.",! G DATE
7 I RALDTE2#1=0 S RALDTE2=RALDTE2+.2359
8 S ZTRTN="START^RAORD8",ZTSAVE("RALIFN")="",ZTSAVE("RALNM")="",ZTSAVE("RALDTE1")="",ZTSAVE("RALDTE2")="" W ! D ZIS^RAUTL G Q:RAPOP
9START U IO K ^TMP($J,"RAORD8"),^TMP($J,"RAORD8-XFER") S RAPGE=0,RAX="",RABEGDT=RALDTE1-.0001,RAENDDT=RALDTE2
10 S RAL0=$S($D(^SC(RALIFN,0)):^(0),1:0)
11 S RADIV=+$$SITE^VASITE(DT,+$P(RAL0,"^",15)) S:RADIV<0 RADIV=0
12 S RADIV=$S($D(^RA(79,RADIV,0)):RADIV,1:$O(^RA(79,0)))
13 I $D(^RA(79,+RADIV,.1)),$P(^(.1),"^",21)="y" S RALOCFLG=""
14 S RALNAME=$P(RAL0,U)
15 S Y=RALDTE1 D D^RAUTL S RALDTE1P=Y S Y=RALDTE2 D D^RAUTL S RALDTE2P=Y
16 S X="NOW",%DT="T" D ^%DT D D^RAUTL S RARUNDTE=Y
17 F RAOSCH=RABEGDT:0 S RAOSCH=$O(^RAO(75.1,"AD",RAOSCH)) Q:'RAOSCH!(RAOSCH>RAENDDT) F RADFN=0:0 S RADFN=$O(^RAO(75.1,"AD",RAOSCH,RADFN)) Q:'RADFN D CHKORD
18 I '$D(^TMP($J,"RAORD8")) W !!?5,"There are no scheduled requests ",!?5,"for ",RALNM," from ",RALDTE1P," to ",RALDTE2P,"." G Q
19 F RAOSCH=0:0 S RAOSCH=$O(^TMP($J,"RAORD8",RAOSCH)) Q:'RAOSCH!(RAX["^") F RADFN=0:0 S RADFN=$O(^TMP($J,"RAORD8",RAOSCH,RADFN)) Q:'RADFN!(RAX["^") D CHKUTL
20Q K ^TMP($J,"RAORD8"),^TMP($J,"RAORD8-XFER")
21 K POP,RAPOP,RABEGDT,RADFN,RADIV,RADPT0,RAENDDT,RAILCNM,RALDTE1,RALDTE1P,RALDTE2,RALDTE2P,RAL0,RALIFN,RALOCFLG,RALNAME,RALNM,RALOCN,RANME,RAOIFN,RAORD0,RAOSCH,RAPGE,RAPRC,RARLOCN,RARUNDTE,RASSN,RATIME,RAX,RAXFERIN,RAXFEROU,X,Y
22 K RAMES,ZTDESC,ZTRTN,ZTSAVE
23 K DDH,DFN,VAERR
24 W ! D CLOSE^RAUTL
25 Q
26 ;
27 ;Even if pt xfer'd out of the req'g loc, include pt on report
28CHKORD F RAOIFN=0:0 S RAOIFN=$O(^RAO(75.1,"AD",RAOSCH,RADFN,RAOIFN)) Q:'RAOIFN S RAORD0=$G(^RAO(75.1,RAOIFN,0)) I $P(RAORD0,"^",5)=8 D XFER I ($P(RAORD0,"^",22)=RALIFN)!(RAXFERIN) S ^TMP($J,"RAORD8",RAOSCH,RADFN,RAOIFN)=RAORD0
29 Q
30XFER ;Find out if patient transferred in or out of the requesting loc
31 S (RAXFERIN,RAXFEROU)=0 D IPOP^RAUTL13
32 I RALOCN=RALNAME,$L($G(RARLOCN)),$G(RARLOCN)'=RALNAME S RAXFERIN=1
33 I RALOCN'=RALNAME,$L($G(RARLOCN)),$G(RARLOCN)=RALNAME S RAXFEROU=1
34 I RAXFERIN!(RAXFEROU) S ^TMP($J,"RAORD8-XFER",RAOSCH,RADFN,RAOIFN)=RALOCN_U_$G(RARLOCN)
35 Q
36 ;
37CHKUTL F RAOIFN=0:0 S RAOIFN=$O(^TMP($J,"RAORD8",RAOSCH,RADFN,RAOIFN)) Q:'RAOIFN!(RAX["^") S RAORD0=^(RAOIFN) I $D(^DPT(RADFN,0)) S RADPT0=^(0) D PRT
38 Q
39 ;
40PRT D HD:($Y+4)>IOSL!('RAPGE) Q:RAX["^" S RAPRC=$S($D(^RAMIS(71,+$P(RAORD0,"^",2),0)):$P(^(0),"^"),1:"UNKNOWN"),RANME=$P(RADPT0,"^")
41 S RATIME=$$FMTE^XLFDT(RAOSCH,2) I $D(RALOCFLG) S RAILCNM=$S('$D(^RA(79.1,+$P(RAORD0,"^",20),0)):"UNKNOWN",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"UNKNOWN")
42 W !,$E(RANME,1,19),?20,$$SSN^RAUTL(RADFN,1),?28,RATIME,?43,$E(RAPRC,1,21) W:$D(RAILCNM) ?66,$E(RAILCNM,1,15)
43 S X=$G(^TMP($J,"RAORD8-XFER",RAOSCH,RADFN,RAOIFN)) I $L(X) D
44 . S RALOCN=$P(X,U),RARLOCN=$P(X,U,2)
45 . I RARLOCN=RALNAME W !?10,"Patient transferred to: ",RALOCN,!
46 . I RALOCN=RALNAME W !?10,"Requesting Location: ",RARLOCN,!
47 Q
48 ;
49HD D CRCHK Q:RAX["^" W:$Y>0 @IOF W !?23,">>> RADIOLOGY/NUCLEAR MEDICINE <<<",!!,"Scheduled Request Log for ",RALNM S RAPGE=RAPGE+1 W ?70,"Page: ",RAPGE
50 W !?5,"Schedule dates from ",RALDTE1P," to ",RALDTE2P W !,"Run Date: ",RARUNDTE
51 W !!,"Patient",?20,"Pt ID",?28,"Sched. Date",?43,"Procedure" W:$D(RALOCFLG) ?66,"Imaging Loc" W !,"-------------------",?20,"-----",?28,"-------------",?43,"---------------------" W:$D(RALOCFLG) ?66,"--------------"
52 Q
53 ;
54CRCHK I RAPGE,$E(IOST)="C" W !!,*7,"Press RETURN to continue or '^' to stop " R X:DTIME S RAX=X
55 Q
Note: See TracBrowser for help on using the repository browser.