| 1 | SROAR1 ;BIR/MAM - ANNUAL REPORT, ALL SPECIALTIES ;11/17/99 6:25 AM
|
---|
| 2 | ;;3.0; Surgery ;**34,50,88,127,142**;24 Jun 93
|
---|
| 3 | S (GRAND,GMAJ,GMIN,GMAS,GMAR,GMIS,GMIR)=0 K ^TMP("SR",$J) S PAGE=1
|
---|
| 4 | D HDR Q:SRHALT S SRSDATE=SDATE1 F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:SRSDATE>EDATE1!('SRSDATE)!SRHALT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN!SRHALT I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D SET
|
---|
| 5 | S SRSS=0 F S SRSS=$O(^TMP("SR",$J,SRSS)) Q:SRSS=""!SRHALT D SPEC S SRCPT=0 F S SRCPT=$O(^TMP("SR",$J,SRSS,SRCPT)) D:SRCPT="" TOTS Q:SRCPT=""!SRHALT D OUT
|
---|
| 6 | W !!! F LINE=1:1:132 W "="
|
---|
| 7 | D:$Y+6>IOSL HDR Q:SRHALT W !!,"TOTAL OPERATIONS:",?50,GRAND,?68,GMAS,?77,GMAR,?88,GMAJ,?103,GMIS,?112,GMIR,?124,GMIN,!! F I=1:1:132 W "="
|
---|
| 8 | Q
|
---|
| 9 | SPEC ; specialty heading
|
---|
| 10 | D:$Y+5>IOSL HDR Q:SRHALT W !,?(132-$L(SRSS)\2),SRSS,! F LINE=1:1:132 W "-"
|
---|
| 11 | S (TOTAL,TOTMAJ,TOTMIN,TOTMAS,TOTMAR,TOTMIS,TOTMIR)=0
|
---|
| 12 | Q
|
---|
| 13 | HDR ; print heading
|
---|
| 14 | I $D(ZTQUEUED) D ^SROSTOP Q:SRHALT
|
---|
| 15 | W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,?120,"PAGE: "_PAGE,!,?58,"SURGICAL SERVICE",?100,"REVIEWED BY:",!,?48,"ANNUAL REPORT OF SURGICAL PROCEDURES",?100,"DATE REVIEWED:"
|
---|
| 16 | W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT
|
---|
| 17 | W !!,?75,"MAJOR",?110,"MINOR",!,"CPT CODE - OPERATION",?48,"TOTAL",?67,"STAFF",?74,"RESIDENT",?87,"TOTAL",?102,"STAFF",?109,"RESIDENT",?122,"TOTAL",! F I=1:1:132 W "-"
|
---|
| 18 | S PAGE=PAGE+1
|
---|
| 19 | Q
|
---|
| 20 | OUT ; print info
|
---|
| 21 | K MAJR,MAJS,MAJT,MINR,MINS,MINT I $Y+5>IOSL D HDR Q:SRHALT W !,?(132-$L(SRSS)\2),SRSS,! F LINE=1:1:132 W "-"
|
---|
| 22 | S SRCPT("NAME")=SRCPT_" "_^TMP("SR",$J,SRSS,SRCPT)
|
---|
| 23 | S (MAJS,MAJR,MINS,MINR)=0
|
---|
| 24 | I $D(^TMP("SR",$J,SRSS,SRCPT,"J","S")) S MAJS=^("S")
|
---|
| 25 | I $D(^TMP("SR",$J,SRSS,SRCPT,"J","R")) S MAJR=^("R")
|
---|
| 26 | I $D(^TMP("SR",$J,SRSS,SRCPT,"N","S")) S MINS=^("S")
|
---|
| 27 | I $D(^TMP("SR",$J,SRSS,SRCPT,"N","R")) S MINR=^("R")
|
---|
| 28 | S MAJT=MAJR+MAJS,MINT=MINR+MINS,SUBT=MAJT+MINT,TOTAL=TOTAL+SUBT,TOTMAJ=TOTMAJ+MAJT,TOTMIN=TOTMIN+MINT,TOTMAS=TOTMAS+MAJS,TOTMAR=TOTMAR+MAJR,TOTMIS=TOTMIS+MINS,TOTMIR=TOTMIR+MINR
|
---|
| 29 | W !,SRCPT("NAME"),?50,SUBT,?68,MAJS,?77,MAJR,?88,MAJT,?103,MINS,?112,MINR,?124,MINT
|
---|
| 30 | Q
|
---|
| 31 | SET ; set local variables
|
---|
| 32 | Q:'$D(^SRF(SRTN,.2)) I $P(^SRF(SRTN,.2),"^",12)="" Q
|
---|
| 33 | I $D(^SRF(SRTN,30)),$P(^(30),"^")'="" Q
|
---|
| 34 | I $D(^SRF(SRTN,31)),$P(^(31),"^",8)'="" Q
|
---|
| 35 | K CPT S SR(0)=^SRF(SRTN,0),SRSS=$P(SR(0),"^",4) S SRSS=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED")
|
---|
| 36 | S SRMAJ=$P(SR(0),"^",3) S:SRMAJ="" SRMAJ="N"
|
---|
| 37 | S SRATT=$P($G(^SRF(SRTN,.1)),"^",3) S:SRATT="" SRATT="R"
|
---|
| 38 | S (CPT,CNT)=0 F S CPT=$O(^SRO(136,SRTN,3,CPT)) Q:CPT="" S CNT=CNT+1 S Y=$P($G(^SRO(136,SRTN,3,CPT,0)),"^") I Y S X=$$CPT^ICPTCOD(Y,$P(^SRF(SRTN,0),"^",9)),CPT(CNT)=$P(X,"^",2,3)
|
---|
| 39 | S CPT("*")=$P($G(^SRO(136,SRTN,0)),"^",2) I CPT("*")'="" S X=$$CPT^ICPTCOD(CPT("*"),$P(^SRF(SRTN,0),"^",9)),CPT("*")=$P(X,"^",2,3)
|
---|
| 40 | S CPT=0 F S CPT=$O(CPT(CPT)) Q:CPT="" I CPT(CPT)'="" D SETUTL
|
---|
| 41 | Q
|
---|
| 42 | SETUTL ; set ^TMP("SR",$J)
|
---|
| 43 | S SRCPT=$P(CPT(CPT),"^"),FLAG=0
|
---|
| 44 | I $D(^TMP("SR",$J,SRSS,SRCPT,SRMAJ,SRATT)) S ^TMP("SR",$J,SRSS,SRCPT,SRMAJ,SRATT)=^TMP("SR",$J,SRSS,SRCPT,SRMAJ,SRATT)+1,FLAG=1
|
---|
| 45 | I FLAG Q
|
---|
| 46 | S ^TMP("SR",$J,SRSS,SRCPT,SRMAJ,SRATT)=1,^TMP("SR",$J,SRSS,SRCPT)=$P(CPT(CPT),"^",2)
|
---|
| 47 | Q
|
---|
| 48 | TOTS W !!! F I=1:1:132 W "-"
|
---|
| 49 | D:$Y+5>IOSL HDR Q:SRHALT W !,"TOTALS FOR "_SRSS_": ",?50,TOTAL,?68,TOTMAS,?77,TOTMAR,?88,TOTMAJ,?103,TOTMIS,?112,TOTMIR,?124,TOTMIN,! F LINE=1:1:132 W "-"
|
---|
| 50 | GRAND S GRAND=GRAND+TOTAL,GMAS=GMAS+TOTMAS,GMAR=GMAR+TOTMAR,GMIS=GMIS+TOTMIS,GMIR=GMIR+TOTMIR,GMAJ=GMAJ+TOTMAJ,GMIN=GMIN+TOTMIN
|
---|
| 51 | Q
|
---|