SROACCM.m

SROACCM ;BIR/MAM - TOTAL CPTS ;12/15/98  11:34 AM

 ;;3.0; Surgery ;**59,50,88,127,142**;24 Jun 93

EN ; entry when queued

 U IO S SRSOUT=0,SRINST=SRSITE("SITE") K ^TMP("SR",$J)

 N SRFRTO S Y=SDATE X ^DD("DD") S SRFRTO="FROM: "_Y_"  TO: " S Y=EDATE X ^DD("DD") S SRFRTO=SRFRTO_Y

 S SRSDT=SDATE1 F  S SRSDT=$O(^SRF("AC",SRSDT)) Q:SRSDT>EDATE1!('SRSDT)  S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN  I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D UTIL

 D HDR Q:SRSOUT

 S CPT=0 F  S CPT=$O(^TMP("SR",$J,CPT)) Q:'CPT!(SRSOUT)  D PRINT

 I '$D(^TMP("SR",$J)) W $$NODATA^SROUTL0()

 Q

PRINT ; print info

 I $Y+6>IOSL D PAGE I SRSOUT Q

 S TOT1=$S($D(^TMP("SR",$J,CPT,1)):^(1),1:0),TOT2=$S($D(^TMP("SR",$J,CPT,2)):^(2),1:0),TOT=TOT1+TOT2

 S Y=$$CPT^ICPTCOD(CPT,EDATE),CPT1=$P(Y,"^",2)_"  "_$P(Y,"^",3)

 W !,CPT1,?55,TOT,?79,TOT1,?110,TOT2,! F LINE=1:1:132 W "-"

 Q

PAGE I $E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit:  " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q

HDR ; print heading

 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q

 W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,!,?57,"SURGICAL SERVICE",?100,"REVIEWED BY",!,?50,"CUMULATIVE REPORT OF CPT CODES",?100,"DATE REVIEWED:"

 W !,?(132-$L(SRFRTO)\2),SRFRTO

 W !,$S(SRFLG=1:"O.R. SURGICAL PROCEDURES",SRFLG=2:"NON-O.R. PROCEDURES",1:"O.R. SURGICAL PROCEDURES AND NON-O.R. PROCEDURES")

 W !!,"CPT CODE - SHORT DESCRIPTION",?50,"TOTAL PROCEDURES",?72,"TOTAL PRINCIPAL PROCEDURES",?104,"TOTAL OTHER PROCEDURES",! F LINE=1:1:132 W "="

 Q

UTIL ; set ^TMP("SR")

 S SRNON=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1

 I SRFLG=1!(SRFLG=3&('SRNON)) Q:$P($G(^SRF(SRTN,.2)),"^",12)=""

 I SRFLG=2 Q:'SRNON

 I $P($G(^SRF(SRTN,30)),"^")'="" Q

 S CPT=$P($G(^SRO(136,SRTN,0)),"^",2) I CPT S X=$S($D(^TMP("SR",$J,CPT,1)):^(1),1:0),^TMP("SR",$J,CPT,1)=X+1

 S OP=0 F  S OP=$O(^SRO(136,SRTN,3,OP)) Q:'OP  I $D(^SRO(136,SRTN,3,OP,0)),$P(^(0),"^") S CPT=$P(^(0),"^") I CPT S X=$S($D(^TMP("SR",$J,CPT,2)):^(2),1:0),^TMP("SR",$J,CPT,2)=X+1

 Q

SROACCM   ;BIR/MAM - TOTAL CPTS ;12/15/98  11:34 AM

 +1       ;;3.0; Surgery ;**59,50,88,127,142**;24 Jun 93

EN        ; entry when queued

 +1        USE IO

           SET SRSOUT=0

           SET SRINST=SRSITE("SITE")

           KILL ^TMP("SR",$JOB)

 +2        NEW SRFRTO

           SET Y=SDATE

           XECUTE ^DD("DD")

           SET SRFRTO="FROM: "_Y_"  TO: "

           SET Y=EDATE

           XECUTE ^DD("DD")

           SET SRFRTO=SRFRTO_Y

 +3        SET SRSDT=SDATE1

           FOR 

               SET SRSDT=$ORDER(^SRF("AC",SRSDT))

               IF SRSDT>EDATE1!('SRSDT)

                   QUIT 

               SET SRTN=0

               FOR 

                   SET SRTN=$ORDER(^SRF("AC",SRSDT,SRTN))

                   IF 'SRTN

                       QUIT 

                   IF $DATA(^SRF(SRTN,0))

                       IF $$DIV^SROUTL0(SRTN)

                           DO UTIL

 +4        DO HDR

           IF SRSOUT

               QUIT 

 +5        SET CPT=0

           FOR 

               SET CPT=$ORDER(^TMP("SR",$JOB,CPT))

               IF 'CPT!(SRSOUT)

                   QUIT 

               DO PRINT

 +6        IF '$DATA(^TMP("SR",$JOB))

               WRITE $$NODATA^SROUTL0()

 +7        QUIT 

PRINT     ; print info

 +1        IF $Y+6>IOSL

               DO PAGE

               IF SRSOUT

                   QUIT 

 +2        SET TOT1=$SELECT($DATA(^TMP("SR",$JOB,CPT,1)):^(1),1:0)

           SET TOT2=$SELECT($DATA(^TMP("SR",$JOB,CPT,2)):^(2),1:0)

           SET TOT=TOT1+TOT2

 +3        SET Y=$$CPT^ICPTCOD(CPT,EDATE)

           SET CPT1=$PIECE(Y,"^",2)_"  "_$PIECE(Y,"^",3)

 +4        WRITE !,CPT1,?55,TOT,?79,TOT1,?110,TOT2,!

           FOR LINE=1:1:132

               WRITE "-"

 +5        QUIT 

PAGE       IF $EXTRACT(IOST)'="P"

               WRITE !!,"Press RETURN to continue, or '^' to quit:  "

               READ X:DTIME

               IF '$TEST!(X["^")

                   SET SRSOUT=1

                   QUIT 

HDR       ; print heading

 +1        IF $DATA(ZTQUEUED)

               DO ^SROSTOP

               IF SRHALT

                   SET SRSOUT=1

                   QUIT 

 +2        IF $Y

               WRITE @IOF

           WRITE !,?(132-$LENGTH(SRINST)\2),SRINST,!,?57,"SURGICAL SERVICE",?100,"REVIEWED BY",!,?50,"CUMULATIVE REPORT OF CPT CODES",?100,"DATE REVIEWED:"

 +3        WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO

 +4        WRITE !,$SELECT(SRFLG=1:"O.R. SURGICAL PROCEDURES",SRFLG=2:"NON-O.R. PROCEDURES",1:"O.R. SURGICAL PROCEDURES AND NON-O.R. PROCEDURES")

 +5        WRITE !!,"CPT CODE - SHORT DESCRIPTION",?50,"TOTAL PROCEDURES",?72,"TOTAL PRINCIPAL PROCEDURES",?104,"TOTAL OTHER PROCEDURES",!

           FOR LINE=1:1:132

               WRITE "="

 +6        QUIT 

UTIL      ; set ^TMP("SR")

 +1        SET SRNON=0

           IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"

               SET SRNON=1

 +2        IF SRFLG=1!(SRFLG=3&('SRNON))

               IF $PIECE($GET(^SRF(SRTN,.2)),"^",12)=""

                   QUIT 

 +3        IF SRFLG=2

               IF 'SRNON

                   QUIT 

 +4        IF $PIECE($GET(^SRF(SRTN,30)),"^")'=""

               QUIT 

 +5        SET CPT=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)

           IF CPT

               SET X=$SELECT($DATA(^TMP("SR",$JOB,CPT,1)):^(1),1:0)

               SET ^TMP("SR",$JOB,CPT,1)=X+1

 +6        SET OP=0

           FOR 

               SET OP=$ORDER(^SRO(136,SRTN,3,OP))

               IF 'OP

                   QUIT 

               IF $DATA(^SRO(136,SRTN,3,OP,0))

                   IF $PIECE(^(0),"^")

                       SET CPT=$PIECE(^(0),"^")

                       IF CPT

                           SET X=$SELECT($DATA(^TMP("SR",$JOB,CPT,2)):^(2),1:0)

                           SET ^TMP("SR",$JOB,CPT,2)=X+1

 +7        QUIT