- SROAR1 ;BIR/MAM - ANNUAL REPORT, ALL SPECIALTIES ;11/17/99 6:25 AM
- ;;3.0; Surgery ;**34,50,88,127,142**;24 Jun 93
- S (GRAND,GMAJ,GMIN,GMAS,GMAR,GMIS,GMIR)=0 K ^TMP("SR",$J) S PAGE=1
- 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
- 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
- W !!! F LINE=1:1:132 W "="
- 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 "="
- Q
- SPEC ; specialty heading
- D:$Y+5>IOSL HDR Q:SRHALT W !,?(132-$L(SRSS)\2),SRSS,! F LINE=1:1:132 W "-"
- S (TOTAL,TOTMAJ,TOTMIN,TOTMAS,TOTMAR,TOTMIS,TOTMIR)=0
- Q
- HDR ; print heading
- I $D(ZTQUEUED) D ^SROSTOP Q:SRHALT
- 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:"
- W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT
- 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 "-"
- S PAGE=PAGE+1
- Q
- OUT ; print info
- 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 "-"
- S SRCPT("NAME")=SRCPT_" "_^TMP("SR",$J,SRSS,SRCPT)
- S (MAJS,MAJR,MINS,MINR)=0
- I $D(^TMP("SR",$J,SRSS,SRCPT,"J","S")) S MAJS=^("S")
- I $D(^TMP("SR",$J,SRSS,SRCPT,"J","R")) S MAJR=^("R")
- I $D(^TMP("SR",$J,SRSS,SRCPT,"N","S")) S MINS=^("S")
- I $D(^TMP("SR",$J,SRSS,SRCPT,"N","R")) S MINR=^("R")
- 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
- W !,SRCPT("NAME"),?50,SUBT,?68,MAJS,?77,MAJR,?88,MAJT,?103,MINS,?112,MINR,?124,MINT
- Q
- SET ; set local variables
- Q:'$D(^SRF(SRTN,.2)) I $P(^SRF(SRTN,.2),"^",12)="" Q
- I $D(^SRF(SRTN,30)),$P(^(30),"^")'="" Q
- I $D(^SRF(SRTN,31)),$P(^(31),"^",8)'="" Q
- 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")
- S SRMAJ=$P(SR(0),"^",3) S:SRMAJ="" SRMAJ="N"
- S SRATT=$P($G(^SRF(SRTN,.1)),"^",3) S:SRATT="" SRATT="R"
- 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)
- 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)
- S CPT=0 F S CPT=$O(CPT(CPT)) Q:CPT="" I CPT(CPT)'="" D SETUTL
- Q
- SETUTL ; set ^TMP("SR",$J)
- S SRCPT=$P(CPT(CPT),"^"),FLAG=0
- 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
- I FLAG Q
- S ^TMP("SR",$J,SRSS,SRCPT,SRMAJ,SRATT)=1,^TMP("SR",$J,SRSS,SRCPT)=$P(CPT(CPT),"^",2)
- Q
- TOTS W !!! F I=1:1:132 W "-"
- 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 "-"
- GRAND S GRAND=GRAND+TOTAL,GMAS=GMAS+TOTMAS,GMAR=GMAR+TOTMAR,GMIS=GMIS+TOTMIS,GMIR=GMIR+TOTMIR,GMAJ=GMAJ+TOTMAJ,GMIN=GMIN+TOTMIN
- Q
- SROAR1 ;BIR/MAM - ANNUAL REPORT, ALL SPECIALTIES ;11/17/99 6:25 AM
- +1 ;;3.0; Surgery ;**34,50,88,127,142**;24 Jun 93
- +2 SET (GRAND,GMAJ,GMIN,GMAS,GMAR,GMIS,GMIR)=0
- KILL ^TMP("SR",$JOB)
- SET PAGE=1
- +3 DO HDR
- IF SRHALT
- QUIT
- SET SRSDATE=SDATE1
- FOR
- SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))
- IF SRSDATE>EDATE1!('SRSDATE)!SRHALT
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))
- IF 'SRTN!SRHALT
- QUIT
- IF $DATA(^SRF(SRTN,0))
- IF $$DIV^SROUTL0(SRTN)
- DO SET
- +4 SET SRSS=0
- FOR
- SET SRSS=$ORDER(^TMP("SR",$JOB,SRSS))
- IF SRSS=""!SRHALT
- QUIT
- DO SPEC
- SET SRCPT=0
- FOR
- SET SRCPT=$ORDER(^TMP("SR",$JOB,SRSS,SRCPT))
- IF SRCPT=""
- DO TOTS
- IF SRCPT=""!SRHALT
- QUIT
- DO OUT
- +5 WRITE !!!
- FOR LINE=1:1:132
- WRITE "="
- +6 IF $Y+6>IOSL
- DO HDR
- IF SRHALT
- QUIT
- WRITE !!,"TOTAL OPERATIONS:",?50,GRAND,?68,GMAS,?77,GMAR,?88,GMAJ,?103,GMIS,?112,GMIR,?124,GMIN,!!
- FOR I=1:1:132
- WRITE "="
- +7 QUIT
- SPEC ; specialty heading
- +1 IF $Y+5>IOSL
- DO HDR
- IF SRHALT
- QUIT
- WRITE !,?(132-$LENGTH(SRSS)\2),SRSS,!
- FOR LINE=1:1:132
- WRITE "-"
- +2 SET (TOTAL,TOTMAJ,TOTMIN,TOTMAS,TOTMAR,TOTMIS,TOTMIR)=0
- +3 QUIT
- HDR ; print heading
- +1 IF $DATA(ZTQUEUED)
- DO ^SROSTOP
- IF SRHALT
- QUIT
- +2 IF $Y
- WRITE @IOF
- WRITE !,?(132-$LENGTH(SRINST)\2),SRINST,?120,"PAGE: "_PAGE,!,?58,"SURGICAL SERVICE",?100,"REVIEWED BY:",!,?48,"ANNUAL REPORT OF SURGICAL PROCEDURES",?100,"DATE REVIEWED:"
- +3 WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO,?100,SRPRINT
- +4 WRITE !!,?75,"MAJOR",?110,"MINOR",!,"CPT CODE - OPERATION",?48,"TOTAL",?67,"STAFF",?74,"RESIDENT",?87,"TOTAL",?102,"STAFF",?109,"RESIDENT",?122,"TOTAL",!
- FOR I=1:1:132
- WRITE "-"
- +5 SET PAGE=PAGE+1
- +6 QUIT
- OUT ; print info
- +1 KILL MAJR,MAJS,MAJT,MINR,MINS,MINT
- IF $Y+5>IOSL
- DO HDR
- IF SRHALT
- QUIT
- WRITE !,?(132-$LENGTH(SRSS)\2),SRSS,!
- FOR LINE=1:1:132
- WRITE "-"
- +2 SET SRCPT("NAME")=SRCPT_" "_^TMP("SR",$JOB,SRSS,SRCPT)
- +3 SET (MAJS,MAJR,MINS,MINR)=0
- +4 IF $DATA(^TMP("SR",$JOB,SRSS,SRCPT,"J","S"))
- SET MAJS=^("S")
- +5 IF $DATA(^TMP("SR",$JOB,SRSS,SRCPT,"J","R"))
- SET MAJR=^("R")
- +6 IF $DATA(^TMP("SR",$JOB,SRSS,SRCPT,"N","S"))
- SET MINS=^("S")
- +7 IF $DATA(^TMP("SR",$JOB,SRSS,SRCPT,"N","R"))
- SET MINR=^("R")
- +8 SET MAJT=MAJR+MAJS
- SET MINT=MINR+MINS
- SET SUBT=MAJT+MINT
- SET TOTAL=TOTAL+SUBT
- SET TOTMAJ=TOTMAJ+MAJT
- SET TOTMIN=TOTMIN+MINT
- SET TOTMAS=TOTMAS+MAJS
- SET TOTMAR=TOTMAR+MAJR
- SET TOTMIS=TOTMIS+MINS
- SET TOTMIR=TOTMIR+MINR
- +9 WRITE !,SRCPT("NAME"),?50,SUBT,?68,MAJS,?77,MAJR,?88,MAJT,?103,MINS,?112,MINR,?124,MINT
- +10 QUIT
- SET ; set local variables
- +1 IF '$DATA(^SRF(SRTN,.2))
- QUIT
- IF $PIECE(^SRF(SRTN,.2),"^",12)=""
- QUIT
- +2 IF $DATA(^SRF(SRTN,30))
- IF $PIECE(^(30),"^")'=""
- QUIT
- +3 IF $DATA(^SRF(SRTN,31))
- IF $PIECE(^(31),"^",8)'=""
- QUIT
- +4 KILL CPT
- SET SR(0)=^SRF(SRTN,0)
- SET SRSS=$PIECE(SR(0),"^",4)
- SET SRSS=$SELECT(SRSS:$PIECE(^SRO(137.45,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED")
- +5 SET SRMAJ=$PIECE(SR(0),"^",3)
- IF SRMAJ=""
- SET SRMAJ="N"
- +6 SET SRATT=$PIECE($GET(^SRF(SRTN,.1)),"^",3)
- IF SRATT=""
- SET SRATT="R"
- +7 SET (CPT,CNT)=0
- FOR
- SET CPT=$ORDER(^SRO(136,SRTN,3,CPT))
- IF CPT=""
- QUIT
- SET CNT=CNT+1
- SET Y=$PIECE($GET(^SRO(136,SRTN,3,CPT,0)),"^")
- IF Y
- SET X=$$CPT^ICPTCOD(Y,$PIECE(^SRF(SRTN,0),"^",9))
- SET CPT(CNT)=$PIECE(X,"^",2,3)
- +8 SET CPT("*")=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
- IF CPT("*")'=""
- SET X=$$CPT^ICPTCOD(CPT("*"),$PIECE(^SRF(SRTN,0),"^",9))
- SET CPT("*")=$PIECE(X,"^",2,3)
- +9 SET CPT=0
- FOR
- SET CPT=$ORDER(CPT(CPT))
- IF CPT=""
- QUIT
- IF CPT(CPT)'=""
- DO SETUTL
- +10 QUIT
- SETUTL ; set ^TMP("SR",$J)
- +1 SET SRCPT=$PIECE(CPT(CPT),"^")
- SET FLAG=0
- +2 IF $DATA(^TMP("SR",$JOB,SRSS,SRCPT,SRMAJ,SRATT))
- SET ^TMP("SR",$JOB,SRSS,SRCPT,SRMAJ,SRATT)=^TMP("SR",$JOB,SRSS,SRCPT,SRMAJ,SRATT)+1
- SET FLAG=1
- +3 IF FLAG
- QUIT
- +4 SET ^TMP("SR",$JOB,SRSS,SRCPT,SRMAJ,SRATT)=1
- SET ^TMP("SR",$JOB,SRSS,SRCPT)=$PIECE(CPT(CPT),"^",2)
- +5 QUIT
- TOTS WRITE !!!
- FOR I=1:1:132
- WRITE "-"
- +1 IF $Y+5>IOSL
- DO HDR
- IF SRHALT
- QUIT
- WRITE !,"TOTALS FOR "_SRSS_": ",?50,TOTAL,?68,TOTMAS,?77,TOTMAR,?88,TOTMAJ,?103,TOTMIS,?112,TOTMIR,?124,TOTMIN,!
- FOR LINE=1:1:132
- WRITE "-"
- GRAND SET GRAND=GRAND+TOTAL
- SET GMAS=GMAS+TOTMAS
- SET GMAR=GMAR+TOTMAR
- SET GMIS=GMIS+TOTMIS
- SET GMIR=GMIR+TOTMIR
- SET GMAJ=GMAJ+TOTMAJ
- SET GMIN=GMIN+TOTMIN
- +1 QUIT
