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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRONAN1 2609 printed Sep 23, 2025@20:20:38 Page 2
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
