- SRONAN1 ;BIR/MAM - ANNUAL REPORT NON-O.R. PROCEDURES ;12/16/98 11:46 AM
- ;;3.0; Surgery ;**50,88,127,142**;24 Jun 93
- ;
- ; Reference to ^ECC(723 supported by DBIA #205
- ;
- K ^TMP("SR",$J) S (SRHDR,SRSUMM,SRSOUT)=0,^TMP("SR",$J)=0
- F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED) S SROP=0 F S SROP=$O(^SRF("AC",SRSD,SROP)) Q:'SROP I $P($G(^SRF(SROP,"NON")),"^")="Y",$D(^SRF(SROP,0)),$$DIV^SROUTL0(SROP) D SET
- S SRSS=0 F S SRSS=$O(^TMP("SR",$J,SRSS)) Q:SRSS=""!SRSOUT D HDR Q:SRSOUT S SRCPT=0 F S SRCPT=$O(^TMP("SR",$J,SRSS,SRCPT)) Q:SRCPT=""!SRSOUT D PRINT
- Q:SRSOUT S SRSUMM=1,SRSS="" D HDR Q:SRSOUT
- S SRSS=0 F S SRSS=$O(^TMP("SR",$J,SRSS)) Q:SRSS=""!(SRSOUT) D SUM
- W:'SRSOUT !!,?9,"TOTAL NON-O.R. PROCEDURES FOR "_SRSITE("SITE")_": "_^TMP("SR",$J)
- Q
- SET ; set local variables
- I $P($G(^SRF(SROP,30)),"^") Q
- S SRSS=$P(^SRF(SROP,"NON"),"^",8),SRCPT=$P($G(^SRO(136,SROP,0)),"^",2) I 'SRCPT Q
- S SRSPEC=$S(SRSS:$P(^ECC(723,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED")
- D CPT,UTIL S SROTH=0 F S SROTH=$O(^SRO(136,SROP,3,SROTH)) Q:'SROTH S SRCPT=$P($G(^SRO(136,SROP,3,SROTH,0)),"^") I SRCPT D CPT,UTIL
- Q
- UTIL ; set ^TMP("SR",$J
- S ^TMP("SR",$J)=^TMP("SR",$J)+1
- I '$D(^TMP("SR",$J,SRSPEC)) S ^TMP("SR",$J,SRSPEC)=0
- S ^TMP("SR",$J,SRSPEC)=^TMP("SR",$J,SRSPEC)+1
- I '$D(^TMP("SR",$J,SRSPEC,SRCPT)) S ^TMP("SR",$J,SRSPEC,SRCPT)=1 Q
- S ^TMP("SR",$J,SRSPEC,SRCPT)=^TMP("SR",$J,SRSPEC,SRCPT)+1
- Q
- CPT ; get procedure name and code
- S X=$$CPT^ICPTCOD(SRCPT,$P(SRED,".")),SROPER=$P(X,"^",3),SRCPT=$P(X,"^",2)_" "_SROPER
- Q
- PRINT ; print CPT info
- I $Y+5>IOSL D HDR Q:SRSOUT
- W !,SRCPT,?66,^TMP("SR",$J,SRSS,SRCPT)
- Q
- SUM ; print summary
- I $Y+5>IOSL D HDR Q:SRSOUT
- W !,SRSS,?42,"TOTAL NON-O.R. PROCEDURES: ",?67,^TMP("SR",$J,SRSS)
- Q
- HDR1 ; print heading to screen
- I SRHDR W !!!!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
- W @IOF,!,?22,"ANNUAL REPORT OF NON-O.R. PROCEDURES" I SRSUMM W !,?27,"SUMMARY OF ALL SPECIALTIES"
- W !,?(80-$L(SRFRTO)\2),SRFRTO,! F LINE=1:1:80 W "="
- W:'SRSUMM&(SRSS'="") !!,?(80-$L(SRSS)\2),SRSS,! S SRHDR=1
- Q
- HDR ; print heading
- I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
- I $E(IOST)'="P" D HDR1 Q
- W:$Y @IOF W !,?(80-$L(SRINST)\2),SRINST,?65,"REVIEWED BY:",!,?32,"SURGICAL SERVICE",!,?22,"ANNUAL REPORT OF NON-O.R. PROCEDURES",?65,"DATE REVIEWED:"
- I SRSUMM W !,?27,"SUMMARY OF ALL SPECIALTIES"
- W !,?(80-$L(SRFRTO)\2),SRFRTO I 'SRSUMM W !!,"CPT - PROCEDURE",?30,"SPECIALTY",?65,"TOTAL"
- W ! F LINE=1:1:80 W "="
- W:'SRSUMM&(SRSS'="") !!,?(80-$L(SRSS)\2),SRSS,! S SRHDR=1
- Q
- SRONAN1 ;BIR/MAM - ANNUAL REPORT NON-O.R. PROCEDURES ;12/16/98 11:46 AM
- +1 ;;3.0; Surgery ;**50,88,127,142**;24 Jun 93
- +2 ;
- +3 ; Reference to ^ECC(723 supported by DBIA #205
- +4 ;
- +5 KILL ^TMP("SR",$JOB)
- SET (SRHDR,SRSUMM,SRSOUT)=0
- SET ^TMP("SR",$JOB)=0
- +6 FOR
- SET SRSD=$ORDER(^SRF("AC",SRSD))
- IF 'SRSD!(SRSD>SRED)
- QUIT
- SET SROP=0
- FOR
- SET SROP=$ORDER(^SRF("AC",SRSD,SROP))
- IF 'SROP
- QUIT
- IF $PIECE($GET(^SRF(SROP,"NON")),"^")="Y"
- IF $DATA(^SRF(SROP,0))
- IF $$DIV^SROUTL0(SROP)
- DO SET
- +7 SET SRSS=0
- FOR
- SET SRSS=$ORDER(^TMP("SR",$JOB,SRSS))
- IF SRSS=""!SRSOUT
- QUIT
- DO HDR
- IF SRSOUT
- QUIT
- SET SRCPT=0
- FOR
- SET SRCPT=$ORDER(^TMP("SR",$JOB,SRSS,SRCPT))
- IF SRCPT=""!SRSOUT
- QUIT
- DO PRINT
- +8 IF SRSOUT
- QUIT
- SET SRSUMM=1
- SET SRSS=""
- DO HDR
- IF SRSOUT
- QUIT
- +9 SET SRSS=0
- FOR
- SET SRSS=$ORDER(^TMP("SR",$JOB,SRSS))
- IF SRSS=""!(SRSOUT)
- QUIT
- DO SUM
- +10 IF 'SRSOUT
- WRITE !!,?9,"TOTAL NON-O.R. PROCEDURES FOR "_SRSITE("SITE")_": "_^TMP("SR",$JOB)
- +11 QUIT
- SET ; set local variables
- +1 IF $PIECE($GET(^SRF(SROP,30)),"^")
- QUIT
- +2 SET SRSS=$PIECE(^SRF(SROP,"NON"),"^",8)
- SET SRCPT=$PIECE($GET(^SRO(136,SROP,0)),"^",2)
- IF 'SRCPT
- QUIT
- +3 SET SRSPEC=$SELECT(SRSS:$PIECE(^ECC(723,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED")
- +4 DO CPT
- DO UTIL
- SET SROTH=0
- FOR
- SET SROTH=$ORDER(^SRO(136,SROP,3,SROTH))
- IF 'SROTH
- QUIT
- SET SRCPT=$PIECE($GET(^SRO(136,SROP,3,SROTH,0)),"^")
- IF SRCPT
- DO CPT
- DO UTIL
- +5 QUIT
- UTIL ; set ^TMP("SR",$J
- +1 SET ^TMP("SR",$JOB)=^TMP("SR",$JOB)+1
- +2 IF '$DATA(^TMP("SR",$JOB,SRSPEC))
- SET ^TMP("SR",$JOB,SRSPEC)=0
- +3 SET ^TMP("SR",$JOB,SRSPEC)=^TMP("SR",$JOB,SRSPEC)+1
- +4 IF '$DATA(^TMP("SR",$JOB,SRSPEC,SRCPT))
- SET ^TMP("SR",$JOB,SRSPEC,SRCPT)=1
- QUIT
- +5 SET ^TMP("SR",$JOB,SRSPEC,SRCPT)=^TMP("SR",$JOB,SRSPEC,SRCPT)+1
- +6 QUIT
- CPT ; get procedure name and code
- +1 SET X=$$CPT^ICPTCOD(SRCPT,$PIECE(SRED,"."))
- SET SROPER=$PIECE(X,"^",3)
- SET SRCPT=$PIECE(X,"^",2)_" "_SROPER
- +2 QUIT
- PRINT ; print CPT info
- +1 IF $Y+5>IOSL
- DO HDR
- IF SRSOUT
- QUIT
- +2 WRITE !,SRCPT,?66,^TMP("SR",$JOB,SRSS,SRCPT)
- +3 QUIT
- SUM ; print summary
- +1 IF $Y+5>IOSL
- DO HDR
- IF SRSOUT
- QUIT
- +2 WRITE !,SRSS,?42,"TOTAL NON-O.R. PROCEDURES: ",?67,^TMP("SR",$JOB,SRSS)
- +3 QUIT
- HDR1 ; print heading to screen
- +1 IF SRHDR
- WRITE !!!!,"Press RETURN to continue, or '^' to quit: "
- READ X:DTIME
- IF '$TEST!(X["^")
- SET SRSOUT=1
- QUIT
- +2 WRITE @IOF,!,?22,"ANNUAL REPORT OF NON-O.R. PROCEDURES"
- IF SRSUMM
- WRITE !,?27,"SUMMARY OF ALL SPECIALTIES"
- +3 WRITE !,?(80-$LENGTH(SRFRTO)\2),SRFRTO,!
- FOR LINE=1:1:80
- WRITE "="
- +4 IF 'SRSUMM&(SRSS'="")
- WRITE !!,?(80-$LENGTH(SRSS)\2),SRSS,!
- SET SRHDR=1
- +5 QUIT
- HDR ; print heading
- +1 IF $DATA(ZTQUEUED)
- DO ^SROSTOP
- IF SRHALT
- SET SRSOUT=1
- QUIT
- +2 IF $EXTRACT(IOST)'="P"
- DO HDR1
- QUIT
- +3 IF $Y
- WRITE @IOF
- WRITE !,?(80-$LENGTH(SRINST)\2),SRINST,?65,"REVIEWED BY:",!,?32,"SURGICAL SERVICE",!,?22,"ANNUAL REPORT OF NON-O.R. PROCEDURES",?65,"DATE REVIEWED:"
- +4 IF SRSUMM
- WRITE !,?27,"SUMMARY OF ALL SPECIALTIES"
- +5 WRITE !,?(80-$LENGTH(SRFRTO)\2),SRFRTO
- IF 'SRSUMM
- WRITE !!,"CPT - PROCEDURE",?30,"SPECIALTY",?65,"TOTAL"
- +6 WRITE !
- FOR LINE=1:1:80
- WRITE "="
- +7 IF 'SRSUMM&(SRSS'="")
- WRITE !!,?(80-$LENGTH(SRSS)\2),SRSS,!
- SET SRHDR=1
- +8 QUIT
