- 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 Feb 19, 2025@00:06:32 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