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

RAORD8 ;HISC/CAH,FPT AISC/RMO-Ward/Clinic Scheduled Request Log ;9/9/94  10:05
 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
 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)
DATE S %DT("A")="Starting Imaging Exam Scheduled Date: ",%DT="EXA" W ! D ^%DT K %DT G Q^RAORD8:Y<0 S RALDTE1=Y
 S %DT("A")="Ending Imaging Exam Scheduled Date: ",%DT="EXA" W ! D ^%DT K %DT G Q^RAORD8:Y<0 S RALDTE2=Y
 I RALDTE2<RALDTE1 W !?5,"  ?? Starting date must be before ending date.  Please try again.",! G DATE
 I RALDTE2#1=0 S RALDTE2=RALDTE2+.2359
 S ZTRTN="START^RAORD8",ZTSAVE("RALIFN")="",ZTSAVE("RALNM")="",ZTSAVE("RALDTE1")="",ZTSAVE("RALDTE2")="" W ! D ZIS^RAUTL G Q:RAPOP
START U IO K ^TMP($J,"RAORD8"),^TMP($J,"RAORD8-XFER") S RAPGE=0,RAX="",RABEGDT=RALDTE1-.0001,RAENDDT=RALDTE2
 S RAL0=$S($D(^SC(RALIFN,0)):^(0),1:0)
 S RADIV=+$$SITE^VASITE(DT,+$P(RAL0,"^",15)) S:RADIV<0 RADIV=0
 S RADIV=$S($D(^RA(79,RADIV,0)):RADIV,1:$O(^RA(79,0)))
 I $D(^RA(79,+RADIV,.1)),$P(^(.1),"^",21)="y" S RALOCFLG=""
 S RALNAME=$P(RAL0,U)
 S Y=RALDTE1 D D^RAUTL S RALDTE1P=Y S Y=RALDTE2 D D^RAUTL S RALDTE2P=Y
 S X="NOW",%DT="T" D ^%DT D D^RAUTL S RARUNDTE=Y
 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
 I '$D(^TMP($J,"RAORD8")) W !!?5,"There are no scheduled requests ",!?5,"for ",RALNM," from ",RALDTE1P," to ",RALDTE2P,"." G Q
 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
Q K ^TMP($J,"RAORD8"),^TMP($J,"RAORD8-XFER")
 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
 K RAMES,ZTDESC,ZTRTN,ZTSAVE
 K DDH,DFN,VAERR
 W ! D CLOSE^RAUTL
 Q
 ;
 ;Even if pt xfer'd out of the req'g loc, include pt on report
CHKORD 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
 Q
XFER ;Find out if patient transferred in or out of the requesting loc
 S (RAXFERIN,RAXFEROU)=0 D IPOP^RAUTL13
 I RALOCN=RALNAME,$L($G(RARLOCN)),$G(RARLOCN)'=RALNAME S RAXFERIN=1
 I RALOCN'=RALNAME,$L($G(RARLOCN)),$G(RARLOCN)=RALNAME S RAXFEROU=1
 I RAXFERIN!(RAXFEROU) S ^TMP($J,"RAORD8-XFER",RAOSCH,RADFN,RAOIFN)=RALOCN_U_$G(RARLOCN)
 Q
 ;
CHKUTL 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
 Q
 ;
PRT 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,"^")
 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")
 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)
 S X=$G(^TMP($J,"RAORD8-XFER",RAOSCH,RADFN,RAOIFN)) I $L(X) D
 . S RALOCN=$P(X,U),RARLOCN=$P(X,U,2)
 . I RARLOCN=RALNAME W !?10,"Patient transferred to: ",RALOCN,!
 . I RALOCN=RALNAME W !?10,"Requesting Location: ",RARLOCN,!
 Q
 ;
HD 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
 W !?5,"Schedule dates from ",RALDTE1P," to ",RALDTE2P W !,"Run Date: ",RARUNDTE
 W !!,"Patient",?20,"Pt ID",?28,"Sched. Date",?43,"Procedure" W:$D(RALOCFLG) ?66,"Imaging Loc" W !,"-------------------",?20,"-----",?28,"-------------",?43,"---------------------" W:$D(RALOCFLG) ?66,"--------------"
 Q
 ;
CRCHK I RAPGE,$E(IOST)="C" W !!,*7,"Press RETURN to continue or '^' to stop " R X:DTIME S RAX=X
 Q