RACMP ;HISC/GJC AISC/MJK-Complication Report (Part 1 of 3) ;4/16/96 09:47
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
; Select Imaging Type, if exists
I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
N RACMP S RACMP=+$O(^RA(78.1,"B","NO COMPLICATION",0))
I 'RACMP D Q
. W !,"You need to define 'NO COMPLICATION' in your Complication "
. W "Types file",!,"in order to run this report!"
. Q
S X=$$DIVLOC^RAUTL7() I X D KILL Q
S A="" F S A=$O(RACCESS(DUZ,"DIV-IMG",A)) Q:A']"" D
. Q:'$D(^TMP($J,"RA D-TYPE",A)) S B=0
. F S B=+$O(^TMP($J,"RA D-TYPE",A,B)) Q:'B D
.. S ^TMP($J,"RACMP",B)=0
.. S C="" F S C=$O(RACCESS(DUZ,"DIV-IMG",A,C)) Q:C']"" D
... Q:'$D(^TMP($J,"RA I-TYPE",C)) S ^TMP($J,"RACMP",B,C)=0
... Q
.. Q
. Q
ASKLOG ; Ask date range
K A,B,C,^TMP($J,"DIV-IMG") W !
D DATE^RAUTL I RAPOP D KILL Q
S RADTBEGI=BEGDATE,RADTENDI=ENDDATE
S RADTBEG=BEGDATE-.0001,RADTEND=ENDDATE+.9999
K BEGDATE,ENDDATE
S Y=RADTBEGI X ^DD("DD") S RADTBEGX=Y
S Y=RADTENDI X ^DD("DD") S RADTENDX=Y
S ZTDESC="Rad/Nuc Med Complications Report"
S ZTRTN="START^RACMP",ZTSAVE("RACMP")=""
S ZTSAVE("RADT*")="",ZTSAVE("^TMP($J,""RACMP"",")=""
S ZTSAVE("^TMP($J,""RA D-TYPE"",")=""
S ZTSAVE("^TMP($J,""RA I-TYPE"",")="" D ZIS^RAUTL
I RAPOP D KILL Q
START ; Start processing data
U IO D NOW^%DTC S (RAPG,RAXIT)=0
S:$D(ZTQUEUED) ZTREQ="@"
S RATDY=$$FMTE^XLFDT(%\1,1),$P(RALN,"-",(IOM+1))=""
S RAERR="No Data Captured For This Time Frame."
S RAHDR(1)=">>> Complications Report <<<"
S RAHDR(2)="Period: "_RADTBEGX_" to "_RADTENDX_"."
S RATAB(1)=$S(IOM=132:15,1:9),RATAB(2)=$S(IOM=132:24,1:26)
S RATAB(3)=$S(IOM=132:40,1:34),RATAB(4)=$S(IOM=132:52,1:49)
S RATAB(5)=$S(IOM=132:90,1:52),RATAB(6)=$S(IOM=132:102,1:62)
F RADTE=RADTBEG:0 S RADTE=$O(^RADPT("AR",RADTE)) Q:'RADTE!(RADTE>RADTEND) D Q:RAXIT
. S RADFN=0 F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:'RADFN D Q:RAXIT
.. S RADTI=9999999.9999-RADTE D SORT^RACMP2
.. Q
. Q
I RAXIT D CLOSE^RAUTL,KILL Q
S X=$O(^TMP($J,"RACMP",""))
I X="" S Y=X
E S Y=$O(^TMP($J,"RACMP",X,""))
S RADIV=X,RAITYPE=Y D HEADER^RACMP2
I $D(^TMP($J,"RACMP")) D
. D PRINT^RACMP1
. I 'RAXIT D
.. S RADIVNM=$$DIVTOT("RACMP") Q:'RADIVNM
.. S (RADIV,RAFLG,RAITYPE)="",RAXIT=$$EOS^RAUTL5()
.. I 'RAXIT D HEADER^RACMP2,SYNOP^RACMP2
.. Q
. Q
D CLOSE^RAUTL,KILL
Q
KILL ; Kill and quit
K %,%I,RA0,RA1,RA10,RA2,RA3,RA4,RA5,RA7,RACCESS(DUZ,"DIV-IMG"),RACMPTX
K RACNI,RACOMP,RADFN,RADIV,RADIVNM,RADTBEG,RADTBEGI,RADTBEGX,RADTE
K RADTEND,RADTENDI,RADTENDX,RADTI,RAERR,RAEX,RAFLG,RAHDR,RAITYPE,RALN
K RANME,RAPG,RAPHY,RAPOP,RAPRC,RARE,RARES,RASSN,RASTF,RATAB,RATDY,RATME
K RAQUIT,RAXIT,X,Y,ZTDESC,ZTRTN,ZTSAVE
K ^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE"),^TMP($J,"RACMP")
K ^TMP($J,"RACMRE"),^TMP($J,"RACNTU"),^TMP($J,"RACOMP")
K ^TMP($J,"RAEXAM")
K:$D(RAPSTX) RACCESS,RAPSTX
K %DT,BEGDATE,I,POP,RAMES
Q
SET ; Set data global
S X=RADTE D TIME^RAUTL1 S RATME=X
S RAPRC=+$P(RAEX(0),"^",2),RAPRC=$G(^RAMIS(71,RAPRC,0))
S RAPRC=$S($P(RAPRC,"^")]"":$E($P(RAPRC,"^"),1,20),1:"Unknown")
S RARES=+$P(RAEX(0),"^",12),RARES=$G(^VA(200,RARES,0))
S RARES=$S($P(RARES,"^")]"":$E($P(RARES,"^"),1,20),1:"Unknown")
S RAPHY=+$P(RAEX(0),"^",14),RAPHY=$G(^VA(200,RAPHY,0))
S RAPHY=$S($P(RAPHY,"^")]"":$E($P(RAPHY,"^"),1,20),1:"Unknown")
S RASTF=+$P(RAEX(0),"^",15),RASTF=$G(^VA(200,RASTF,0))
S RASTF=$S($P(RASTF,"^")]"":$E($P(RASTF,"^"),1,20),1:"Unknown")
S RACMPTX=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP"))
S RACMPTX=$S(RACMPTX]"":RACMPTX,1:"None")
S ^TMP($J,"RACMP",RADIV,RAITYPE,RANME,RADTE,RACNI)=RAPRC_"^"_RATME_"^"_RAPHY_"^"_RARES_"^"_RASTF_"^"_RACMPTX_"^"_$P(RACOMP,"^")_"^"_RASSN_"^"_RADFN
Q
DIVTOT(Z) ; Check if more than one division is included in the report.
; Pass back '0' if just one division, '1' if more than one division.
N X,Y1,Y2 S X=0
S Y1=+$O(^TMP($J,Z,X)) Q:'Y1 0
S Y2=+$O(^TMP($J,Z,Y1)) Q:Y2 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRACMP 3993 printed Apr 09, 2024@21:39:33 Page 2
RACMP ;HISC/GJC AISC/MJK-Complication Report (Part 1 of 3) ;4/16/96 09:47
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 ; Select Imaging Type, if exists
+3 IF $ORDER(RACCESS(DUZ,""))=""
DO SETVARS^RAPSET1(0)
SET RAPSTX=""
+4 NEW RACMP
SET RACMP=+$ORDER(^RA(78.1,"B","NO COMPLICATION",0))
+5 IF 'RACMP
Begin DoDot:1
+6 WRITE !,"You need to define 'NO COMPLICATION' in your Complication "
+7 WRITE "Types file",!,"in order to run this report!"
+8 QUIT
End DoDot:1
QUIT
+9 SET X=$$DIVLOC^RAUTL7()
IF X
DO KILL
QUIT
+10 SET A=""
FOR
SET A=$ORDER(RACCESS(DUZ,"DIV-IMG",A))
if A']""
QUIT
Begin DoDot:1
+11 if '$DATA(^TMP($JOB,"RA D-TYPE",A))
QUIT
SET B=0
+12 FOR
SET B=+$ORDER(^TMP($JOB,"RA D-TYPE",A,B))
if 'B
QUIT
Begin DoDot:2
+13 SET ^TMP($JOB,"RACMP",B)=0
+14 SET C=""
FOR
SET C=$ORDER(RACCESS(DUZ,"DIV-IMG",A,C))
if C']""
QUIT
Begin DoDot:3
+15 if '$DATA(^TMP($JOB,"RA I-TYPE",C))
QUIT
SET ^TMP($JOB,"RACMP",B,C)=0
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
ASKLOG ; Ask date range
+1 KILL A,B,C,^TMP($JOB,"DIV-IMG")
WRITE !
+2 DO DATE^RAUTL
IF RAPOP
DO KILL
QUIT
+3 SET RADTBEGI=BEGDATE
SET RADTENDI=ENDDATE
+4 SET RADTBEG=BEGDATE-.0001
SET RADTEND=ENDDATE+.9999
+5 KILL BEGDATE,ENDDATE
+6 SET Y=RADTBEGI
XECUTE ^DD("DD")
SET RADTBEGX=Y
+7 SET Y=RADTENDI
XECUTE ^DD("DD")
SET RADTENDX=Y
+8 SET ZTDESC="Rad/Nuc Med Complications Report"
+9 SET ZTRTN="START^RACMP"
SET ZTSAVE("RACMP")=""
+10 SET ZTSAVE("RADT*")=""
SET ZTSAVE("^TMP($J,""RACMP"",")=""
+11 SET ZTSAVE("^TMP($J,""RA D-TYPE"",")=""
+12 SET ZTSAVE("^TMP($J,""RA I-TYPE"",")=""
DO ZIS^RAUTL
+13 IF RAPOP
DO KILL
QUIT
START ; Start processing data
+1 USE IO
DO NOW^%DTC
SET (RAPG,RAXIT)=0
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 SET RATDY=$$FMTE^XLFDT(%\1,1)
SET $PIECE(RALN,"-",(IOM+1))=""
+4 SET RAERR="No Data Captured For This Time Frame."
+5 SET RAHDR(1)=">>> Complications Report <<<"
+6 SET RAHDR(2)="Period: "_RADTBEGX_" to "_RADTENDX_"."
+7 SET RATAB(1)=$SELECT(IOM=132:15,1:9)
SET RATAB(2)=$SELECT(IOM=132:24,1:26)
+8 SET RATAB(3)=$SELECT(IOM=132:40,1:34)
SET RATAB(4)=$SELECT(IOM=132:52,1:49)
+9 SET RATAB(5)=$SELECT(IOM=132:90,1:52)
SET RATAB(6)=$SELECT(IOM=132:102,1:62)
+10 FOR RADTE=RADTBEG:0
SET RADTE=$ORDER(^RADPT("AR",RADTE))
if 'RADTE!(RADTE>RADTEND)
QUIT
Begin DoDot:1
+11 SET RADFN=0
FOR
SET RADFN=$ORDER(^RADPT("AR",RADTE,RADFN))
if 'RADFN
QUIT
Begin DoDot:2
+12 SET RADTI=9999999.9999-RADTE
DO SORT^RACMP2
+13 QUIT
End DoDot:2
if RAXIT
QUIT
+14 QUIT
End DoDot:1
if RAXIT
QUIT
+15 IF RAXIT
DO CLOSE^RAUTL
DO KILL
QUIT
+16 SET X=$ORDER(^TMP($JOB,"RACMP",""))
+17 IF X=""
SET Y=X
+18 IF '$TEST
SET Y=$ORDER(^TMP($JOB,"RACMP",X,""))
+19 SET RADIV=X
SET RAITYPE=Y
DO HEADER^RACMP2
+20 IF $DATA(^TMP($JOB,"RACMP"))
Begin DoDot:1
+21 DO PRINT^RACMP1
+22 IF 'RAXIT
Begin DoDot:2
+23 SET RADIVNM=$$DIVTOT("RACMP")
if 'RADIVNM
QUIT
+24 SET (RADIV,RAFLG,RAITYPE)=""
SET RAXIT=$$EOS^RAUTL5()
+25 IF 'RAXIT
DO HEADER^RACMP2
DO SYNOP^RACMP2
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 DO CLOSE^RAUTL
DO KILL
+29 QUIT
KILL ; Kill and quit
+1 KILL %,%I,RA0,RA1,RA10,RA2,RA3,RA4,RA5,RA7,RACCESS(DUZ,"DIV-IMG"),RACMPTX
+2 KILL RACNI,RACOMP,RADFN,RADIV,RADIVNM,RADTBEG,RADTBEGI,RADTBEGX,RADTE
+3 KILL RADTEND,RADTENDI,RADTENDX,RADTI,RAERR,RAEX,RAFLG,RAHDR,RAITYPE,RALN
+4 KILL RANME,RAPG,RAPHY,RAPOP,RAPRC,RARE,RARES,RASSN,RASTF,RATAB,RATDY,RATME
+5 KILL RAQUIT,RAXIT,X,Y,ZTDESC,ZTRTN,ZTSAVE
+6 KILL ^TMP($JOB,"RA D-TYPE"),^TMP($JOB,"RA I-TYPE"),^TMP($JOB,"RACMP")
+7 KILL ^TMP($JOB,"RACMRE"),^TMP($JOB,"RACNTU"),^TMP($JOB,"RACOMP")
+8 KILL ^TMP($JOB,"RAEXAM")
+9 if $DATA(RAPSTX)
KILL RACCESS,RAPSTX
+10 KILL %DT,BEGDATE,I,POP,RAMES
+11 QUIT
SET ; Set data global
+1 SET X=RADTE
DO TIME^RAUTL1
SET RATME=X
+2 SET RAPRC=+$PIECE(RAEX(0),"^",2)
SET RAPRC=$GET(^RAMIS(71,RAPRC,0))
+3 SET RAPRC=$SELECT($PIECE(RAPRC,"^")]"":$EXTRACT($PIECE(RAPRC,"^"),1,20),1:"Unknown")
+4 SET RARES=+$PIECE(RAEX(0),"^",12)
SET RARES=$GET(^VA(200,RARES,0))
+5 SET RARES=$SELECT($PIECE(RARES,"^")]"":$EXTRACT($PIECE(RARES,"^"),1,20),1:"Unknown")
+6 SET RAPHY=+$PIECE(RAEX(0),"^",14)
SET RAPHY=$GET(^VA(200,RAPHY,0))
+7 SET RAPHY=$SELECT($PIECE(RAPHY,"^")]"":$EXTRACT($PIECE(RAPHY,"^"),1,20),1:"Unknown")
+8 SET RASTF=+$PIECE(RAEX(0),"^",15)
SET RASTF=$GET(^VA(200,RASTF,0))
+9 SET RASTF=$SELECT($PIECE(RASTF,"^")]"":$EXTRACT($PIECE(RASTF,"^"),1,20),1:"Unknown")
+10 SET RACMPTX=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP"))
+11 SET RACMPTX=$SELECT(RACMPTX]"":RACMPTX,1:"None")
+12 SET ^TMP($JOB,"RACMP",RADIV,RAITYPE,RANME,RADTE,RACNI)=RAPRC_"^"_RATME_"^"_RAPHY_"^"_RARES_"^"_RASTF_"^"_RACMPTX_"^"_$PIECE(RACOMP,"^")_"^"_RASSN_"^"_RADFN
+13 QUIT
DIVTOT(Z) ; Check if more than one division is included in the report.
+1 ; Pass back '0' if just one division, '1' if more than one division.
+2 NEW X,Y1,Y2
SET X=0
+3 SET Y1=+$ORDER(^TMP($JOB,Z,X))
if 'Y1
QUIT 0
+4 SET Y2=+$ORDER(^TMP($JOB,Z,Y1))
if Y2
QUIT 1
+5 QUIT 0
