VistA-WorldVistAEHR/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RACPT1.m

95 lines
4.5 KiB
Mathematica
Raw Permalink Normal View History

2009-11-29 13:37:14 -05:00
RACPT1 ;HISC/GJC,FPT-Procedure/CPT Stats Report ;12/29/00 11:28
;;5.0;Radiology/Nuclear Medicine;**26,69**;Mar 16, 1998
;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
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