RADLQ1 ;HISC/GJC AISC/MJK,RMO-Delq Status/Incomplete Rpt's ;30 Mar 2018 1:20 PM
;;5.0;Radiology/Nuclear Medicine;**15,97,47,137,124**;Mar 16, 1998;Build 4
;'RALL' will be defined in the entry action of RA INCOMPLETE
I $D(DUZ),($O(RACCESS(DUZ,""))']"") D CHECK^RADLQ3(DUZ)
S X=$$DIVLOC^RAUTL7() K ^TMP($J,"RADLQ")
I X K:$D(RAPSTX) RAPSTX K RAQUIT,X,I,POP Q ; Selection process aborted.
S INVMAXDT=9999999.9999,RAXIT=0
S RAHD(0)=$S($D(RALL):"Incomplete Exam",1:"Delinquent Status")
S RAHD(0)=RAHD(0)_" Report" W @IOF,!?(IOM-$L(RAHD(0))\2),RAHD(0)
D DISPXAM^RADLQ3 ; Display xam statuses
I RAXIT D EXIT^RADLQ3 Q
DEV D DATE^RAUTL I RAPOP D EXIT^RADLQ3 Q ; Quit if device not selected
S RABEG=INVMAXDT-ENDDATE,RAEND=INVMAXDT-BEGDATE K DIR,X,Y
S DIR(0)="SO^I:INPATIENT;O:OUTPATIENT;B:BOTH"
S DIR("?",1)="This report can be broken out by"
S DIR("?")="Outpatient, Inpatient, or Both."
S DIR("A")="Report to include" D ^DIR K DIR
I $D(DIRUT) D EXIT^RADLQ3 Q
S RASORT1=Y
W !!?5,"Now that you have selected ",Y(0)
W " do you want to sort by",!?5,"Patient or Date ?" K X,Y
S DIR(0)="SO^P:PATIENT;D:DATE"
S DIR("?",1)="This allows you the flexibility to further"
S DIR("?")="sort the report by Patient or Date." D ^DIR K DIR
I $D(DIRUT) D EXIT^RADLQ3 Q
S RASORT2=Y D ZEROUT^RADLQ3("RADLQ")
I '$D(^TMP($J,"RADLQ")) D EXIT^RADLQ3 Q
K RACCESS(DUZ,"DIV-IMG") W !
S ZTRTN="START^RADLQ1" S:$D(RALL) ZTSAVE("RALL")=""
F RASV="RAHD(","RACRT(","RABEG","RAEND","RASORT1","RASORT2","INVMAXDT","RAXIT","RADIVNM","RAMDIV" D
. S ZTSAVE(RASV)=""
. Q
S ZTSAVE("^TMP($J,""RA D-TYPE"",")=""
S ZTSAVE("^TMP($J,""RADLQ"",")=""
S ZTSAVE("^TMP($J,""RA I-TYPE"",")=""
D ZIS^RAUTL I RAPOP D EXIT^RADLQ3 Q
START ; start processing here
U IO S $P(RALN1,"-",(IOM+1))=""
S:$D(ZTQUEUED) ZTREQ="@"
S $P(RALN2,"=",(IOM+1))="",(RAPG,RASTI)=0
F S RASTI=$O(^RADPT("AS",RASTI)) Q:'RASTI D Q:RAXIT
. D RADFN:$S($D(RALL):1,$D(RACRT(RASTI)):1,1:0)
. Q
K RADIV("I") D:'RAXIT PRINT^RADLQ2
I 'RAXIT D
. S RADIVNM=$$DIVTOT^RACMP("RADLQ") Q:'RADIVNM
. S RAXIT=$$EOS^RAUTL5() Q:RAXIT S RAFLAG="" D HDR^RADLQ2
. D:'RAXIT LIST^RADLQ3
. Q
; is RAXIT set to one? If yes, skip $$EOS call /p124/
S:RAXIT=0 RAXIT=$$EOS^RAUTL5() ;cause screen pause for user
;
D EXIT^RADLQ3
Q
RADFN ; $ order through rad patients ien's
S RADFN=0
F S RADFN=$O(^RADPT("AS",RASTI,RADFN)) Q:'RADFN D Q:RAXIT
. F RADTI=RABEG-1:0 S RADTI=$O(^RADPT("AS",RASTI,RADFN,RADTI)) Q:'RADTI!(RADTI>RAEND) D Q:RAXIT
.. S RADTE=INVMAXDT-RADTI D RACNI
.. Q
. Q
Q
RACNI ; $ order through case #
S RACNI=0
F S RACNI=$O(^RADPT("AS",RASTI,RADFN,RADTI,RACNI)) Q:'RACNI D SORT Q:RAXIT
Q
SORT ; sort logic
S RAREGEX(0)=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:RAREGEX(0)']""
S RADIV("I")=+$P(RAREGEX(0),"^",3) Q:RADIV("I")=0
S RADIV("I")=$S($D(^RA(79,RADIV("I"),0)):$P(^(0),"^"),1:0)
S RADIV=$S($D(^DIC(4,RADIV("I"),0)):$P(^(0),"^"),1:0)
Q:'$D(^TMP($J,"RA D-TYPE",RADIV))
S RADIV=RADIV("I"),RAPAT(0)=$G(^DPT(RADFN,0))
S RANME=$S($P(RAPAT(0),"^")]"":$P(RAPAT(0),"^"),1:"Unknown")
S RASSN=$$SSN^RAUTL
S RAEXAM(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RAEXAM(0)']""
S RAIPHY="Unknown"
S:$P(RAEXAM(0),"^",15)]"" RAIPHY=$P($G(^VA(200,+$P(RAEXAM(0),"^",15),0)),"^")
S:$P(RAEXAM(0),"^",12)]""&(RAIPHY="Unknown") RAIPHY=$P($G(^VA(200,+$P(RAEXAM(0),"^",12),0)),"^")
K RATECH S RATD4=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0))
I RATD4 D ; Obtain the first 'tech' encountered
. S RATECH=$E($$GET1^DIQ(200,+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RATD4,0))_",",.01),1,15)
. Q
K RATD4 S:'$L($G(RATECH)) RATECH="Unknown"
S RACN=+$P(RAEXAM(0),"^"),RAPRC=+$P(RAEXAM(0),"^",2)
S RAPRC=$S($D(^RAMIS(71,RAPRC,0)):$P(^(0),"^"),1:"Unknown")
S RAST=+$P(RAEXAM(0),"^",3),RADT=$P(RADTE,".")
S RAITYPE("I")=$S($D(^RA(72,RAST,0)):+$P(^(0),"^",7),1:0)
S RAITYPE=$S($D(^RA(79.2,RAITYPE("I"),0)):$P(^(0),"^"),1:"Unknown")
Q:'$D(^TMP($J,"RA I-TYPE",RAITYPE))
S:'$D(^RA(72,RAST,0)) RAST="Unknown"
S:$D(^RA(72,RAST,0)) RAST=$P(^(0),"^")
S RADT=$E(RADT,4,5)_"/"_$E(RADT,6,7)_"/"_$E(RADT,2,3)
; 6th piece: Ward Location <-> 8th piece: Principal Clinic
; 9th piece: Contact/Sharing Source <-> 17th piece: Report Text
F RA=6,8,9,17 S RA(RA)=+$P(RAEXAM(0),"^",RA)
S RA("R")=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"R"))
S RAWHE=$S($D(^DIC(42,RA(6),0)):$P(^(0),"^"),$D(^SC(RA(8),0)):$P(^(0),"^"),$D(^DIC(34,RA(9),0)):$P(^(0),"^"),RA("R")]"":RA("R"),1:"Unknown")
S RAVAR=$S($D(^DIC(42,RA(6),0)):"I",1:"O")
Q:RASORT1'="B"&(RASORT1'=RAVAR)
S RARP=$S(+$O(^RARPT(RA(17),"R",0)):"Yes",+$O(^RARPT(RA(17),"I",0)):"Yes",1:"No")
S RAVRFIED=$P($G(^RARPT(RA(17),0)),U,5) S RAVRFIED=$S(RAVRFIED="D":"Draft",RAVRFIED="R":"Released",RAVRFIED="PD":"Prb Drft",RAVRFIED="V":"Verified",RAVRFIED="EF":"Elec. F.",1:"No Rpt")
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
;S ^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,$S(RASORT2="P":RANME,1:$P(RADTE,".")),$S(RASORT2="P":$P(RADTE,"."),1:RANME),RACN)=RACN_"^"_RAPRC_"^"_RAST_"^"_RADT_"^"_RAWHE_"^"_RARP_"^"_RASSN_"^"_RAVRFIED_"^"_RAIPHY_"^"_RATECH
N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
I ($O(^RARPT(RA(17),2005,0))) S RACN=RACN_" i" I RASSAN]"" S RASSAN=RASSAN_"i" ;Images captured indicator -P137/KLM
S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACN)
I $$USESSAN^RAHLRU1() D
.S ^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,$S(RASORT2="P":RANME,1:$P(RADTE,".")),$S(RASORT2="P":$P(RADTE,"."),1:RANME),RACN)=RACNDSP_"^"_RAPRC_"^"_RAST_"^"_RADT_"^"_RAWHE_"^"_RARP_"^"_RASSN_"^"_RAVRFIED_"^"_RAIPHY_"^"_RATECH
I '$$USESSAN^RAHLRU1() D
.S ^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,$S(RASORT2="P":RANME,1:$P(RADTE,".")),$S(RASORT2="P":$P(RADTE,"."),1:RANME),RACN)=RACN_"^"_RAPRC_"^"_RAST_"^"_RADT_"^"_RAWHE_"^"_RARP_"^"_RASSN_"^"_RAVRFIED_"^"_RAIPHY_"^"_RATECH
S ^TMP($J,"RADLQ")=+$G(^TMP($J,"RADLQ"))+1
S ^TMP($J,"RADLQ",RADIV)=+$G(^TMP($J,"RADLQ",RADIV))+1
S ^TMP($J,"RADLQ",RADIV,RAITYPE)=+$G(^TMP($J,"RADLQ",RADIV,RAITYPE))+1
S ^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR)=+$G(^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR))+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRADLQ1 6152 printed Dec 13, 2024@02:34:44 Page 2
RADLQ1 ;HISC/GJC AISC/MJK,RMO-Delq Status/Incomplete Rpt's ;30 Mar 2018 1:20 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**15,97,47,137,124**;Mar 16, 1998;Build 4
+2 ;'RALL' will be defined in the entry action of RA INCOMPLETE
+3 IF $DATA(DUZ)
IF ($ORDER(RACCESS(DUZ,""))']"")
DO CHECK^RADLQ3(DUZ)
+4 SET X=$$DIVLOC^RAUTL7()
KILL ^TMP($JOB,"RADLQ")
+5 ; Selection process aborted.
IF X
if $DATA(RAPSTX)
KILL RAPSTX
KILL RAQUIT,X,I,POP
QUIT
+6 SET INVMAXDT=9999999.9999
SET RAXIT=0
+7 SET RAHD(0)=$SELECT($DATA(RALL):"Incomplete Exam",1:"Delinquent Status")
+8 SET RAHD(0)=RAHD(0)_" Report"
WRITE @IOF,!?(IOM-$LENGTH(RAHD(0))\2),RAHD(0)
+9 ; Display xam statuses
DO DISPXAM^RADLQ3
+10 IF RAXIT
DO EXIT^RADLQ3
QUIT
DEV ; Quit if device not selected
DO DATE^RAUTL
IF RAPOP
DO EXIT^RADLQ3
QUIT
+1 SET RABEG=INVMAXDT-ENDDATE
SET RAEND=INVMAXDT-BEGDATE
KILL DIR,X,Y
+2 SET DIR(0)="SO^I:INPATIENT;O:OUTPATIENT;B:BOTH"
+3 SET DIR("?",1)="This report can be broken out by"
+4 SET DIR("?")="Outpatient, Inpatient, or Both."
+5 SET DIR("A")="Report to include"
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
DO EXIT^RADLQ3
QUIT
+7 SET RASORT1=Y
+8 WRITE !!?5,"Now that you have selected ",Y(0)
+9 WRITE " do you want to sort by",!?5,"Patient or Date ?"
KILL X,Y
+10 SET DIR(0)="SO^P:PATIENT;D:DATE"
+11 SET DIR("?",1)="This allows you the flexibility to further"
+12 SET DIR("?")="sort the report by Patient or Date."
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
DO EXIT^RADLQ3
QUIT
+14 SET RASORT2=Y
DO ZEROUT^RADLQ3("RADLQ")
+15 IF '$DATA(^TMP($JOB,"RADLQ"))
DO EXIT^RADLQ3
QUIT
+16 KILL RACCESS(DUZ,"DIV-IMG")
WRITE !
+17 SET ZTRTN="START^RADLQ1"
if $DATA(RALL)
SET ZTSAVE("RALL")=""
+18 FOR RASV="RAHD(","RACRT(","RABEG","RAEND","RASORT1","RASORT2","INVMAXDT","RAXIT","RADIVNM","RAMDIV"
Begin DoDot:1
+19 SET ZTSAVE(RASV)=""
+20 QUIT
End DoDot:1
+21 SET ZTSAVE("^TMP($J,""RA D-TYPE"",")=""
+22 SET ZTSAVE("^TMP($J,""RADLQ"",")=""
+23 SET ZTSAVE("^TMP($J,""RA I-TYPE"",")=""
+24 DO ZIS^RAUTL
IF RAPOP
DO EXIT^RADLQ3
QUIT
START ; start processing here
+1 USE IO
SET $PIECE(RALN1,"-",(IOM+1))=""
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 SET $PIECE(RALN2,"=",(IOM+1))=""
SET (RAPG,RASTI)=0
+4 FOR
SET RASTI=$ORDER(^RADPT("AS",RASTI))
if 'RASTI
QUIT
Begin DoDot:1
+5 if $SELECT($DATA(RALL):1,$DATA(RACRT(RASTI)):1,1:0)
DO RADFN
+6 QUIT
End DoDot:1
if RAXIT
QUIT
+7 KILL RADIV("I")
if 'RAXIT
DO PRINT^RADLQ2
+8 IF 'RAXIT
Begin DoDot:1
+9 SET RADIVNM=$$DIVTOT^RACMP("RADLQ")
if 'RADIVNM
QUIT
+10 SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
SET RAFLAG=""
DO HDR^RADLQ2
+11 if 'RAXIT
DO LIST^RADLQ3
+12 QUIT
End DoDot:1
+13 ; is RAXIT set to one? If yes, skip $$EOS call /p124/
+14 ;cause screen pause for user
if RAXIT=0
SET RAXIT=$$EOS^RAUTL5()
+15 ;
+16 DO EXIT^RADLQ3
+17 QUIT
RADFN ; $ order through rad patients ien's
+1 SET RADFN=0
+2 FOR
SET RADFN=$ORDER(^RADPT("AS",RASTI,RADFN))
if 'RADFN
QUIT
Begin DoDot:1
+3 FOR RADTI=RABEG-1:0
SET RADTI=$ORDER(^RADPT("AS",RASTI,RADFN,RADTI))
if 'RADTI!(RADTI>RAEND)
QUIT
Begin DoDot:2
+4 SET RADTE=INVMAXDT-RADTI
DO RACNI
+5 QUIT
End DoDot:2
if RAXIT
QUIT
+6 QUIT
End DoDot:1
if RAXIT
QUIT
+7 QUIT
RACNI ; $ order through case #
+1 SET RACNI=0
+2 FOR
SET RACNI=$ORDER(^RADPT("AS",RASTI,RADFN,RADTI,RACNI))
if 'RACNI
QUIT
DO SORT
if RAXIT
QUIT
+3 QUIT
SORT ; sort logic
+1 SET RAREGEX(0)=$GET(^RADPT(RADFN,"DT",RADTI,0))
if RAREGEX(0)']""
QUIT
+2 SET RADIV("I")=+$PIECE(RAREGEX(0),"^",3)
if RADIV("I")=0
QUIT
+3 SET RADIV("I")=$SELECT($DATA(^RA(79,RADIV("I"),0)):$PIECE(^(0),"^"),1:0)
+4 SET RADIV=$SELECT($DATA(^DIC(4,RADIV("I"),0)):$PIECE(^(0),"^"),1:0)
+5 if '$DATA(^TMP($JOB,"RA D-TYPE",RADIV))
QUIT
+6 SET RADIV=RADIV("I")
SET RAPAT(0)=$GET(^DPT(RADFN,0))
+7 SET RANME=$SELECT($PIECE(RAPAT(0),"^")]"":$PIECE(RAPAT(0),"^"),1:"Unknown")
+8 SET RASSN=$$SSN^RAUTL
+9 SET RAEXAM(0)=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
if RAEXAM(0)']""
QUIT
+10 SET RAIPHY="Unknown"
+11 if $PIECE(RAEXAM(0),"^",15)]""
SET RAIPHY=$PIECE($GET(^VA(200,+$PIECE(RAEXAM(0),"^",15),0)),"^")
+12 if $PIECE(RAEXAM(0),"^",12)]""&(RAIPHY="Unknown")
SET RAIPHY=$PIECE($GET(^VA(200,+$PIECE(RAEXAM(0),"^",12),0)),"^")
+13 KILL RATECH
SET RATD4=+$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0))
+14 ; Obtain the first 'tech' encountered
IF RATD4
Begin DoDot:1
+15 SET RATECH=$EXTRACT($$GET1^DIQ(200,+$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RATD4,0))_",",.01),1,15)
+16 QUIT
End DoDot:1
+17 KILL RATD4
if '$LENGTH($GET(RATECH))
SET RATECH="Unknown"
+18 SET RACN=+$PIECE(RAEXAM(0),"^")
SET RAPRC=+$PIECE(RAEXAM(0),"^",2)
+19 SET RAPRC=$SELECT($DATA(^RAMIS(71,RAPRC,0)):$PIECE(^(0),"^"),1:"Unknown")
+20 SET RAST=+$PIECE(RAEXAM(0),"^",3)
SET RADT=$PIECE(RADTE,".")
+21 SET RAITYPE("I")=$SELECT($DATA(^RA(72,RAST,0)):+$PIECE(^(0),"^",7),1:0)
+22 SET RAITYPE=$SELECT($DATA(^RA(79.2,RAITYPE("I"),0)):$PIECE(^(0),"^"),1:"Unknown")
+23 if '$DATA(^TMP($JOB,"RA I-TYPE",RAITYPE))
QUIT
+24 if '$DATA(^RA(72,RAST,0))
SET RAST="Unknown"
+25 if $DATA(^RA(72,RAST,0))
SET RAST=$PIECE(^(0),"^")
+26 SET RADT=$EXTRACT(RADT,4,5)_"/"_$EXTRACT(RADT,6,7)_"/"_$EXTRACT(RADT,2,3)
+27 ; 6th piece: Ward Location <-> 8th piece: Principal Clinic
+28 ; 9th piece: Contact/Sharing Source <-> 17th piece: Report Text
+29 FOR RA=6,8,9,17
SET RA(RA)=+$PIECE(RAEXAM(0),"^",RA)
+30 SET RA("R")=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"R"))
+31 SET RAWHE=$SELECT($DATA(^DIC(42,RA(6),0)):$PIECE(^(0),"^"),$DATA(^SC(RA(8),0)):$PIECE(^(0),"^"),$DATA(^DIC(34,RA(9),0)):$PIECE(^(0),"^"),RA("R")]"":RA("R"),1:"Unknown")
+32 SET RAVAR=$SELECT($DATA(^DIC(42,RA(6),0)):"I",1:"O")
+33 if RASORT1'="B"&(RASORT1'=RAVAR)
QUIT
+34 SET RARP=$SELECT(+$ORDER(^RARPT(RA(17),"R",0)):"Yes",+$ORDER(^RARPT(RA(17),"I",0)):"Yes",1:"No")
+35 SET RAVRFIED=$PIECE($GET(^RARPT(RA(17),0)),U,5)
SET RAVRFIED=$SELECT(RAVRFIED="D":"Draft",RAVRFIED="R":"Released",RAVRFIED="PD":"Prb Drft",RAVRFIED="V":"Verified",RAVRFIED="EF":"Elec. F.",1:"No Rpt")
+36 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
if RAXIT
QUIT
+37 ;S ^TMP($J,"RADLQ",RADIV,RAITYPE,RAVAR,$S(RASORT2="P":RANME,1:$P(RADTE,".")),$S(RASORT2="P":$P(RADTE,"."),1:RANME),RACN)=RACN_"^"_RAPRC_"^"_RAST_"^"_RADT_"^"_RAWHE_"^"_RARP_"^"_RASSN_"^"_RAVRFIED_"^"_RAIPHY_"^"_RATECH
+38 NEW RASSAN,RACNDSP
SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
+39 ;Images captured indicator -P137/KLM
IF ($ORDER(^RARPT(RA(17),2005,0)))
SET RACN=RACN_" i"
IF RASSAN]""
SET RASSAN=RASSAN_"i"
+40 SET RACNDSP=$SELECT((RASSAN'=""):RASSAN,1:RACN)
+41 IF $$USESSAN^RAHLRU1()
Begin DoDot:1
+42 SET ^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR,$SELECT(RASORT2="P":RANME,1:$PIECE(RADTE,".")),$SELECT(RASORT2="P":$PIECE(RADTE,"."),1:RANME),RACN)=RACNDSP_"^"_RAPRC_"^"_RAST_"^"_RADT_"^"_RAWHE_"^"_RARP_"^"_RASSN_"^"_RAVRFIED_"^"_RAIPHY_"^"_R
ATECH
End DoDot:1
+43 IF '$$USESSAN^RAHLRU1()
Begin DoDot:1
+44 SET ^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR,$SELECT(RASORT2="P":RANME,1:$PIECE(RADTE,".")),$SELECT(RASORT2="P":$PIECE(RADTE,"."),1:RANME),RACN)=RACN_"^"_RAPRC_"^"_RAST_"^"_RADT_"^"_RAWHE_"^"_RARP_"^"_RASSN_"^"_RAVRFIED_"^"_RAIPHY_"^"_RATE
CH
End DoDot:1
+45 SET ^TMP($JOB,"RADLQ")=+$GET(^TMP($JOB,"RADLQ"))+1
+46 SET ^TMP($JOB,"RADLQ",RADIV)=+$GET(^TMP($JOB,"RADLQ",RADIV))+1
+47 SET ^TMP($JOB,"RADLQ",RADIV,RAITYPE)=+$GET(^TMP($JOB,"RADLQ",RADIV,RAITYPE))+1
+48 SET ^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR)=+$GET(^TMP($JOB,"RADLQ",RADIV,RAITYPE,RAVAR))+1
+49 QUIT
