RACPT1 ;HISC/GJC,FPT-Procedure/CPT Stats Report ;12/29/00 11:28
;;5.0;Radiology/Nuclear Medicine;**26,69,103**;Mar 16, 1998;Build 2
;04/05/2010 KAM/BP Remedy Call 349101 CPT Codes w/modifiers do not
; display properly
;01/19/2006 KAM/BAY Remedy Call 97373 CPT Code Display Problem
CHK ;
I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
I $O(RACCESS(DUZ,""))="" D ACCVIO^RAUTL19 S RAQUIT=1 Q
D ASK1^RAWKL ;ask if want separate CPT mods
I $$DIVLOC^RAUTL7() D S RAQUIT=1 Q
. I $O(^TMP($J,"RA D-TYPE",""))="" W !!?5,"No divisions selected." Q
. I $O(^TMP($J,"RA I-TYPE",""))="" W !!?5,"No imaging types selected."
. Q
W ! S RACAN=$$YESNO()
; RACAN=0: cancelled exams excluded, RACAN=1: cancelled exams
; are included, RACAN=-1: exit option
S:RACAN<0 RAQUIT=1 Q:$G(RAQUIT)
K DIR S DIR(0)="Y",DIR("B")="Yes"
S DIR("A")="Do you wish to include all Procedures"
S DIR("?",1)="Enter 'Yes' to select all entries in the file."
S DIR("?")="Enter 'No' to select a subset of entries in the file."
W ! D ^DIR K DIR I $D(DIRUT) S RAQUIT=1 Q
S RAINPUT=+Y
I RAINPUT=0 D Q:$G(RAQUIT)
. K RADIC
. S RADIC="^RAMIS(71,",RADIC(0)="EMQZ",RADIC("A")="Select PROCEDURE: "
. S RAUTIL="RA P-TYPE" D EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
. I $O(^TMP($J,"RA P-TYPE",""))=""!$G(RAQUIT) W !!?5,"No procedures selected." S RAQUIT=1
. Q
S RANUMPRC=$$PROCNUM()
DATE D DATE^RAUTL Q:RAPOP
;S Z=9999999.9999, WHY IS THIS NEEDED?
S RABEG=BEGDATE,RAEND=ENDDATE+.9
S DIR(0)="S^I:INPATIENT;O:OUTPATIENT;B:BOTH;",DIR("B")="BOTH",DIR("?",1)="This CPT Workload Report can be broken",DIR("?")="out by Inpatient, Outpatient or Both.",DIR("A")="Report to include"
D ^DIR S RASORT=Y I $D(DIRUT) S RAQUIT=1 Q
K DIR,X,Y
S ZTRTN="START^RACPT"
F RASV="RACAN","RANUMPRC","BEGDATE","ENDDATE","RABEG","RAEND","RASORT","RAINPUT","RACMLIST" S ZTSAVE(RASV)=""
F RASV="D","I","P" S ZTSAVE("^TMP($J,""RA "_RASV_"-TYPE"",")=""
W ! D ZIS^RAUTL
Q
PRINT ; Output data
; 01/19/2006 KAM/BAY Changed next line to utilize $$NAMCODE^RACPTMSC
I '$G(RACMLIST) W !,$P($$NAMCODE^RACPTMSC(CPT,""),U),?7,$S($D(^RAMIS(71,J,0)):$E($P(^(0),"^"),1,38),1:"UNKNOWN") S RATOT(1)=+$P(^(0),U,10) ;cost per unit
; 01/19/2006 KAM/BAY Changed next line to utilize $$NAMCODE^RACPTMSC
;I $G(RACMLIST) W !,$P($$NAMCODE^RACPTMSC(CPT,""),U),?15,$S($D(^RAMIS(71,J,0)):$E($P(^(0),"^"),1,30),1:"UNKNOWN") S RATOT(1)=+$P(^(0),U,10) ;cost per unit
; 01/13/2010 KAM/BAY Changed next line to display CPT w/Modifier
I $G(RACMLIST) W !,$S(CPT["-":$P($$NAMCODE^RACPTMSC($P(CPT,"-"),""),U)_"-"_$P(CPT,"-",2),1:$P($$NAMCODE^RACPTMSC(CPT,""),U)),?15,$S($D(^RAMIS(71,J,0)):$E($P(^(0),"^"),1,30),1:"UNKNOWN") S RATOT(1)=+$P(^(0),U,10) ;cost per unit KEN TESTING
S RATOT(2)=RATOT*RATOT(1) ;occurrence * cost per unit
S RATOT(4)=$G(^TMP($J,"RA",RAI,RADIV,RAIMAG(1),"DONE"))
S RATOT(5)=$G(^TMP($J,"RA",RAI,RADIV,RAIMAG(1),"COST"))
W ?45,$J(RATOT,5),?52,$S(RATOT(4)=0:$J(0,3,0),1:$J(RATOT/RATOT(4)*100,3,0))
W ?56,$J(RATOT(1),8,2)
W ?65,$J(RATOT(2),10,2),?77,$S(RATOT(5)=0:$J(0,3,0),1:$J(RATOT(2)/RATOT(5)*100,3,0))
I $E(IOST,1,2)="C-",$Y+4>IOSL D HANG1,HED:'RAEXIT
Q
HED ; Issue header
W:($E(IOST)="C")!(PAGE>1) @IOF
N RA S RA=">>>>> PROCEDURE/CPT STATISTICS REPORT "
S RA=RA_$S(RAI="I":"(INPATIENT)",RAI="O":"(OUTPATIENT)",1:"")_" <<<<<"
W !?78-$L(RA)\2,RA,?70,"Page: ",PAGE S PAGE=PAGE+1
W !!," Division: ",$S(RADIV="":"Unknown",$D(^DIC(4,RADIV,0)):$P(^(0),U),1:"Unknown")
W !,"Imaging Type: ",RAIMAG(0)
W ?52,"For period: ",BEGDATE(0)," to"
W !," Run Date: ",RARUNDTE,?64,ENDDATE(0)
W !," # of Procedures selected: ",$S(RAINPUT:"All",1:RANUMPRC)
W ?52,"Cancelled Exams: "_$S(RACAN:"in",1:"ex")_"cluded"
W:'$G(RACMLIST) !!,"CPT",?7,"PROCEDURE"
W:$G(RACMLIST) !!,"CPT (* : >3 CPT mods)",?25,"PROCEDURE"
W ?44,"# DONE",?52,"(%)",?59,"$UNIT",?69,"$TOTAL",?77,"(%)",!,QQ
Q
HANG ; get to the EOP
Q:$E(IOST,1,2)'="C-"
F Z=1:1:(IOSL-($Y+4)) W !
HANG1 ; Issue EOP prompt
R !!,"Press RETURN to continue or an '^' to stop ",X:DTIME
S RAEXIT=(X=U)
Q
SRTPA(RA) ; Check on the sort parameters. If inpatient and outpatient,
; issue a EOP prompt when the sort parameter changes.
; '1' implies that we are sorting by both inpatient/outpatient and
; are on the second parameter, '0' implies that we fail the above
; conditions.
I ($L(RASORT,",")#2)=0,(RA>1),('+$G(RAEOPFLG)) Q 1
Q 0
PROCNUM() ; Determine the number of procedures a user has chosen.
N X,Y S X="",Y=0
F S X=$O(^TMP($J,"RA P-TYPE",X)) Q:X']"" S Y=Y+1
Q Y
YESNO() ; Pass back the user's response to the 'Yes/No' question
; returns: 0=user answers No, 1=user answers Yes, -1='^' or timeout
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y S DIR(0)="Y",DIR("B")="Yes"
S DIR("A")="Do you wish to include cancelled cases"
S DIR("?",1)="Enter 'Yes' if exams with an examination status of Cancelled"
S DIR("?",2)="are to be included on the report. Enter 'No' if cancelled exams"
S DIR("?")="are to be excluded from the report." D ^DIR
S:$D(DIRUT) Y=-1
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRACPT1 5119 printed Nov 22, 2024@17:44:10 Page 2
RACPT1 ;HISC/GJC,FPT-Procedure/CPT Stats Report ;12/29/00 11:28
+1 ;;5.0;Radiology/Nuclear Medicine;**26,69,103**;Mar 16, 1998;Build 2
+2 ;04/05/2010 KAM/BP Remedy Call 349101 CPT Codes w/modifiers do not
+3 ; display properly
+4 ;01/19/2006 KAM/BAY Remedy Call 97373 CPT Code Display Problem
CHK ;
+1 IF $ORDER(RACCESS(DUZ,""))=""
DO SETVARS^RAPSET1(0)
SET RAPSTX=""
+2 IF $ORDER(RACCESS(DUZ,""))=""
DO ACCVIO^RAUTL19
SET RAQUIT=1
QUIT
+3 ;ask if want separate CPT mods
DO ASK1^RAWKL
+4 IF $$DIVLOC^RAUTL7()
Begin DoDot:1
+5 IF $ORDER(^TMP($JOB,"RA D-TYPE",""))=""
WRITE !!?5,"No divisions selected."
QUIT
+6 IF $ORDER(^TMP($JOB,"RA I-TYPE",""))=""
WRITE !!?5,"No imaging types selected."
+7 QUIT
End DoDot:1
SET RAQUIT=1
QUIT
+8 WRITE !
SET RACAN=$$YESNO()
+9 ; RACAN=0: cancelled exams excluded, RACAN=1: cancelled exams
+10 ; are included, RACAN=-1: exit option
+11 if RACAN<0
SET RAQUIT=1
if $GET(RAQUIT)
QUIT
+12 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="Yes"
+13 SET DIR("A")="Do you wish to include all Procedures"
+14 SET DIR("?",1)="Enter 'Yes' to select all entries in the file."
+15 SET DIR("?")="Enter 'No' to select a subset of entries in the file."
+16 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET RAQUIT=1
QUIT
+17 SET RAINPUT=+Y
+18 IF RAINPUT=0
Begin DoDot:1
+19 KILL RADIC
+20 SET RADIC="^RAMIS(71,"
SET RADIC(0)="EMQZ"
SET RADIC("A")="Select PROCEDURE: "
+21 SET RAUTIL="RA P-TYPE"
DO EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
+22 IF $ORDER(^TMP($JOB,"RA P-TYPE",""))=""!$GET(RAQUIT)
WRITE !!?5,"No procedures selected."
SET RAQUIT=1
+23 QUIT
End DoDot:1
if $GET(RAQUIT)
QUIT
+24 SET RANUMPRC=$$PROCNUM()
DATE DO DATE^RAUTL
if RAPOP
QUIT
+1 ;S Z=9999999.9999, WHY IS THIS NEEDED?
+2 SET RABEG=BEGDATE
SET RAEND=ENDDATE+.9
+3 SET DIR(0)="S^I:INPATIENT;O:OUTPATIENT;B:BOTH;"
SET DIR("B")="BOTH"
SET DIR("?",1)="This CPT Workload Report can be broken"
SET DIR("?")="out by Inpatient, Outpatient or Both."
SET DIR("A")="Report to include"
+4 DO ^DIR
SET RASORT=Y
IF $DATA(DIRUT)
SET RAQUIT=1
QUIT
+5 KILL DIR,X,Y
+6 SET ZTRTN="START^RACPT"
+7 FOR RASV="RACAN","RANUMPRC","BEGDATE","ENDDATE","RABEG","RAEND","RASORT","RAINPUT","RACMLIST"
SET ZTSAVE(RASV)=""
+8 FOR RASV="D","I","P"
SET ZTSAVE("^TMP($J,""RA "_RASV_"-TYPE"",")=""
+9 WRITE !
DO ZIS^RAUTL
+10 QUIT
PRINT ; Output data
+1 ; 01/19/2006 KAM/BAY Changed next line to utilize $$NAMCODE^RACPTMSC
+2 ;cost per unit
IF '$GET(RACMLIST)
WRITE !,$PIECE($$NAMCODE^RACPTMSC(CPT,""),U),?7,$SELECT($DATA(^RAMIS(71,J,0)):$EXTRACT($PIECE(^(0),"^"),1,38),1:"UNKNOWN")
SET RATOT(1)=+$PIECE(^(0),U,10)
+3 ; 01/19/2006 KAM/BAY Changed next line to utilize $$NAMCODE^RACPTMSC
+4 ;I $G(RACMLIST) W !,$P($$NAMCODE^RACPTMSC(CPT,""),U),?15,$S($D(^RAMIS(71,J,0)):$E($P(^(0),"^"),1,30),1:"UNKNOWN") S RATOT(1)=+$P(^(0),U,10) ;cost per unit
+5 ; 01/13/2010 KAM/BAY Changed next line to display CPT w/Modifier
+6 ;cost per unit KEN TESTING
IF $GET(RACMLIST)
WRITE !,$SELECT(CPT["-":$PIECE($$NAMCODE^RACPTMSC($PIECE(CPT,"-"),""),U)_"-"_$PIECE(CPT,"-",2),1:$PIECE($$NAMCODE^RACPTMSC(CPT,""),U)),?15,$SELECT($DATA(^RAMIS(71,J,0)):$EXTRACT($PIECE(^(0),"^"),1,30),1:"UNKNOWN")
SET RATOT(1)=+$PIECE(^(0),U,10)
+7 ;occurrence * cost per unit
SET RATOT(2)=RATOT*RATOT(1)
+8 SET RATOT(4)=$GET(^TMP($JOB,"RA",RAI,RADIV,RAIMAG(1),"DONE"))
+9 SET RATOT(5)=$GET(^TMP($JOB,"RA",RAI,RADIV,RAIMAG(1),"COST"))
+10 WRITE ?45,$JUSTIFY(RATOT,5),?52,$SELECT(RATOT(4)=0:$JUSTIFY(0,3,0),1:$JUSTIFY(RATOT/RATOT(4)*100,3,0))
+11 WRITE ?56,$JUSTIFY(RATOT(1),8,2)
+12 WRITE ?65,$JUSTIFY(RATOT(2),10,2),?77,$SELECT(RATOT(5)=0:$JUSTIFY(0,3,0),1:$JUSTIFY(RATOT(2)/RATOT(5)*100,3,0))
+13 IF $EXTRACT(IOST,1,2)="C-"
IF $Y+4>IOSL
DO HANG1
if 'RAEXIT
DO HED
+14 QUIT
HED ; Issue header
+1 if ($EXTRACT(IOST)="C")!(PAGE>1)
WRITE @IOF
+2 NEW RA
SET RA=">>>>> PROCEDURE/CPT STATISTICS REPORT "
+3 SET RA=RA_$SELECT(RAI="I":"(INPATIENT)",RAI="O":"(OUTPATIENT)",1:"")_" <<<<<"
+4 WRITE !?78-$LENGTH(RA)\2,RA,?70,"Page: ",PAGE
SET PAGE=PAGE+1
+5 WRITE !!," Division: ",$SELECT(RADIV="":"Unknown",$DATA(^DIC(4,RADIV,0)):$PIECE(^(0),U),1:"Unknown")
+6 WRITE !,"Imaging Type: ",RAIMAG(0)
+7 WRITE ?52,"For period: ",BEGDATE(0)," to"
+8 WRITE !," Run Date: ",RARUNDTE,?64,ENDDATE(0)
+9 WRITE !," # of Procedures selected: ",$SELECT(RAINPUT:"All",1:RANUMPRC)
+10 WRITE ?52,"Cancelled Exams: "_$SELECT(RACAN:"in",1:"ex")_"cluded"
+11 if '$GET(RACMLIST)
WRITE !!,"CPT",?7,"PROCEDURE"
+12 if $GET(RACMLIST)
WRITE !!,"CPT (* : >3 CPT mods)",?25,"PROCEDURE"
+13 WRITE ?44,"# DONE",?52,"(%)",?59,"$UNIT",?69,"$TOTAL",?77,"(%)",!,QQ
+14 QUIT
HANG ; get to the EOP
+1 if $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 FOR Z=1:1:(IOSL-($Y+4))
WRITE !
HANG1 ; Issue EOP prompt
+1 READ !!,"Press RETURN to continue or an '^' to stop ",X:DTIME
+2 SET RAEXIT=(X=U)
+3 QUIT
SRTPA(RA) ; Check on the sort parameters. If inpatient and outpatient,
+1 ; issue a EOP prompt when the sort parameter changes.
+2 ; '1' implies that we are sorting by both inpatient/outpatient and
+3 ; are on the second parameter, '0' implies that we fail the above
+4 ; conditions.
+5 IF ($LENGTH(RASORT,",")#2)=0
IF (RA>1)
IF ('+$GET(RAEOPFLG))
QUIT 1
+6 QUIT 0
PROCNUM() ; Determine the number of procedures a user has chosen.
+1 NEW X,Y
SET X=""
SET Y=0
+2 FOR
SET X=$ORDER(^TMP($JOB,"RA P-TYPE",X))
if X']""
QUIT
SET Y=Y+1
+3 QUIT Y
YESNO() ; Pass back the user's response to the 'Yes/No' question
+1 ; returns: 0=user answers No, 1=user answers Yes, -1='^' or timeout
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
SET DIR(0)="Y"
SET DIR("B")="Yes"
+3 SET DIR("A")="Do you wish to include cancelled cases"
+4 SET DIR("?",1)="Enter 'Yes' if exams with an examination status of Cancelled"
+5 SET DIR("?",2)="are to be included on the report. Enter 'No' if cancelled exams"
+6 SET DIR("?")="are to be excluded from the report."
DO ^DIR
+7 if $DATA(DIRUT)
SET Y=-1
+8 QUIT Y
