RAUTL16A ;HISC/DAD-EXAM STATUS IMAGING TYPE INCONSISTENCIES REPORT (FULL FILE SCAN) ;1/26/95 10:23
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
;
W !,"This report requires a 132 column output device."
K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTDESC="Rad/Nuc Med EXAM STATUS IMAGING TYPE INCONSISTENCIES REPORT"
. S ZTRTN="ENTSK^RAUTL16A" D ^%ZTLOAD
. Q
ENTSK ;
K ^TMP("RAUTL16",$J)
S RAD0=0
F S RAD0=$O(^RADPT(RAD0)) Q:RAD0'>0 D
. S RADFN=$P($G(^RADPT(RAD0,0)),U) Q:RADFN'>0
. S RAD1=0
. F S RAD1=$O(^RADPT(RAD0,"DT",RAD1)) Q:RAD1'>0 D
.. S RA=$G(^RADPT(RAD0,"DT",RAD1,0))
.. S RAEXAMDT=$P(RA,U),RAIMTYPE=$P(RA,U,2)
.. I RAEXAMDT'>0!(RAIMTYPE'>0) D MISSING
.. S RAD2=0
.. F S RAD2=$O(^RADPT(RAD0,"DT",RAD1,"P",RAD2)) Q:RAD2'>0 D
... S RA=$G(^RADPT(RAD0,"DT",RAD1,"P",RAD2,0))
... S RACASENO=$P(RA,U),RAEXAMST=$P(RA,U,3)
... I RACASENO'>0!(RAEXAMST'>0) D MISSING
... S RAIMEXAM=$P($G(^RA(72,+RAEXAMST,0)),U,7)
... I RAIMTYPE'=RAIMEXAM D SORT
... Q
.. Q
. Q
;
S RAEXIT=0,RAPAGE=1,RATODAY=$$FMTE^XLFDT($$DT^XLFDT)
K RAUNDL S $P(RAUNDL,"-",133)=""
U IO D HEADER
I $O(^TMP("RAUTL16",$J,""))="" D D PAUSE G EXIT
. W !!,"The imaging type of the visit matches the imaging type"
. W !,"of the exam status for all current incomplete exams."
. Q
S RADFN="",RAEXIT=0
F S RADFN=$O(^TMP("RAUTL16",$J,RADFN)) Q:RADFN=""!RAEXIT D
. S RASSN=""
. F S RASSN=$O(^TMP("RAUTL16",$J,RADFN,RASSN)) Q:RASSN=""!RAEXIT D
.. S RAEXAMDT=""
.. F S RAEXAMDT=$O(^TMP("RAUTL16",$J,RADFN,RASSN,RAEXAMDT)) Q:RAEXAMDT=""!RAEXIT D
... S RACASENO=""
... F S RACASENO=$O(^TMP("RAUTL16",$J,RADFN,RASSN,RAEXAMDT,RACASENO)) Q:RACASENO=""!RAEXIT D PRINT
... Q
.. Q
. Q
I 'RAEXIT D PAUSE
EXIT ;
S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC,KVA^VADPT
K %ZIS,DFN,DIR,DIROUT,DTOUT,DUOUT,POP,RA,RACASENO,RAD0,RAD1,RAD2,RADFN
K RAEXAMDT,RAEXAMST,RAEXIT,RAIMAGE,RAIMEXAM,RAIMTYPE,RAPAGE,RASSN
K RATODAY,RAUNDL,X,Y,ZTDESC,ZTRTN,^TMP("RAUTL16",$J)
Q
MISSING ;
S:$G(RAEXAMDT)'>0 RAEXAMDT="Missing"
S:$G(RAIMTYPE)'>0 RAIMTYPE="Missing"
S:$G(RACASENO)'>0 RACASENO="Missing"
S:$G(RAEXAMST)'>0 RAEXAMST="Missing"
S RAIMEXAM=$P($G(^RA(72,+RAEXAMST,0)),U,7)
SORT ;
D KVA^VADPT S DFN=RADFN D DEM^VADPT
S RADFN(0)=$G(VADM(1)),RA=$G(VADM(2)),RASSN=$P(RA,U),RASSN(0)=$P(RA,U,2)
S RAEXAMDT(0)=$$FMTE^XLFDT(RAEXAMDT)
S RAIMTYPE(0)=$P($G(^RA(79.2,+RAIMTYPE,0)),U) I RAIMTYPE(0)="" S RAIMTYPE(0)="Missing"
S RAEXAMST(0)=$P($G(^RA(72,+RAEXAMST,0)),U) I RAEXAMST(0)="" S RAEXAMST(0)="Missing"
S RAIMEXAM(0)=$P($G(^RA(79.2,+RAIMEXAM,0)),U) I RAIMEXAM(0)="" S RAIMEXAM(0)="Missing"
S ^TMP("RAUTL16",$J,RADFN(0),RASSN,RAEXAMDT,RACASENO)=RADFN(0)_U_RASSN(0)_U_RAEXAMDT(0)_U_RAIMTYPE(0)_U_RACASENO_U_RAEXAMST(0)_U_RAIMEXAM(0)_U_+$G(RAD0)_U_+$G(RAD1)_U_+$G(RAD2)
Q
PRINT ;
S RA=^TMP("RAUTL16",$J,RADFN,RASSN,RAEXAMDT,RACASENO)
S RADFN(0)=$P(RA,U),RASSN(0)=$P(RA,U,2),RAEXAMDT(0)=$P(RA,U,3)
S RAIMTYPE(0)=$P(RA,U,4),RACASENO(0)=$P(RA,U,5)
S RAEXAMST(0)=$P(RA,U,6),RAIMEXAM(0)=$P(RA,U,7)
S RAD0=$P(RA,U,8),RAD1=$P(RA,U,9),RAD2=$P(RA,U,10)
W !!,RADFN(0),?34,RASSN(0)
W !?3,RAEXAMDT(0),?25,$J(RACASENO(0),5),?34,RAIMTYPE(0)
W ?68,RAEXAMST(0),?102,RAIMEXAM(0)
I $Y>(IOSL-6) D PAUSE,HEADER
Q
PAUSE ;
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S RAEXIT=$S(Y'>0:1,1:0)
Q
Q:RAEXIT
W:$E(IOST)="C"!(RAPAGE>1) @IOF
W !?46,"EXAM STATUS IMAGING TYPE INCONSISTENCIES"
W ?102,"PAGE: ",RAPAGE,!?102,RATODAY S RAPAGE=RAPAGE+1
W !,"PATIENT",?34,"SSN"
W !?3,"EXAM DATE/TIME",?25,"CASE#",?34,"IMAGING TYPE OF VISIT"
W ?68,"EXAM STATUS",?102,"IMAGING TYPE OF EXAM STATUS",!,RAUNDL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAUTL16A 3717 printed Dec 13, 2024@02:40:16 Page 2
RAUTL16A ;HISC/DAD-EXAM STATUS IMAGING TYPE INCONSISTENCIES REPORT (FULL FILE SCAN) ;1/26/95 10:23
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 ;
+3 WRITE !,"This report requires a 132 column output device."
+4 KILL %ZIS,IOP
SET %ZIS="QM"
WRITE !
DO ^%ZIS
if POP
GOTO EXIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET ZTDESC="Rad/Nuc Med EXAM STATUS IMAGING TYPE INCONSISTENCIES REPORT"
+7 SET ZTRTN="ENTSK^RAUTL16A"
DO ^%ZTLOAD
+8 QUIT
End DoDot:1
GOTO EXIT
ENTSK ;
+1 KILL ^TMP("RAUTL16",$JOB)
+2 SET RAD0=0
+3 FOR
SET RAD0=$ORDER(^RADPT(RAD0))
if RAD0'>0
QUIT
Begin DoDot:1
+4 SET RADFN=$PIECE($GET(^RADPT(RAD0,0)),U)
if RADFN'>0
QUIT
+5 SET RAD1=0
+6 FOR
SET RAD1=$ORDER(^RADPT(RAD0,"DT",RAD1))
if RAD1'>0
QUIT
Begin DoDot:2
+7 SET RA=$GET(^RADPT(RAD0,"DT",RAD1,0))
+8 SET RAEXAMDT=$PIECE(RA,U)
SET RAIMTYPE=$PIECE(RA,U,2)
+9 IF RAEXAMDT'>0!(RAIMTYPE'>0)
DO MISSING
+10 SET RAD2=0
+11 FOR
SET RAD2=$ORDER(^RADPT(RAD0,"DT",RAD1,"P",RAD2))
if RAD2'>0
QUIT
Begin DoDot:3
+12 SET RA=$GET(^RADPT(RAD0,"DT",RAD1,"P",RAD2,0))
+13 SET RACASENO=$PIECE(RA,U)
SET RAEXAMST=$PIECE(RA,U,3)
+14 IF RACASENO'>0!(RAEXAMST'>0)
DO MISSING
+15 SET RAIMEXAM=$PIECE($GET(^RA(72,+RAEXAMST,0)),U,7)
+16 IF RAIMTYPE'=RAIMEXAM
DO SORT
+17 QUIT
End DoDot:3
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 ;
+21 SET RAEXIT=0
SET RAPAGE=1
SET RATODAY=$$FMTE^XLFDT($$DT^XLFDT)
+22 KILL RAUNDL
SET $PIECE(RAUNDL,"-",133)=""
+23 USE IO
DO HEADER
+24 IF $ORDER(^TMP("RAUTL16",$JOB,""))=""
Begin DoDot:1
+25 WRITE !!,"The imaging type of the visit matches the imaging type"
+26 WRITE !,"of the exam status for all current incomplete exams."
+27 QUIT
End DoDot:1
DO PAUSE
GOTO EXIT
+28 SET RADFN=""
SET RAEXIT=0
+29 FOR
SET RADFN=$ORDER(^TMP("RAUTL16",$JOB,RADFN))
if RADFN=""!RAEXIT
QUIT
Begin DoDot:1
+30 SET RASSN=""
+31 FOR
SET RASSN=$ORDER(^TMP("RAUTL16",$JOB,RADFN,RASSN))
if RASSN=""!RAEXIT
QUIT
Begin DoDot:2
+32 SET RAEXAMDT=""
+33 FOR
SET RAEXAMDT=$ORDER(^TMP("RAUTL16",$JOB,RADFN,RASSN,RAEXAMDT))
if RAEXAMDT=""!RAEXIT
QUIT
Begin DoDot:3
+34 SET RACASENO=""
+35 FOR
SET RACASENO=$ORDER(^TMP("RAUTL16",$JOB,RADFN,RASSN,RAEXAMDT,RACASENO))
if RACASENO=""!RAEXIT
QUIT
DO PRINT
+36 QUIT
End DoDot:3
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
+39 IF 'RAEXIT
DO PAUSE
EXIT ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
DO KVA^VADPT
+2 KILL %ZIS,DFN,DIR,DIROUT,DTOUT,DUOUT,POP,RA,RACASENO,RAD0,RAD1,RAD2,RADFN
+3 KILL RAEXAMDT,RAEXAMST,RAEXIT,RAIMAGE,RAIMEXAM,RAIMTYPE,RAPAGE,RASSN
+4 KILL RATODAY,RAUNDL,X,Y,ZTDESC,ZTRTN,^TMP("RAUTL16",$JOB)
+5 QUIT
MISSING ;
+1 if $GET(RAEXAMDT)'>0
SET RAEXAMDT="Missing"
+2 if $GET(RAIMTYPE)'>0
SET RAIMTYPE="Missing"
+3 if $GET(RACASENO)'>0
SET RACASENO="Missing"
+4 if $GET(RAEXAMST)'>0
SET RAEXAMST="Missing"
+5 SET RAIMEXAM=$PIECE($GET(^RA(72,+RAEXAMST,0)),U,7)
SORT ;
+1 DO KVA^VADPT
SET DFN=RADFN
DO DEM^VADPT
+2 SET RADFN(0)=$GET(VADM(1))
SET RA=$GET(VADM(2))
SET RASSN=$PIECE(RA,U)
SET RASSN(0)=$PIECE(RA,U,2)
+3 SET RAEXAMDT(0)=$$FMTE^XLFDT(RAEXAMDT)
+4 SET RAIMTYPE(0)=$PIECE($GET(^RA(79.2,+RAIMTYPE,0)),U)
IF RAIMTYPE(0)=""
SET RAIMTYPE(0)="Missing"
+5 SET RAEXAMST(0)=$PIECE($GET(^RA(72,+RAEXAMST,0)),U)
IF RAEXAMST(0)=""
SET RAEXAMST(0)="Missing"
+6 SET RAIMEXAM(0)=$PIECE($GET(^RA(79.2,+RAIMEXAM,0)),U)
IF RAIMEXAM(0)=""
SET RAIMEXAM(0)="Missing"
+7 SET ^TMP("RAUTL16",$JOB,RADFN(0),RASSN,RAEXAMDT,RACASENO)=RADFN(0)_U_RASSN(0)_U_RAEXAMDT(0)_U_RAIMTYPE(0)_U_RACASENO_U_RAEXAMST(0)_U_RAIMEXAM(0)_U_+$GET(RAD0)_U_+$GET(RAD1)_U_+$GET(RAD2)
+8 QUIT
PRINT ;
+1 SET RA=^TMP("RAUTL16",$JOB,RADFN,RASSN,RAEXAMDT,RACASENO)
+2 SET RADFN(0)=$PIECE(RA,U)
SET RASSN(0)=$PIECE(RA,U,2)
SET RAEXAMDT(0)=$PIECE(RA,U,3)
+3 SET RAIMTYPE(0)=$PIECE(RA,U,4)
SET RACASENO(0)=$PIECE(RA,U,5)
+4 SET RAEXAMST(0)=$PIECE(RA,U,6)
SET RAIMEXAM(0)=$PIECE(RA,U,7)
+5 SET RAD0=$PIECE(RA,U,8)
SET RAD1=$PIECE(RA,U,9)
SET RAD2=$PIECE(RA,U,10)
+6 WRITE !!,RADFN(0),?34,RASSN(0)
+7 WRITE !?3,RAEXAMDT(0),?25,$JUSTIFY(RACASENO(0),5),?34,RAIMTYPE(0)
+8 WRITE ?68,RAEXAMST(0),?102,RAIMEXAM(0)
+9 IF $Y>(IOSL-6)
DO PAUSE
DO HEADER
+10 QUIT
PAUSE ;
+1 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET RAEXIT=$SELECT(Y'>0:1,1:0)
+2 QUIT
+1 if RAEXIT
QUIT
+2 if $EXTRACT(IOST)="C"!(RAPAGE>1)
WRITE @IOF
+3 WRITE !?46,"EXAM STATUS IMAGING TYPE INCONSISTENCIES"
+4 WRITE ?102,"PAGE: ",RAPAGE,!?102,RATODAY
SET RAPAGE=RAPAGE+1
+5 WRITE !,"PATIENT",?34,"SSN"
+6 WRITE !?3,"EXAM DATE/TIME",?25,"CASE#",?34,"IMAGING TYPE OF VISIT"
+7 WRITE ?68,"EXAM STATUS",?102,"IMAGING TYPE OF EXAM STATUS",!,RAUNDL
+8 QUIT
