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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAR1 3464 printed Nov 22, 2024@17:51:48 Page 2
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
