- 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 RADFN(0)=$G(VADM(1)),RA=$G(VA("PID")),RASSN=$P(RA,U),RASSN(0)=$P(RA,U) ;IHS/ITSC/CLS 09/25/2003 use HRCN
- 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
- 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 !,"PATIENT",?34,"HRCN" ;IHS/ITSC/CLS 09/25/2003
- W !?3,"EXAM DATE/TIME",?25,"CASE#",?34,"IMAGING TYPE OF VISIT"
- W ?68,"EXAM STATUS",?102,"IMAGING TYPE OF EXAM STATUS",!,RAUNDL
- Q
- RAUTL16 ;HISC/DAD-EXAM STATUS IMAGING TYPE INCONSISTENCIES REPORT ;1/26/95 08:55
- +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^RAUTL16"
- DO ^%ZTLOAD
- +8 QUIT
- End DoDot:1
- GOTO EXIT
- ENTSK ;
- +1 KILL ^TMP("RAUTL16",$JOB)
- +2 SET RAIMAGE=0
- +3 FOR
- SET RAIMAGE=$ORDER(^RADPT("AS",RAIMAGE))
- IF RAIMAGE'>0
- QUIT
- Begin DoDot:1
- +4 SET RAD0=0
- +5 FOR
- SET RAD0=$ORDER(^RADPT("AS",RAIMAGE,RAD0))
- IF RAD0'>0
- QUIT
- Begin DoDot:2
- +6 SET RADFN=$PIECE($GET(^RADPT(RAD0,0)),U)
- IF RADFN'>0
- QUIT
- +7 SET RAD1=0
- +8 FOR
- SET RAD1=$ORDER(^RADPT("AS",RAIMAGE,RAD0,RAD1))
- IF RAD1'>0
- QUIT
- Begin DoDot:3
- +9 SET RA=$GET(^RADPT(RAD0,"DT",RAD1,0))
- +10 SET RAEXAMDT=$PIECE(RA,U)
- SET RAIMTYPE=$PIECE(RA,U,2)
- IF RAEXAMDT'>0!(RAIMTYPE'>0)
- QUIT
- +11 SET RAD2=0
- +12 FOR
- SET RAD2=$ORDER(^RADPT("AS",RAIMAGE,RAD0,RAD1,RAD2))
- IF RAD2'>0
- QUIT
- Begin DoDot:4
- +13 SET RA=$GET(^RADPT(RAD0,"DT",RAD1,"P",RAD2,0))
- +14 SET RACASENO=$PIECE(RA,U)
- SET RAEXAMST=$PIECE(RA,U,3)
- 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:4
- +18 QUIT
- End DoDot:3
- +19 QUIT
- End DoDot:2
- +20 QUIT
- End DoDot:1
- +21 ;
- +22 SET RAEXIT=0
- SET RAPAGE=1
- SET RATODAY=$$FMTE^XLFDT($$DT^XLFDT)
- +23 KILL RAUNDL
- SET $PIECE(RAUNDL,"-",133)=""
- +24 USE IO
- DO HEADER
- +25 IF $ORDER(^TMP("RAUTL16",$JOB,""))=""
- Begin DoDot:1
- +26 WRITE !!,"The imaging type of the visit matches the imaging type"
- +27 WRITE !,"of the exam status for all current incomplete exams."
- +28 QUIT
- End DoDot:1
- DO PAUSE
- GOTO EXIT
- +29 SET RADFN=""
- SET RAEXIT=0
- +30 FOR
- SET RADFN=$ORDER(^TMP("RAUTL16",$JOB,RADFN))
- IF RADFN=""!RAEXIT
- QUIT
- Begin DoDot:1
- +31 SET RASSN=""
- +32 FOR
- SET RASSN=$ORDER(^TMP("RAUTL16",$JOB,RADFN,RASSN))
- IF RASSN=""!RAEXIT
- QUIT
- Begin DoDot:2
- +33 SET RAEXAMDT=0
- +34 FOR
- SET RAEXAMDT=$ORDER(^TMP("RAUTL16",$JOB,RADFN,RASSN,RAEXAMDT))
- IF RAEXAMDT'>0!RAEXIT
- QUIT
- Begin DoDot:3
- +35 SET RACASENO=0
- +36 FOR
- SET RACASENO=$ORDER(^TMP("RAUTL16",$JOB,RADFN,RASSN,RAEXAMDT,RACASENO))
- IF RACASENO'>0!RAEXIT
- QUIT
- DO PRINT
- +37 QUIT
- End DoDot:3
- +38 QUIT
- End DoDot:2
- +39 QUIT
- End DoDot:1
- +40 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),DIRUT
- +5 QUIT
- MISSING ;
- +1 IF RACASENO'>0
- SET RACASENO="Missing"
- IF RAEXAMST=""
- SET RAEXAMST="Missing"
- SET RAIMEXAM=$PIECE($GET(^RA(72,+RAEXAMST,0)),U,7)
- SORT ;
- +1 DO KVA^VADPT
- SET DFN=RADFN
- DO DEM^VADPT
- +2 ;S RADFN(0)=$G(VADM(1)),RA=$G(VADM(2)),RASSN=$P(RA,U),RASSN(0)=$P(RA,U,2)
- +3 ;IHS/ITSC/CLS 09/25/2003 use HRCN
- SET RADFN(0)=$GET(VADM(1))
- SET RA=$GET(VA("PID"))
- SET RASSN=$PIECE(RA,U)
- SET RASSN(0)=$PIECE(RA,U)
- +4 SET RAEXAMDT(0)=$$FMTE^XLFDT(RAEXAMDT)
- +5 SET RAIMTYPE(0)=$PIECE($GET(^RA(79.2,+RAIMTYPE,0)),U)
- IF RAIMTYPE(0)=""
- SET RAIMTYPE(0)="Missing"
- +6 SET RAEXAMST(0)=$PIECE($GET(^RA(72,+RAEXAMST,0)),U)
- IF RAEXAMST(0)=""
- SET RAEXAMST(0)="Missing"
- +7 SET RAIMEXAM(0)=$PIECE($GET(^RA(79.2,+RAIMEXAM,0)),U)
- IF RAIMEXAM(0)=""
- SET RAIMEXAM(0)="Missing"
- +8 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_RAD0_U_RAD1_U_RAD2
- +9 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 ;W !,"PATIENT",?34,"SSN"
- +6 ;IHS/ITSC/CLS 09/25/2003
- WRITE !,"PATIENT",?34,"HRCN"
- +7 WRITE !?3,"EXAM DATE/TIME",?25,"CASE#",?34,"IMAGING TYPE OF VISIT"
- +8 WRITE ?68,"EXAM STATUS",?102,"IMAGING TYPE OF EXAM STATUS",!,RAUNDL
- +9 QUIT
