- RAORD7A ;HISC/CAH-Log of Scheduled Requests by Procedure ;11/5/01 15:19
- ;;5.0;Radiology/Nuclear Medicine;**15,31**;Mar 16, 1998
- ;;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.
- ; if sort by procedure:
- ;^TMP($J,"RA7",Img loc name,Img loc IEN, proc name, sched day, sched time, AMIS ien, PATIENT ien, Rad Order ien)
- ; if sort by date:
- ;^TMP($J,"RA7",Img loc name,Img loc IEN, sched day, sched time, proc name, AMIS ien, PATIENT ien, Rad Order ien)
- ;
- START ;Entry point for Scheduled Request Log task
- S RAZERO="0000"
- 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
- 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
- S RALOCNM="" F S RALOCNM=$O(RALOC(RALOCNM)) Q:RALOCNM="" S RA791IEN="" F S RA791IEN=$O(RALOC(RALOCNM,RA791IEN)) Q:RA791IEN="" S RALOC1(RA791IEN)=""
- S RALOC("UNKNOWN",99999)="",RALOC1(99999)="" ;Setup if loc is missing
- S RA791IEN="" F S RA791IEN=$O(RALOC1(RA791IEN)) Q:'RA791IEN!(RA791IEN=99999) S RALOC2(+$P(^RA(79.1,RA791IEN,0),U,6))=""
- K RALOCNM,RA791IEN
- 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
- .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
- ..I $P(RAORD0,U,20)="",'$D(RALOC2(+$P(RAORD0,U,3))) Q ;UNK is dif imgtyp
- ..S RAPRI=+$P(RAORD0,"^",2) D S RAPRC=$S($P($G(^RAMIS(71,RAPRI,0)),U)]"":$E($P(^(0),U),1,21),1:"UNKNOWN")
- ...S RAI=0,RAI=$O(^RAMIS(71,RAPRI,2,RAI)) S:'RAI RAMIS=0 Q:'RAI S RAMIS=+$G(^(RAI,0))
- ..S RADAY=$P(RAOSCH,".",1),RATIME=$P(RAOSCH,".",2) S:RATIME="" RATIME=0
- ..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)
- ..S RALIEN=$S($P(RAORD0,"^",20):$P(RAORD0,"^",20),1:99999)
- ..S RALNM=$S(RALIEN=99999:"UNKNOWN",1:$P(^SC($P($G(^RA(79.1,+RALIEN,0)),U),0),U))
- ..S:$E(RASORT)="P" ^TMP($J,"RA7",RALNM,RALIEN,RAPRC,RADAY,RAZTIME,RAMIS,RADFN,RAOIFN)=RATIME
- ..S:$E(RASORT)="D" ^TMP($J,"RA7",RALNM,RALIEN,RADAY,RAZTIME,RAPRC,RAMIS,RADFN,RAOIFN)=RATIME
- Q:$G(RAX)["^" I '$D(^TMP($J,"RA7")) W !!," No scheduled requests are logged for ",RALDTE1," through ",RALDTE2,"." G Q
- S I="" F S I=$O(RALOC(I)) Q:I="" I '$D(^TMP($J,"RA7",I)) S ^TMP($J,"RA7",I)="NONE"
- S RALNM="" F S RALNM=$O(^TMP($J,"RA7",RALNM)) Q:RALNM=""!(RAX["^") D NEG D:'$G(RANEG) GET K RANEG
- G Q
- GET 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
- .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
- ..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
- ...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
- Q
- GETDFN 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:"???")
- I $D(RANOSHOW),RASTAT'="SCH" Q
- S RALIEN=RAHI K RARLOC,RARLOCN,RARIPOP,RACIPOP,RAIPLOC,RAIPLOCN,RADONE
- D IPOP^RAUTL13,WRT
- Q
- WRT S RAOURG=$P(RAORD0,"^",6)
- D HD:($Y+4)>IOSL!('RAPGE)!(RALIEN'=RAHI) Q:RAX["^"
- 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)
- S C=$P(^DD(75.1,6,0),U,2),Y=RAOURG D Y^DIQ W ?71,$E(Y,1,7),!
- I $L($G(RARLOCN)) W ?28,"Requesting Loc: ",RARLOCN
- Q
- NEG ;Negative reporting
- Q:$G(RAX)["^" K RANEG
- I RALNM="UNKNOWN" Q
- 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,"."
- Q
- Q 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
- 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
- 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
- W ! D CLOSE^RAUTL
- K DDH,DIRUT,DISYS,DFN
- Q
- ;
- HD D CRCHK Q:RAX["^" W:RAPGE!($E(IOST,1,2)="C-") @IOF W !,"Scheduled Request Log by Imaging Location, ",RASORT S RAPGE=RAPGE+1
- W ?70,"Page: ",RAPGE,!?5,"Includes requests scheduled from ",RALDTE1," to ",RALDTE2
- W !,"Run Date: ",RARUNDTE,?31,"Imaging Location: ",RALNM ;$S($D(^SC(+$P($G(^RA(79.1,+RALIEN,0)),"^"),0)):$P(^(0),"^"),1:"UNKNOWN")
- W !?5,$S($D(RANOSHOW):"(no-show's only) ",1:"")
- W !,"Patient",?14,"Pt ID",?22,"Procedure",?44,"Pt Loc",?56,"Sched. Date",?71,"Urgency",!,RALNE
- S RAHI=RALIEN Q
- ;
- CRCHK I RAPGE,$E(IOST)="C" W !!,$C(7),"Press RETURN to continue or '^' to stop " R X:DTIME S RAX=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAORD7A 5551 printed Feb 19, 2025@00:04:27 Page 2
- RAORD7A ;HISC/CAH-Log of Scheduled Requests by Procedure ;11/5/01 15:19
- +1 ;;5.0;Radiology/Nuclear Medicine;**15,31**;Mar 16, 1998
- +2 ;;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.
- +3 ; if sort by procedure:
- +4 ;^TMP($J,"RA7",Img loc name,Img loc IEN, proc name, sched day, sched time, AMIS ien, PATIENT ien, Rad Order ien)
- +5 ; if sort by date:
- +6 ;^TMP($J,"RA7",Img loc name,Img loc IEN, sched day, sched time, proc name, AMIS ien, PATIENT ien, Rad Order ien)
- +7 ;
- START ;Entry point for Scheduled Request Log task
- +1 SET RAZERO="0000"
- +2 USE IO
- KILL ^TMP($JOB,"RA7")
- SET RAPGE=0
- SET $PIECE(RALNE,"-",79)=""
- SET $PIECE(RALNE1,"=",79)=""
- SET (RAX,RAHI)=""
- SET RABEGDT=RALDTE1-.0001
- SET RAENDDT=+$PIECE(RALDTE2,".",1)+.9999
- +3 SET Y=RALDTE1
- DO D^RAUTL
- SET RALDTE1=Y
- SET Y=RALDTE2
- DO D^RAUTL
- SET RALDTE2=Y
- SET X="NOW"
- SET %DT="T"
- DO ^%DT
- DO D^RAUTL
- SET RARUNDTE=Y
- +4 SET RALOCNM=""
- FOR
- SET RALOCNM=$ORDER(RALOC(RALOCNM))
- if RALOCNM=""
- QUIT
- SET RA791IEN=""
- FOR
- SET RA791IEN=$ORDER(RALOC(RALOCNM,RA791IEN))
- if RA791IEN=""
- QUIT
- SET RALOC1(RA791IEN)=""
- +5 ;Setup if loc is missing
- SET RALOC("UNKNOWN",99999)=""
- SET RALOC1(99999)=""
- +6 SET RA791IEN=""
- FOR
- SET RA791IEN=$ORDER(RALOC1(RA791IEN))
- if 'RA791IEN!(RA791IEN=99999)
- QUIT
- SET RALOC2(+$PIECE(^RA(79.1,RA791IEN,0),U,6))=""
- +7 KILL RALOCNM,RA791IEN
- +8 FOR RAOSCH=RABEGDT:0
- SET RAOSCH=$ORDER(^RAO(75.1,"AD",RAOSCH))
- if 'RAOSCH!(RAOSCH>RAENDDT)
- QUIT
- SET RADFN=0
- FOR
- SET RADFN=$ORDER(^RAO(75.1,"AD",RAOSCH,RADFN))
- if 'RADFN
- QUIT
- Begin DoDot:1
- +9 SET RAOIFN=0
- FOR
- SET RAOIFN=$ORDER(^RAO(75.1,"AD",RAOSCH,RADFN,RAOIFN))
- if 'RAOIFN
- QUIT
- IF $DATA(^RAO(75.1,RAOIFN,0))
- SET RAORD0=^(0)
- IF $DATA(RALOC1(+$PIECE(RAORD0,U,20)))!($PIECE(RAORD0,U,20)="")
- Begin DoDot:2
- +10 ;UNK is dif imgtyp
- IF $PIECE(RAORD0,U,20)=""
- IF '$DATA(RALOC2(+$PIECE(RAORD0,U,3)))
- QUIT
- +11 SET RAPRI=+$PIECE(RAORD0,"^",2)
- Begin DoDot:3
- +12 SET RAI=0
- SET RAI=$ORDER(^RAMIS(71,RAPRI,2,RAI))
- if 'RAI
- SET RAMIS=0
- if 'RAI
- QUIT
- SET RAMIS=+$GET(^(RAI,0))
- End DoDot:3
- SET RAPRC=$SELECT($PIECE($GET(^RAMIS(71,RAPRI,0)),U)]"":$EXTRACT($PIECE(^(0),U),1,21),1:"UNKNOWN")
- +13 SET RADAY=$PIECE(RAOSCH,".",1)
- SET RATIME=$PIECE(RAOSCH,".",2)
- if RATIME=""
- SET RATIME=0
- +14 ;append trailing zero(s), then remove leading zero(s)
- SET RAZTIME=RATIME
- if $LENGTH(RAZTIME)<4
- SET RAZTIME=RATIME_$EXTRACT(RAZERO,1,(4-$LENGTH(RATIME)))
- SET RAZTIME=+RAZTIME
- +15 SET RALIEN=$SELECT($PIECE(RAORD0,"^",20):$PIECE(RAORD0,"^",20),1:99999)
- +16 SET RALNM=$SELECT(RALIEN=99999:"UNKNOWN",1:$PIECE(^SC($PIECE($GET(^RA(79.1,+RALIEN,0)),U),0),U))
- +17 if $EXTRACT(RASORT)="P"
- SET ^TMP($JOB,"RA7",RALNM,RALIEN,RAPRC,RADAY,RAZTIME,RAMIS,RADFN,RAOIFN)=RATIME
- +18 if $EXTRACT(RASORT)="D"
- SET ^TMP($JOB,"RA7",RALNM,RALIEN,RADAY,RAZTIME,RAPRC,RAMIS,RADFN,RAOIFN)=RATIME
- End DoDot:2
- End DoDot:1
- +19 if $GET(RAX)["^"
- QUIT
- IF '$DATA(^TMP($JOB,"RA7"))
- WRITE !!," No scheduled requests are logged for ",RALDTE1," through ",RALDTE2,"."
- GOTO Q
- +20 SET I=""
- FOR
- SET I=$ORDER(RALOC(I))
- if I=""
- QUIT
- IF '$DATA(^TMP($JOB,"RA7",I))
- SET ^TMP($JOB,"RA7",I)="NONE"
- +21 SET RALNM=""
- FOR
- SET RALNM=$ORDER(^TMP($JOB,"RA7",RALNM))
- if RALNM=""!(RAX["^")
- QUIT
- DO NEG
- if '$GET(RANEG)
- DO GET
- KILL RANEG
- +22 GOTO Q
- GET SET (RALIEN,RA5)=""
- FOR
- SET RALIEN=$ORDER(^TMP($JOB,"RA7",RALNM,RALIEN))
- if 'RALIEN!(RAX["^")
- QUIT
- IF $DATA(RALOC1(RALIEN))
- DO HD
- FOR
- SET RA5=$ORDER(^TMP($JOB,"RA7",RALNM,RALIEN,RA5))
- if (RA5="")!(RAX["^")
- QUIT
- if (RAPGE)&($EXTRACT(RASORT)="P")
- WRITE !,RALNE1
- Begin DoDot:1
- +1 SET RA6=""
- FOR
- SET RA6=$ORDER(^TMP($JOB,"RA7",RALNM,RALIEN,RA5,RA6))
- if RA6=""!(RAX["^")
- QUIT
- SET RA7=""
- FOR
- SET RA7=$ORDER(^TMP($JOB,"RA7",RALNM,RALIEN,RA5,RA6,RA7))
- if (RA7="")!(RAX["^")
- QUIT
- Begin DoDot:2
- +2 SET RAMIS=""
- FOR
- SET RAMIS=$ORDER(^TMP($JOB,"RA7",RALNM,RALIEN,RA5,RA6,RA7,RAMIS))
- if RAMIS=""!(RAX["^")
- QUIT
- SET RADFN=0
- FOR
- SET RADFN=$ORDER(^TMP($JOB,"RA7",RALNM,RALIEN,RA5,RA6,RA7,RAMIS,RADFN))
- if RADFN=""!(RAX["^")
- QUIT
- Begin DoDot:3
- +3 SET RAOIFN=0
- FOR
- SET RAOIFN=$ORDER(^TMP($JOB,"RA7",RALNM,RALIEN,RA5,RA6,RA7,RAMIS,RADFN,RAOIFN))
- if 'RAOIFN!(RAX["^")
- QUIT
- SET RATIME=^(RAOIFN)
- SET RAORD0=$GET(^RAO(75.1,RAOIFN,0))
- DO GETDFN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +4 QUIT
- GETDFN if RAX["^"
- QUIT
- SET RANME=$PIECE($GET(^DPT(RADFN,0)),"^")
- SET RAOSCH=$SELECT($EXTRACT(RASORT)="P":RA6,1:RA5)_"."_RATIME
- SET RAOSCH=+RAOSCH
- SET X=$PIECE(RAORD0,U,5)
- SET RASTAT=$SELECT(X=3:"HOL",X=5:"PEN",X=8:"SCH",X=11:"UNR",1:"???")
- +1 IF $DATA(RANOSHOW)
- IF RASTAT'="SCH"
- QUIT
- +2 SET RALIEN=RAHI
- KILL RARLOC,RARLOCN,RARIPOP,RACIPOP,RAIPLOC,RAIPLOCN,RADONE
- +3 DO IPOP^RAUTL13
- DO WRT
- +4 QUIT
- WRT SET RAOURG=$PIECE(RAORD0,"^",6)
- +1 if ($Y+4)>IOSL!('RAPGE)!(RALIEN'=RAHI)
- DO HD
- if RAX["^"
- QUIT
- +2 WRITE !,$EXTRACT(RANME,1,12),?14,$$SSN^RAUTL(RADFN,1),?21,$SELECT($EXTRACT(RASORT)="P":RA5,1:RA7),?44,$EXTRACT(RALOCN,1,10),?56,$$FMTE^XLFDT(RAOSCH,2)
- +3 SET C=$PIECE(^DD(75.1,6,0),U,2)
- SET Y=RAOURG
- DO Y^DIQ
- WRITE ?71,$EXTRACT(Y,1,7),!
- +4 IF $LENGTH($GET(RARLOCN))
- WRITE ?28,"Requesting Loc: ",RARLOCN
- +5 QUIT
- NEG ;Negative reporting
- +1 if $GET(RAX)["^"
- QUIT
- KILL RANEG
- +2 IF RALNM="UNKNOWN"
- QUIT
- +3 IF $GET(^TMP($JOB,"RA7",RALNM))="NONE"
- SET RANEG=1
- DO HD
- if $GET(RAX)["^"
- QUIT
- WRITE !!," No scheduled requests are logged for ",RALDTE1," through ",RALDTE2,"."
- +4 QUIT
- Q KILL ^TMP($JOB,"RA7"),%DT,C,DIR,DTOUT,DUOUT,I,IOP,POP,RABEGDT,RACIPOP,RADAY,RADFN,RADLOCS,RADPT0,RAENDDT,RAHI,RAI,RAIN44,RAIPLOC,RAIPLOCN,RAIPOP
- +1 KILL 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
- +2 KILL 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
- +3 WRITE !
- DO CLOSE^RAUTL
- +4 KILL DDH,DIRUT,DISYS,DFN
- +5 QUIT
- +6 ;
- HD DO CRCHK
- if RAX["^"
- QUIT
- if RAPGE!($EXTRACT(IOST,1,2)="C-")
- WRITE @IOF
- WRITE !,"Scheduled Request Log by Imaging Location, ",RASORT
- SET RAPGE=RAPGE+1
- +1 WRITE ?70,"Page: ",RAPGE,!?5,"Includes requests scheduled from ",RALDTE1," to ",RALDTE2
- +2 ;$S($D(^SC(+$P($G(^RA(79.1,+RALIEN,0)),"^"),0)):$P(^(0),"^"),1:"UNKNOWN")
- WRITE !,"Run Date: ",RARUNDTE,?31,"Imaging Location: ",RALNM
- +3 WRITE !?5,$SELECT($DATA(RANOSHOW):"(no-show's only) ",1:"")
- +4 WRITE !,"Patient",?14,"Pt ID",?22,"Procedure",?44,"Pt Loc",?56,"Sched. Date",?71,"Urgency",!,RALNE
- +5 SET RAHI=RALIEN
- QUIT
- +6 ;
- CRCHK IF RAPGE
- IF $EXTRACT(IOST)="C"
- WRITE !!,$CHAR(7),"Press RETURN to continue or '^' to stop "
- READ X:DTIME
- SET RAX=X
- +1 QUIT