RACPT1.m

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

RACPT1    ;HISC/GJC,FPT-Procedure/CPT Stats Report ;12/29/00  11:28

 +1       ;;5.0;Radiology/Nuclear Medicine;**26,69**;Mar 16, 1998

 +2       ;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       ;cost per unit

           IF $GET(RACMLIST)

               WRITE !,$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)

 +5       ;occurrence * cost per unit

           SET RATOT(2)=RATOT*RATOT(1)

 +6        SET RATOT(4)=$GET(^TMP($JOB,"RA",RAI,RADIV,RAIMAG(1),"DONE"))

 +7        SET RATOT(5)=$GET(^TMP($JOB,"RA",RAI,RADIV,RAIMAG(1),"COST"))

 +8        WRITE ?45,$JUSTIFY(RATOT,5),?52,$SELECT(RATOT(4)=0:$JUSTIFY(0,3,0),1:$JUSTIFY(RATOT/RATOT(4)*100,3,0))

 +9        WRITE ?56,$JUSTIFY(RATOT(1),8,2)

 +10       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))

 +11       IF $EXTRACT(IOST,1,2)="C-"

               IF $Y+4>IOSL

                   DO HANG1

                   IF 'RAEXIT

                       DO HED

 +12       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