126 lines
5.1 KiB
Mathematica
126 lines
5.1 KiB
Mathematica
RADLY ;HISC/GJC AISC/MJK,RMO-Rad Daily Log Report ;7/17/97 12:35
|
|
;;5.0;Radiology/Nuclear Medicine;**15**;Mar 16, 1998
|
|
; setup raccess(duz,"LOC" raccess(duz,"DIV" raccess(duz,"IMG"
|
|
I $O(RACCESS(DUZ,""))="" S RAPSTX="" D SETVARS^RAPSET1(0)
|
|
; Check access and
|
|
; setup raccess(duz,"DIV-IMG","chicago (ws),"general radiology"
|
|
S RAXIT=$$SETUPDI^RAUTL7() G:RAXIT CLEAN
|
|
; Select Div
|
|
; setup ^tmp($j,"RA D-TYPE"
|
|
D SELDIV^RAUTL7
|
|
I '$D(^TMP($J,"RA D-TYPE"))!(RAQUIT) K RACCESS(DUZ,"DIV-IMG") S RAXIT=1 G CLEAN
|
|
; Set imaging types as allowed by division(s) picked
|
|
N X,X1,RACHK1 S X=0
|
|
; setup ^tmp($j,"DIV-IMG"
|
|
D SETUP^RAUTL7A
|
|
; setup ^tmp($j,"RA I-TYPE"
|
|
F S X=$O(^TMP($J,"DIV-IMG",X)) Q:X'=+X I $D(RACCESS(DUZ,"IMG",X)) S ^TMP($J,"RA I-TYPE",$P($G(^RA(79.2,+X,0)),U),X)=""
|
|
; Select Img Loc
|
|
; setup ^tmp($j,"DIV-ITYP-ILOC" ^tmp($j,"RA LOC-TYPE"
|
|
D SELLOC^RAUTL7
|
|
I '$D(^TMP($J,"RA LOC-TYPE"))!(RAQUIT) K RACESS(DUZ,"DIV-IMG"),^TMP($J,"DIV-ITYP-ILOC") S RAXIT=1
|
|
CLEAN K ^TMP($J,"DIV-IMG")
|
|
;
|
|
I RAXIT K RAXIT K:$D(RAPSTX) RACCESS,RAPSTX,I,POP,RAQUIT Q
|
|
; loop thru raccess(duz,"DIV-IMG" to setup ^tmp($j,"RADLY",
|
|
; matching on ^tmp($j,"RA D-TYPE" and ^tmp($j,"RA I-TYPE"
|
|
; use new code in rtn radly1, instead of rtn radlq3
|
|
D ZEROUT^RADLY1 K RACCESS(DUZ,"DIV-IMG") W !
|
|
ASKLOG ; Ask log date
|
|
W ! K %DT
|
|
S %DT="PATEX",%DT("A")="Select Log Date: "
|
|
S %DT("B")="T-1" D ^%DT K %DT
|
|
I Y<0 D KILL^RADLY1 Q
|
|
S RALDTI=Y\1 S RALDTX=$$FMTE^XLFDT(Y\1,1)
|
|
S ZTDESC="Rad/Nuc Med Daily Log Rpt"
|
|
S ZTRTN="START^RADLY",ZTSAVE("RALDT*")=""
|
|
S ZTSAVE("^TMP($J,""RADLY"",")="",ZTSAVE("^TMP($J,""RA D-TYPE"",")=""
|
|
S ZTSAVE("^TMP($J,""RA I-TYPE"",")=""
|
|
S ZTSAVE("^TMP($J,""RA LOC-TYPE"",")=""
|
|
D ZIS^RAUTL
|
|
I RAPOP D KILL^RADLY1 Q
|
|
START ; Start the process
|
|
U IO D NOW^%DTC
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
S RATDY=$$FMTE^XLFDT(%\1,1),(RAPG,RAXIT)=0
|
|
S $P(RALN,"-",(IOM+1))="",RAHEAD="Daily Log Report For: "_RALDTX
|
|
S RATAB(1)=$S(IOM=132:8,1:5),RATAB(2)=$S(IOM=132:25,1:8)
|
|
S RATAB(3)=$S(IOM=132:42,1:25),RATAB(4)=$S(IOM=132:52,1:32)
|
|
S RATAB(5)=$S(IOM=132:72,1:38),RATAB(6)=$S(IOM=132:95,1:43)
|
|
S RATAB(7)=$S(IOM=132:114,1:60),RATAB(8)=$S(IOM=132:122,1:62)
|
|
S RATAB(9)=$S(IOM=132:102,1:62)
|
|
;
|
|
F RADTE=RALDTI:0 S RADTE=$O(^RADPT("AR",RADTE)) Q:'RADTE D Q:RAXIT
|
|
. Q:RADTE>(RALDTI+.9999)
|
|
. F RADFN=0:0 S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:'RADFN D Q:RAXIT
|
|
.. S RADTI=9999999.9999-RADTE
|
|
.. D:$D(^RADPT(RADFN,"DT",RADTI,0)) SORT^RADLY1
|
|
.. Q
|
|
. Q
|
|
I RAXIT D CLOSE^RAUTL,KILL^RADLY1 Q
|
|
;
|
|
; eliminate "RADLY" nodes that are outside the user-selected img locs
|
|
N A,B,C S A=""
|
|
CLN1 S A=$O(^TMP($J,"RADLY",A)) G:A']"" PREP S B=""
|
|
CLN2 S B=$O(^TMP($J,"RADLY",A,B)) G:B']"" CLN1 S C=""
|
|
CLN3 S C=$O(^TMP($J,"RADLY",A,B,C)) G:C']"" CLN2
|
|
K:$O(^TMP($J,"RA LOC-TYPE",C,0))="" ^TMP($J,"RADLY",A,B,C)
|
|
K:$O(^TMP($J,"RA I-TYPE",B,0))="" ^TMP($J,"RADLY",A,B)
|
|
K:$O(^TMP($J,"RADLY",A,""))="" ^TMP($J,"RADLY",A)
|
|
G CLN3
|
|
PREP G:'$D(^TMP($J,"RADLY")) OUT
|
|
S X=+$O(^TMP($J,"RADLY","")),Y=$O(^TMP($J,"RADLY",X,""))
|
|
S RADIV=$P($G(^DIC(4,X,0)),"^"),RAITYPE=Y
|
|
S RAILOC=$O(^TMP($J,"RADLY",X,Y,""))
|
|
; save current values
|
|
S RADIV0=RADIV,RAITYPE0=RAITYPE,RAILOC0=RAILOC
|
|
D HD^RADLY1
|
|
I RAXIT D CLOSE^RAUTL,KILL^RADLY1 Q
|
|
I $D(^TMP($J,"RADLY")) D
|
|
. D PRINT^RADLY1 ; Print out data
|
|
. I 'RAXIT D
|
|
.. S RADIVNM=$$DIVTOT^RACMP("RADLY") Q:'RADIVNM
|
|
.. S (RADIV,RAFLG,RAITYPE)="",RAXIT=$$EOS^RAUTL5() D:'RAXIT HD^RADLY1
|
|
.. D:'RAXIT SYNOP
|
|
.. Q
|
|
. Q
|
|
OUT D CLOSE^RAUTL,KILL^RADLY1
|
|
Q
|
|
SET ; Set ^TMP global
|
|
S RAEX(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
|
|
S RACN=$P(RAEX(0),"^"),RAPRC=+$P(RAEX(0),"^",2)
|
|
S RAPRC=$G(^RAMIS(71,RAPRC,0)),RAST=+$P(RAEX(0),"^",3)
|
|
S RAPRC=$E($S(RAPRC]"":$P(RAPRC,"^"),1:"Unknown"),1,19)
|
|
S RAST=$G(^RA(72,RAST,0)),RA6=+$P(RAEX(0),"^",6)
|
|
S RA8=+$P(RAEX(0),"^",8),RA9=+$P(RAEX(0),"^",9)
|
|
S RAST=$E($S(RAST]"":$P(RAST,"^"),1:"Unknown"),1,20)
|
|
S X=RADTE D TIME^RAUTL1 S RATME=X
|
|
S:$D(^DIC(42,RA6,0)) RAWHE=$P(^DIC(42,RA6,0),"^")
|
|
S:$D(^SC(RA8,0)) RAWHE=$P(^SC(RA8,0),"^")
|
|
S:$D(^DIC(34,RA9,0)) RAWHE=$P(^DIC(34,RA9,0),"^")
|
|
S:$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"R")) RAWHE=$P(^("R"),"^")
|
|
S RAWHE=$E($S($G(RAWHE)]"":RAWHE,1:"Unknown"),1,20)
|
|
S RARPT=+$P(RAEX(0),"^",17)
|
|
S RARPT=$S($O(^RARPT(RARPT,"R",0)):"Yes",1:"No")
|
|
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
|
|
S ^TMP($J,"RADLY",RADIV)=+$G(^TMP($J,"RADLY",RADIV))+1
|
|
S ^TMP($J,"RADLY",RADIV,RAITYPE)=+$G(^TMP($J,"RADLY",RADIV,RAITYPE))+1
|
|
S ^TMP($J,"RADLY",RADIV,RAITYPE,RAILOC)=+$G(^TMP($J,"RADLY",RADIV,RAITYPE,RAILOC))+1
|
|
S RADIVTY=+$G(RADIVTY)+1
|
|
S ^TMP($J,"RADLY",RADIV,RAITYPE,RAILOC,RANME,RADTE,RACNI)=RACN_"^"_RAPRC_"^"_RAST_"^"_RATME_"^"_RAWHE_"^"_RARPT_"^"_RASSN
|
|
Q
|
|
SYNOP ; Synopsis of data presented to the user.
|
|
S A=""
|
|
W !?RATAB(2),"Division",!?RATAB(2)+3,"Imaging Type",!?RATAB(2)+6,"Imaging Location(s)",!
|
|
SYN1 S A=$O(^TMP($J,"RADLY",A)) Q:A']""
|
|
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HD^RADLY1 Q:RAXIT
|
|
W !!?RATAB(2),$P($G(^DIC(4,A,0)),"^") S B=""
|
|
SYN2 S B=$O(^TMP($J,"RADLY",A,B)) G:B']"" SYN1
|
|
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HD^RADLY1 Q:RAXIT
|
|
W !?RATAB(2)+3,B,!?RATAB(2)+6 S C=""
|
|
SYN3 S C=$O(^TMP($J,"RADLY",A,B,C)) G:C']"" SYN2
|
|
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HD^RADLY1 Q:RAXIT
|
|
W:$X>(IOM-30) !?RATAB(2)+6
|
|
W C,?($X+3)
|
|
G SYN3
|