[613] | 1 | SRONAN1 ;BIR/MAM - ANNUAL REPORT NON-O.R. PROCEDURES ;12/16/98 11:46 AM
|
---|
| 2 | ;;3.0; Surgery ;**50,88,127,142**;24 Jun 93
|
---|
| 3 | ;
|
---|
| 4 | ; Reference to ^ECC(723 supported by DBIA #205
|
---|
| 5 | ;
|
---|
| 6 | K ^TMP("SR",$J) S (SRHDR,SRSUMM,SRSOUT)=0,^TMP("SR",$J)=0
|
---|
| 7 | 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
|
---|
| 8 | 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
|
---|
| 9 | Q:SRSOUT S SRSUMM=1,SRSS="" D HDR Q:SRSOUT
|
---|
| 10 | S SRSS=0 F S SRSS=$O(^TMP("SR",$J,SRSS)) Q:SRSS=""!(SRSOUT) D SUM
|
---|
| 11 | W:'SRSOUT !!,?9,"TOTAL NON-O.R. PROCEDURES FOR "_SRSITE("SITE")_": "_^TMP("SR",$J)
|
---|
| 12 | Q
|
---|
| 13 | SET ; set local variables
|
---|
| 14 | I $P($G(^SRF(SROP,30)),"^") Q
|
---|
| 15 | S SRSS=$P(^SRF(SROP,"NON"),"^",8),SRCPT=$P($G(^SRO(136,SROP,0)),"^",2) I 'SRCPT Q
|
---|
| 16 | S SRSPEC=$S(SRSS:$P(^ECC(723,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED")
|
---|
| 17 | 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
|
---|
| 18 | Q
|
---|
| 19 | UTIL ; set ^TMP("SR",$J
|
---|
| 20 | S ^TMP("SR",$J)=^TMP("SR",$J)+1
|
---|
| 21 | I '$D(^TMP("SR",$J,SRSPEC)) S ^TMP("SR",$J,SRSPEC)=0
|
---|
| 22 | S ^TMP("SR",$J,SRSPEC)=^TMP("SR",$J,SRSPEC)+1
|
---|
| 23 | I '$D(^TMP("SR",$J,SRSPEC,SRCPT)) S ^TMP("SR",$J,SRSPEC,SRCPT)=1 Q
|
---|
| 24 | S ^TMP("SR",$J,SRSPEC,SRCPT)=^TMP("SR",$J,SRSPEC,SRCPT)+1
|
---|
| 25 | Q
|
---|
| 26 | CPT ; get procedure name and code
|
---|
| 27 | S X=$$CPT^ICPTCOD(SRCPT,$P(SRED,".")),SROPER=$P(X,"^",3),SRCPT=$P(X,"^",2)_" "_SROPER
|
---|
| 28 | Q
|
---|
| 29 | PRINT ; print CPT info
|
---|
| 30 | I $Y+5>IOSL D HDR Q:SRSOUT
|
---|
| 31 | W !,SRCPT,?66,^TMP("SR",$J,SRSS,SRCPT)
|
---|
| 32 | Q
|
---|
| 33 | SUM ; print summary
|
---|
| 34 | I $Y+5>IOSL D HDR Q:SRSOUT
|
---|
| 35 | W !,SRSS,?42,"TOTAL NON-O.R. PROCEDURES: ",?67,^TMP("SR",$J,SRSS)
|
---|
| 36 | Q
|
---|
| 37 | HDR1 ; print heading to screen
|
---|
| 38 | I SRHDR W !!!!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
|
---|
| 39 | W @IOF,!,?22,"ANNUAL REPORT OF NON-O.R. PROCEDURES" I SRSUMM W !,?27,"SUMMARY OF ALL SPECIALTIES"
|
---|
| 40 | W !,?(80-$L(SRFRTO)\2),SRFRTO,! F LINE=1:1:80 W "="
|
---|
| 41 | W:'SRSUMM&(SRSS'="") !!,?(80-$L(SRSS)\2),SRSS,! S SRHDR=1
|
---|
| 42 | Q
|
---|
| 43 | HDR ; print heading
|
---|
| 44 | I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
|
---|
| 45 | I $E(IOST)'="P" D HDR1 Q
|
---|
| 46 | 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:"
|
---|
| 47 | I SRSUMM W !,?27,"SUMMARY OF ALL SPECIALTIES"
|
---|
| 48 | W !,?(80-$L(SRFRTO)\2),SRFRTO I 'SRSUMM W !!,"CPT - PROCEDURE",?30,"SPECIALTY",?65,"TOTAL"
|
---|
| 49 | W ! F LINE=1:1:80 W "="
|
---|
| 50 | W:'SRSUMM&(SRSS'="") !!,?(80-$L(SRSS)\2),SRSS,! S SRHDR=1
|
---|
| 51 | Q
|
---|