91 lines
3.5 KiB
Mathematica
91 lines
3.5 KiB
Mathematica
|
RAUTL16 ;HISC/DAD-EXAM STATUS IMAGING TYPE INCONSISTENCIES REPORT ;1/26/95 08:55
|
||
|
;;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^RAUTL16" D ^%ZTLOAD
|
||
|
. Q
|
||
|
ENTSK ;
|
||
|
K ^TMP("RAUTL16",$J)
|
||
|
S RAIMAGE=0
|
||
|
F S RAIMAGE=$O(^RADPT("AS",RAIMAGE)) Q:RAIMAGE'>0 D
|
||
|
. S RAD0=0
|
||
|
. F S RAD0=$O(^RADPT("AS",RAIMAGE,RAD0)) Q:RAD0'>0 D
|
||
|
.. S RADFN=$P($G(^RADPT(RAD0,0)),U) Q:RADFN'>0
|
||
|
.. S RAD1=0
|
||
|
.. F S RAD1=$O(^RADPT("AS",RAIMAGE,RAD0,RAD1)) Q:RAD1'>0 D
|
||
|
... S RA=$G(^RADPT(RAD0,"DT",RAD1,0))
|
||
|
... S RAEXAMDT=$P(RA,U),RAIMTYPE=$P(RA,U,2) Q:RAEXAMDT'>0!(RAIMTYPE'>0)
|
||
|
... S RAD2=0
|
||
|
... F S RAD2=$O(^RADPT("AS",RAIMAGE,RAD0,RAD1,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
|
||
|
. 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=0
|
||
|
.. F S RAEXAMDT=$O(^TMP("RAUTL16",$J,RADFN,RASSN,RAEXAMDT)) Q:RAEXAMDT'>0!RAEXIT D
|
||
|
... S RACASENO=0
|
||
|
... F S RACASENO=$O(^TMP("RAUTL16",$J,RADFN,RASSN,RAEXAMDT,RACASENO)) Q:RACASENO'>0!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),DIRUT
|
||
|
Q
|
||
|
MISSING ;
|
||
|
S:RACASENO'>0 RACASENO="Missing" S:RAEXAMST="" 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_RAD0_U_RAD1_U_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
|
||
|
HEADER ;
|
||
|
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
|