RAPMW2 ;HOIFO/SWM-Radiology Wait Time reports ;12/05/05 13:41
 ;;5.0;Radiology/Nuclear Medicine;**67,79,83,99,47**;Mar 16, 1998;Build 21
 ; IA 10063 allows check for Task Stop Request
 ; detail
 Q
STORDET ;
 S RAREC=""
 S RACNL=$E(RAXDT,4,5)_$E(RAXDT,6,7)_$E(RAXDT,2,3)_"-"_+RACN0 ;long CN
 N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
 S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACNL)
 S RA71REC=$G(^RAMIS(71,+$P(RACN0,U,2),0))
 S RAXMST=$P(RA72,U) ;exam status name
 S RACPT=$P($$NAMCODE^RACPTMSC($P(RA71REC,U,9),RAXDT),U) ;CPT code
 S RAPROCNM=$P(RA71REC,U) ;procedure name
 S RAPATNM=$$GET1^DIQ(2,RADFN,.01) S:RAPATNM="" RAPATNM=" " ;pt.name
 S RAPATNM=$E(RAPATNM,1,12) ;use 1st 12 chars of pat name
 S RAPATND=RAPATNM_"-"_RADFN ;patname-DFN
 S RADTORD=$P($P(RAOREC,U,16),".") ;date ordered
 ; store items in this order -- piece no.;field descrp/
 ; 1;pt.name/ 2;long case no./ 3;dt ordered/ 4;dt desired/ 5;exam dt/
 ; 6;no. days wait/ 7;exm stat name/ 8;CPT code/ 9; proc name/
 ; 10;img typ name/ 11;* if canc & re-ord same day/ 12;Proc Typ Name/
 ; 13;"p" if case from print set (highest ranked proc type)
 ;
 I $$USESSAN^RAHLRU1() S RAREC=RAPATNM_U_RACNDSP_U_$E(RADTORD,1,7)_U_$E(RADSDT,1,7)
 I '$$USESSAN^RAHLRU1() S RAREC=RAPATNM_U_RACNL_U_$E(RADTORD,1,7)_U_$E(RADSDT,1,7)
 S RAREC=RAREC_U_$E(RAXDT,1,7)_U_RAWAITD_U_$E(RAXMST,1,11)_U_RACPT
 S RAREC=RAREC_U_$E(RAPROCNM,1,45)_U_$E(RAIMGTYP,1,3)_U_$S(RASAME2:"*",1:"")_U_RAPTA
 S RAREC=RAREC_U_$S(RACNI=99999:"p",1:"") ;flag printset case picked
 ; subscript 3 is the sort value
 ; subscripts 4-6 combined should be unique to a case, prevent over-
 ;    writing subscript 3 when >1 case has same sort value 
 ; subscript 4 is the exam date in Fileman notation
 ; subcript 5 is the patient name (1st 12 chars) and DFN
 ; subscript 6 is the "P" level ien of file 70
 I RASORT="CN" S ^TMP($J,"RA WAIT3",RACNL,RADTE,RAPATND,RACNISAV)=RAREC
 I RASORT="CPT" S ^TMP($J,"RA WAIT3",RACPT,RADTE,RAPATND,RACNISAV)=RAREC
 I RASORT="DD" S ^TMP($J,"RA WAIT3",RADSDT,RADTE,RAPATND,RACNISAV)=RAREC
 I RASORT="D" S ^TMP($J,"RA WAIT3",RAWAITD,RADTE,RAPATND,RACNISAV)=RAREC
 I RASORT="DO" S ^TMP($J,"RA WAIT3",RADTORD,RADTE,RAPATND,RACNISAV)=RAREC
 I RASORT="DR" S ^TMP($J,"RA WAIT3",RAXDT,RADTE,RAPATND,RACNISAV)=RAREC
 I RASORT="I" S ^TMP($J,"RA WAIT3",RAIMGTYP,RADTE,RAPATND,RACNISAV)=RAREC
 I RASORT="PT" S ^TMP($J,"RA WAIT3",RAPTA,RADTE,RAPATND,RACNISAV)=RAREC
 I RASORT="PN" S ^TMP($J,"RA WAIT3",RAPATNM,RADTE,RAPATND,RACNISAV)=RAREC
 I RASORT="PROC" S ^TMP($J,"RA WAIT3",RAPROCNM,RADTE,RAPATND,RACNISAV)=RAREC
 Q
WRTDET ;
 S RAHD0="Detail",RAPG=1
 D SETHD^RAPMW1
 D PRTD Q:RAXIT
 D FOOTD
 Q
HDDET ;
 W !!,"Sorted by: ",RASORTNM,?38,"Print only cases with minimum Days Wait of: ",RASINCE
 W !,"Total number of procedures registered during specified exam date range: ",RATOTAL
 Q
COLHDD ;
 I RAPG>1 W @IOF,!,"Page: ",RAPG
 S RAPG=RAPG+1
 W !!?31,"Date",?40,"Date",?49,"Date",?58,"Days",?63,"Exam",?75,"CPT",?123,"Img",?127,"PROC."
 W !,"Patient Name",?14,"Case #",?31,"Ordered",?40,"Desired",?49,"Register",?58,"Wait",?63,"Status",?75,"Code",?81,"Name of Procedure",?123,"Typ",?127,"TYPE"
 W !,$E(RADASH,1,12),?14,$E(RADASH,1,16),?31,$E(RADASH,1,8),?40,$E(RADASH,1,8),?49,$E(RADASH,1,8),?58,$E(RADASH,1,4),?63,$E(RADASH,1,11),?75,$E(RADASH,1,5),?81,$E(RADASH,1,41),?123,$E(RADASH,1,3),?127,$E(RADASH,1,5)
 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 ;user stopped task
 Q
PRTD ;
 I RATYP="B" D PRESS^RAPMW1 Q:RAXIT
 N X
 D HD^RAPMW1 Q:RAXIT  D HDDET,COLHDD
 S RA0="",RAXIT=0
 F  S RA0=$O(^TMP($J,"RA WAIT3",RA0)) Q:RA0=""  Q:RAXIT  S RA1=0 D
 .F  S RA1=$O(^TMP($J,"RA WAIT3",RA0,RA1)) Q:'RA1  Q:RAXIT  S RA2=0 D
 ..F  S RA2=$O(^TMP($J,"RA WAIT3",RA0,RA1,RA2)) Q:RA2=""  Q:RAXIT  S RA3=0 D
 ...F  S RA3=$O(^TMP($J,"RA WAIT3",RA0,RA1,RA2,RA3)) Q:'RA3  Q:RAXIT  S X=^(RA3) D
 ....D CKLINE Q:RAXIT
 ....W !,$P(X,U),?13,$P(X,U,13),?14,$P(X,U,2),?31,$$FMTE^XLFDT($P(X,U,3),2),?40,$$FMTE^XLFDT($P(X,U,4),2),?49,$$FMTE^XLFDT($P(X,U,5),2),$P(X,U,11),?58,$J($P(X,U,6),4),?63,$P(X,U,7)
 ....W ?75,$P(X,U,8),?81,$P(X,U,9),?123,$P(X,U,10),?127,$E($P(X,U,12),1,5)
 ....Q
 ...Q
 ..Q
 .Q
 Q
CKLINE ;
 I ($Y+5)>IOSL D
 . S RAXIT=$$S^%ZTLOAD("This task was in routine RAPMW2 when it was stopped.") I RAXIT S ZTSTOP=1 Q  ;IA10063
 .D PRESS^RAPMW1
 .Q:RAXIT
 .D COLHDD
 .Q
 Q
 D PRESS^RAPMW1 Q:RAXIT  W:$E(IOST,1,2)="C-" @IOF
 I RANEG W !!?3,"(There ",$S(RANEG=1:"is",1:"are")," ",RANEG," case",$S(RANEG=1:"",1:"s")," with negative days wait included in the listing.)",!
 F I=1:1:28 Q:RAXIT  W !?4,$P($T(FOOTD2+I),";;",2) I ($Y+5)>IOSL D PRESS^RAPMW1 Q:RAXIT  W:$E(IOST,1,2)="C-" @IOF
 Q
CALC ;
 S RASAME2=0 ;=1 if exm's order was cancelled & reordered same day
 S RAORIEN=$P(RACN0,U,11)
 S RAOREC=$G(^RAO(75.1,+RAORIEN,0))
 I RAOREC="" S ^TMP($J,"RA WAIT NO ORD",RADFN,RADTI,RACNI)=RAORIEN Q
 S RAXDT=9999999.9999-RADTI ; exam date FM format
 S RADSDT=$P(RAOREC,U,21) ; Date Desired
 I RADSDT="" S ^TMP($J,"RA WAIT NO DSR DT",RADFN,RADTI,RACNI)=RAORIEN Q
 S RAWAITD=$$FMDIFF^XLFDT(RAXDT,RADSDT) ;Wait days btw exm & desired dt
 S:RAWAITD<0 RANEG=RANEG+1
 D STORSUM^RAPMW1 ;store summary counts for Summary, Detail, Both
 S RA16=$P(RAOREC,U,16) ; request entered dt/tm
 ; count if same proc cancelled and reordered same day
 S RA1=$E(RA16,1,7)
 ; loop start w Last Activity same date as order's entry date
 F  S RA1=$O(^RAO(75.1,"AO",RA1)) Q:'RA1  Q:RA1>RA16  D
 .S RA2=0  F  S RA2=$O(^RAO(75.1,"AO",RA1,RA2)) Q:'RA2  Q:RA2=RAORIEN  D
 ..S RA3=^RAO(75.1,RA2,0) ;skip exm's order
 ..; other order is discontinued,same patient,same ordered procedure
 ..I $P(RA3,U,5)=1,$P(RA3,U,1)=RADFN,$P(RA3,U,2)=$P(RAOREC,U,2) S RASAME=RASAME+1,RASAME2=1
 ..Q
 .Q
 ; store detail rows for Detail,Both IF days wait at least = RASINCE
 I "B^D"[RATYP,((RAWAITD<0)!(RAWAITD'<RASINCE)) D STORDET
 Q
PTA ; *79
 S RAPRC=$P(RACN0,U,2)
 I RAPRC="" S RAPTA="unknown" Q
 S RACPTI=+$P($G(^RAMIS(71,+RAPRC,0)),U,9)
 S RACPTC=$P($$NAMCODE^RACPTMSC(RACPTI,DT),U)
 S RAPTA=$S(RACPTI:$O(^RA(73.2,"B",RACPTC,0)),1:"")
 S RAPTA=$P($G(^RA(73.2,+RAPTA,0)),U,2)
 S RAPTA=$S(RAPTA="":"unknown",'$D(RACOL(RAPTA)):"unknown",1:RAPTA)
 ; RAPTA should match one of the RATOTAL(rapta)
 Q
COLHDS(X) ; moved from RAPMW1
 ;input: X (header) 1 = DAYS WAIT -- PERCENTAGES; 2 = DAYS WAIT -- COUNTS
 I X=1 D
 .W !,"PROCEDURE",?29,"<=14",?37,"<=30",?45,"31-60",?54,"61-90",?63,"91-120",?73,">120"
 .W !,"TYPE",?29,"Days",?37,"Days",?46,"Days",?55,"Days",?65,"Days",?73,"Days"
 .W !,"------------------------",?27,"------",?35,"------",?44,"------",?53,"------",?63,"------",?71,"------"
 .Q
 I X=2 D
 .W !,"PROCEDURE",?19,"<=14",?27,"<=30",?34,"31-60",?42,"61-90",?49,"91-120",?59,">120",?68,"ROW",?75,"Avg."
 .W !,"TYPE",?19,"Days",?27,"Days",?35,"Days",?43,"Days",?51,"Days",?59,"Days",?66,"TOTAL",?75,"Days"
 .W !,"---------------",?16,"-------",?24,"-------",?32,"-------",?40,"-------",?48,"-------",?56,"-------",?64,"-------",?72,"-------"
 .Q
 Q
 ;;
 ;;1. Cancelled, "No Credit", inpatient cases, and not the highest modality of a printset are excluded from this report.
 ;;   (See 3. below.)
 ;;
 ;;2. The "Days Wait" represent # of days from the Registered date (the date/time entered at the "Imaging Exam Date/Time:" prompt)
 ;;   backwards to the Date Desired for the ordered procedure.  The calculation is based on the number of different days and 
 ;;   not rounded off by hours.
 ;;
 ;;3. If the user did not select a specific CPT Code or Procedure Name, then the cases from a printset (group of cases that 
 ;;   share the same report) will have only the case with the highest ranked modality printed.  Modalities are ranked 
 ;;   in this order, (1) being the highest:
 ;;   (1) Interventional, (2) MRI, (3) CT, (4) Cardiac Stress test, (5) Nuc Med, (6) US, (7) Mammo, (8) General Rad (9) Other
 ;;   However, all the cases from an examset (group of cases that have separate reports) will all be listed.
 ;;
 ;;4. "Procedure Types" are assigned by a national CPT code look-up table and may differ from locally defined "Imaging Types."  
 ;;   Therefore the number of procedures in each category may not be the same as other radiology management reports.
 ;;
 ;;5. Procedure Type of "unknown" refers to either cases that have no matching procedure type in the spreadsheet of CPT Codes
 ;;   provided by the Office of Patient Care Services, or cases that are missing data for the procedure.
 ;;
 ;;6. CPT Code is not available for parent and broad procedures in the header section.  CPT Code of the parent order's highest
 ;;   ranked modality case will be printed in the line by line section.  (See 3. above.)
 ;;
 ;;7. Date/Time Registered is the "Imaging Exam Date/Time" entered by the user during Registration.
 ;;
 ;;8. "*" under the "Date Register" column denotes the request was cancelled and re-ordered on the same day that it was cancelled.
 ;;
 ;;9. "p" under the "Case #" column, before the case number, denotes printset case with the highest ranked Procedure Type.
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPMW2   9175     printed  Sep 23, 2025@20:14:47                                                                                                                                                                                                      Page 2
RAPMW2    ;HOIFO/SWM-Radiology Wait Time reports ;12/05/05 13:41
 +1       ;;5.0;Radiology/Nuclear Medicine;**67,79,83,99,47**;Mar 16, 1998;Build 21
 +2       ; IA 10063 allows check for Task Stop Request
 +3       ; detail
 +4        QUIT 
STORDET   ;
 +1        SET RAREC=""
 +2       ;long CN
           SET RACNL=$EXTRACT(RAXDT,4,5)_$EXTRACT(RAXDT,6,7)_$EXTRACT(RAXDT,2,3)_"-"_+RACN0
 +3        NEW RASSAN,RACNDSP
           SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
 +4        SET RACNDSP=$SELECT((RASSAN'=""):RASSAN,1:RACNL)
 +5        SET RA71REC=$GET(^RAMIS(71,+$PIECE(RACN0,U,2),0))
 +6       ;exam status name
           SET RAXMST=$PIECE(RA72,U)
 +7       ;CPT code
           SET RACPT=$PIECE($$NAMCODE^RACPTMSC($PIECE(RA71REC,U,9),RAXDT),U)
 +8       ;procedure name
           SET RAPROCNM=$PIECE(RA71REC,U)
 +9       ;pt.name
           SET RAPATNM=$$GET1^DIQ(2,RADFN,.01)
           if RAPATNM=""
               SET RAPATNM=" "
 +10      ;use 1st 12 chars of pat name
           SET RAPATNM=$EXTRACT(RAPATNM,1,12)
 +11      ;patname-DFN
           SET RAPATND=RAPATNM_"-"_RADFN
 +12      ;date ordered
           SET RADTORD=$PIECE($PIECE(RAOREC,U,16),".")
 +13      ; store items in this order -- piece no.;field descrp/
 +14      ; 1;pt.name/ 2;long case no./ 3;dt ordered/ 4;dt desired/ 5;exam dt/
 +15      ; 6;no. days wait/ 7;exm stat name/ 8;CPT code/ 9; proc name/
 +16      ; 10;img typ name/ 11;* if canc & re-ord same day/ 12;Proc Typ Name/
 +17      ; 13;"p" if case from print set (highest ranked proc type)
 +18      ;
 +19       IF $$USESSAN^RAHLRU1()
               SET RAREC=RAPATNM_U_RACNDSP_U_$EXTRACT(RADTORD,1,7)_U_$EXTRACT(RADSDT,1,7)
 +20       IF '$$USESSAN^RAHLRU1()
               SET RAREC=RAPATNM_U_RACNL_U_$EXTRACT(RADTORD,1,7)_U_$EXTRACT(RADSDT,1,7)
 +21       SET RAREC=RAREC_U_$EXTRACT(RAXDT,1,7)_U_RAWAITD_U_$EXTRACT(RAXMST,1,11)_U_RACPT
 +22       SET RAREC=RAREC_U_$EXTRACT(RAPROCNM,1,45)_U_$EXTRACT(RAIMGTYP,1,3)_U_$SELECT(RASAME2:"*",1:"")_U_RAPTA
 +23      ;flag printset case picked
           SET RAREC=RAREC_U_$SELECT(RACNI=99999:"p",1:"")
 +24      ; subscript 3 is the sort value
 +25      ; subscripts 4-6 combined should be unique to a case, prevent over-
 +26      ;    writing subscript 3 when >1 case has same sort value 
 +27      ; subscript 4 is the exam date in Fileman notation
 +28      ; subcript 5 is the patient name (1st 12 chars) and DFN
 +29      ; subscript 6 is the "P" level ien of file 70
 +30       IF RASORT="CN"
               SET ^TMP($JOB,"RA WAIT3",RACNL,RADTE,RAPATND,RACNISAV)=RAREC
 +31       IF RASORT="CPT"
               SET ^TMP($JOB,"RA WAIT3",RACPT,RADTE,RAPATND,RACNISAV)=RAREC
 +32       IF RASORT="DD"
               SET ^TMP($JOB,"RA WAIT3",RADSDT,RADTE,RAPATND,RACNISAV)=RAREC
 +33       IF RASORT="D"
               SET ^TMP($JOB,"RA WAIT3",RAWAITD,RADTE,RAPATND,RACNISAV)=RAREC
 +34       IF RASORT="DO"
               SET ^TMP($JOB,"RA WAIT3",RADTORD,RADTE,RAPATND,RACNISAV)=RAREC
 +35       IF RASORT="DR"
               SET ^TMP($JOB,"RA WAIT3",RAXDT,RADTE,RAPATND,RACNISAV)=RAREC
 +36       IF RASORT="I"
               SET ^TMP($JOB,"RA WAIT3",RAIMGTYP,RADTE,RAPATND,RACNISAV)=RAREC
 +37       IF RASORT="PT"
               SET ^TMP($JOB,"RA WAIT3",RAPTA,RADTE,RAPATND,RACNISAV)=RAREC
 +38       IF RASORT="PN"
               SET ^TMP($JOB,"RA WAIT3",RAPATNM,RADTE,RAPATND,RACNISAV)=RAREC
 +39       IF RASORT="PROC"
               SET ^TMP($JOB,"RA WAIT3",RAPROCNM,RADTE,RAPATND,RACNISAV)=RAREC
 +40       QUIT 
WRTDET    ;
 +1        SET RAHD0="Detail"
           SET RAPG=1
 +2        DO SETHD^RAPMW1
 +3        DO PRTD
           if RAXIT
               QUIT 
 +4        DO FOOTD
 +5        QUIT 
HDDET     ;
 +1        WRITE !!,"Sorted by: ",RASORTNM,?38,"Print only cases with minimum Days Wait of: ",RASINCE
 +2        WRITE !,"Total number of procedures registered during specified exam date range: ",RATOTAL
 +3        QUIT 
COLHDD    ;
 +1        IF RAPG>1
               WRITE @IOF,!,"Page: ",RAPG
 +2        SET RAPG=RAPG+1
 +3        WRITE !!?31,"Date",?40,"Date",?49,"Date",?58,"Days",?63,"Exam",?75,"CPT",?123,"Img",?127,"PROC."
 +4        WRITE !,"Patient Name",?14,"Case #",?31,"Ordered",?40,"Desired",?49,"Register",?58,"Wait",?63,"Status",?75,"Code",?81,"Name of Procedure",?123,"Typ",?127,"TYPE"
 +5       WRITE !,$EXTRACT(RADASH,1,12),?14,$EXTRACT(RADASH,1,16),?31,$EXTRACT(RADASH,1,8),?40,$EXTRACT(RADASH,1,8),?49,$EXTRACT(RADASH,1,8),?58,$EXTRACT(RADASH,1,4),?63,...
           ... $EXTRACT(RADASH,1,11),?75,$EXTRACT(RADASH,1,5),?81,$EXTRACT(RADASH,1,41),?123,$EXTRACT(RADASH,1,3),?127,$EXTRACT(RADASH,1,5)
 +6       ;user stopped task
           IF $DATA(ZTQUEUED)
               DO STOPCHK^RAUTL9
               if $GET(ZTSTOP)=1
                   SET RAXIT=1
 +7        QUIT 
PRTD      ;
 +1        IF RATYP="B"
               DO PRESS^RAPMW1
               if RAXIT
                   QUIT 
 +2        NEW X
 +3        DO HD^RAPMW1
           if RAXIT
               QUIT 
           DO HDDET
           DO COLHDD
 +4        SET RA0=""
           SET RAXIT=0
 +5        FOR 
               SET RA0=$ORDER(^TMP($JOB,"RA WAIT3",RA0))
               if RA0=""
                   QUIT 
               if RAXIT
                   QUIT 
               SET RA1=0
               Begin DoDot:1
 +6                FOR 
                       SET RA1=$ORDER(^TMP($JOB,"RA WAIT3",RA0,RA1))
                       if 'RA1
                           QUIT 
                       if RAXIT
                           QUIT 
                       SET RA2=0
                       Begin DoDot:2
 +7                        FOR 
                               SET RA2=$ORDER(^TMP($JOB,"RA WAIT3",RA0,RA1,RA2))
                               if RA2=""
                                   QUIT 
                               if RAXIT
                                   QUIT 
                               SET RA3=0
                               Begin DoDot:3
 +8                                FOR 
                                       SET RA3=$ORDER(^TMP($JOB,"RA WAIT3",RA0,RA1,RA2,RA3))
                                       if 'RA3
                                           QUIT 
                                       if RAXIT
                                           QUIT 
                                       SET X=^(RA3)
                                       Begin DoDot:4
 +9                                        DO CKLINE
                                           if RAXIT
                                               QUIT 
 +10                                       WRITE !,$PIECE(X,U),?13,$PIECE(X,U,13),?14,$PIECE(X,U,2),?31,$$FMTE^XLFDT($PIECE(X,U,3),2),?40,$$FMTE^XLFDT($PIECE(X,U,4),2),?49,$$FMTE^XLFDT($PIECE(X,U,5),2),$PIECE(X,U,11),?58,$JUSTIFY($PIECE(X,U,6),4),?63,$PIE
CE(X,U,7)
 +11                                       WRITE ?75,$PIECE(X,U,8),?81,$PIECE(X,U,9),?123,$PIECE(X,U,10),?127,$EXTRACT($PIECE(X,U,12),1,5)
 +12                                       QUIT 
                                       End DoDot:4
 +13                               QUIT 
                               End DoDot:3
 +14                       QUIT 
                       End DoDot:2
 +15               QUIT 
               End DoDot:1
 +16       QUIT 
CKLINE    ;
 +1        IF ($Y+5)>IOSL
               Begin DoDot:1
 +2       ;IA10063
                   SET RAXIT=$$S^%ZTLOAD("This task was in routine RAPMW2 when it was stopped.")
                   IF RAXIT
                       SET ZTSTOP=1
                       QUIT 
 +3                DO PRESS^RAPMW1
 +4                if RAXIT
                       QUIT 
 +5                DO COLHDD
 +6                QUIT 
               End DoDot:1
 +7        QUIT 
 +1        DO PRESS^RAPMW1
           if RAXIT
               QUIT 
           if $EXTRACT(IOST,1,2)="C-"
               WRITE @IOF
 +2        IF RANEG
               WRITE !!?3,"(There ",$SELECT(RANEG=1:"is",1:"are")," ",RANEG," case",$SELECT(RANEG=1:"",1:"s")," with negative days wait included in the listing.)",!
 +3        FOR I=1:1:28
               if RAXIT
                   QUIT 
               WRITE !?4,$PIECE($TEXT(FOOTD2+I),";;",2)
               IF ($Y+5)>IOSL
                   DO PRESS^RAPMW1
                   if RAXIT
                       QUIT 
                   if $EXTRACT(IOST,1,2)="C-"
                       WRITE @IOF
 +4        QUIT 
CALC      ;
 +1       ;=1 if exm's order was cancelled & reordered same day
           SET RASAME2=0
 +2        SET RAORIEN=$PIECE(RACN0,U,11)
 +3        SET RAOREC=$GET(^RAO(75.1,+RAORIEN,0))
 +4        IF RAOREC=""
               SET ^TMP($JOB,"RA WAIT NO ORD",RADFN,RADTI,RACNI)=RAORIEN
               QUIT 
 +5       ; exam date FM format
           SET RAXDT=9999999.9999-RADTI
 +6       ; Date Desired
           SET RADSDT=$PIECE(RAOREC,U,21)
 +7        IF RADSDT=""
               SET ^TMP($JOB,"RA WAIT NO DSR DT",RADFN,RADTI,RACNI)=RAORIEN
               QUIT 
 +8       ;Wait days btw exm & desired dt
           SET RAWAITD=$$FMDIFF^XLFDT(RAXDT,RADSDT)
 +9        if RAWAITD<0
               SET RANEG=RANEG+1
 +10      ;store summary counts for Summary, Detail, Both
           DO STORSUM^RAPMW1
 +11      ; request entered dt/tm
           SET RA16=$PIECE(RAOREC,U,16)
 +12      ; count if same proc cancelled and reordered same day
 +13       SET RA1=$EXTRACT(RA16,1,7)
 +14      ; loop start w Last Activity same date as order's entry date
 +15       FOR 
               SET RA1=$ORDER(^RAO(75.1,"AO",RA1))
               if 'RA1
                   QUIT 
               if RA1>RA16
                   QUIT 
               Begin DoDot:1
 +16               SET RA2=0
                   FOR 
                       SET RA2=$ORDER(^RAO(75.1,"AO",RA1,RA2))
                       if 'RA2
                           QUIT 
                       if RA2=RAORIEN
                           QUIT 
                       Begin DoDot:2
 +17      ;skip exm's order
                           SET RA3=^RAO(75.1,RA2,0)
 +18      ; other order is discontinued,same patient,same ordered procedure
 +19                       IF $PIECE(RA3,U,5)=1
                               IF $PIECE(RA3,U,1)=RADFN
                                   IF $PIECE(RA3,U,2)=$PIECE(RAOREC,U,2)
                                       SET RASAME=RASAME+1
                                       SET RASAME2=1
 +20                       QUIT 
                       End DoDot:2
 +21               QUIT 
               End DoDot:1
 +22      ; store detail rows for Detail,Both IF days wait at least = RASINCE
 +23       IF "B^D"[RATYP
               IF ((RAWAITD<0)!(RAWAITD'<RASINCE))
                   DO STORDET
 +24       QUIT 
PTA       ; *79
 +1        SET RAPRC=$PIECE(RACN0,U,2)
 +2        IF RAPRC=""
               SET RAPTA="unknown"
               QUIT 
 +3        SET RACPTI=+$PIECE($GET(^RAMIS(71,+RAPRC,0)),U,9)
 +4        SET RACPTC=$PIECE($$NAMCODE^RACPTMSC(RACPTI,DT),U)
 +5        SET RAPTA=$SELECT(RACPTI:$ORDER(^RA(73.2,"B",RACPTC,0)),1:"")
 +6        SET RAPTA=$PIECE($GET(^RA(73.2,+RAPTA,0)),U,2)
 +7        SET RAPTA=$SELECT(RAPTA="":"unknown",'$DATA(RACOL(RAPTA)):"unknown",1:RAPTA)
 +8       ; RAPTA should match one of the RATOTAL(rapta)
 +9        QUIT 
COLHDS(X) ; moved from RAPMW1
 +1       ;input: X (header) 1 = DAYS WAIT -- PERCENTAGES; 2 = DAYS WAIT -- COUNTS
 +2        IF X=1
               Begin DoDot:1
 +3                WRITE !,"PROCEDURE",?29,"<=14",?37,"<=30",?45,"31-60",?54,"61-90",?63,"91-120",?73,">120"
 +4                WRITE !,"TYPE",?29,"Days",?37,"Days",?46,"Days",?55,"Days",?65,"Days",?73,"Days"
 +5                WRITE !,"------------------------",?27,"------",?35,"------",?44,"------",?53,"------",?63,"------",?71,"------"
 +6                QUIT 
               End DoDot:1
 +7        IF X=2
               Begin DoDot:1
 +8                WRITE !,"PROCEDURE",?19,"<=14",?27,"<=30",?34,"31-60",?42,"61-90",?49,"91-120",?59,">120",?68,"ROW",?75,"Avg."
 +9                WRITE !,"TYPE",?19,"Days",?27,"Days",?35,"Days",?43,"Days",?51,"Days",?59,"Days",?66,"TOTAL",?75,"Days"
 +10               WRITE !,"---------------",?16,"-------",?24,"-------",?32,"-------",?40,"-------",?48,"-------",?56,"-------",?64,"-------",?72,"-------"
 +11               QUIT 
               End DoDot:1
 +12       QUIT 
 +1       ;;
 +2       ;;1. Cancelled, "No Credit", inpatient cases, and not the highest modality of a printset are excluded from this report.
 +3       ;;   (See 3. below.)
 +4       ;;
 +5       ;;2. The "Days Wait" represent # of days from the Registered date (the date/time entered at the "Imaging Exam Date/Time:" prompt)
 +6       ;;   backwards to the Date Desired for the ordered procedure.  The calculation is based on the number of different days and 
 +7       ;;   not rounded off by hours.
 +8       ;;
 +9       ;;3. If the user did not select a specific CPT Code or Procedure Name, then the cases from a printset (group of cases that 
 +10      ;;   share the same report) will have only the case with the highest ranked modality printed.  Modalities are ranked 
 +11      ;;   in this order, (1) being the highest:
 +12      ;;   (1) Interventional, (2) MRI, (3) CT, (4) Cardiac Stress test, (5) Nuc Med, (6) US, (7) Mammo, (8) General Rad (9) Other
 +13      ;;   However, all the cases from an examset (group of cases that have separate reports) will all be listed.
 +14      ;;
 +15      ;;4. "Procedure Types" are assigned by a national CPT code look-up table and may differ from locally defined "Imaging Types."  
 +16      ;;   Therefore the number of procedures in each category may not be the same as other radiology management reports.
 +17      ;;
 +18      ;;5. Procedure Type of "unknown" refers to either cases that have no matching procedure type in the spreadsheet of CPT Codes
 +19      ;;   provided by the Office of Patient Care Services, or cases that are missing data for the procedure.
 +20      ;;
 +21      ;;6. CPT Code is not available for parent and broad procedures in the header section.  CPT Code of the parent order's highest
 +22      ;;   ranked modality case will be printed in the line by line section.  (See 3. above.)
 +23      ;;
 +24      ;;7. Date/Time Registered is the "Imaging Exam Date/Time" entered by the user during Registration.
 +25      ;;
 +26      ;;8. "*" under the "Date Register" column denotes the request was cancelled and re-ordered on the same day that it was cancelled.
 +27      ;;
 +28      ;;9. "p" under the "Case #" column, before the case number, denotes printset case with the highest ranked Procedure Type.