SROAT2P.m

SROAT2P ;B'HAM ISC/MAM - ATTENDING SURGEON REPORT (CONT.) ; [ 05/11/04  11:29 AM ]

 ;;3.0; Surgery ;**52,50,129**;24 Jun 93

 S (SRHDR,SRSS)=0,SRPAGE=1

 F  S SRSS=$O(^TMP("SR",$J,SRSS)) Q:SRSS=""!(SRSOUT)  S (SRHDR,SRNEW)=0 D PAGE S SRATT=0 F  S SRATT=$O(^TMP("SR",$J,SRSS,SRATT)) Q:SRATT=""!(SRSOUT)  S SRHDR=1 D MORE

 I '$D(^TMP("SR",$J)) D HDR W $$NODATA^SROUTL0()

 Q

MORE S SRATT1="ATTENDING SURGEON: "_$S($E(SRATT,1,3)'="ZZ ":SRATT,1:$E(SRATT,4,99)) D  Q:SRSOUT

 .I 'SRB D:$Y+11>IOSL PAGE Q:SRSOUT  D AT

 .I SRB D:SRNEW PAGE Q:SRSOUT  D:'SRNEW AT S SRNEW=1

 S SRATC="" F  S SRATC=$O(^TMP("SR",$J,SRSS,SRATT,SRATC)) Q:SRATC=""!(SRSOUT)  S SRSDATE=0 F  S SRSDATE=$O(^TMP("SR",$J,SRSS,SRATT,SRATC,SRSDATE)) Q:'SRSDATE  D CASE

 Q

CASE S SRTN=0 F  S SRTN=$O(^TMP("SR",$J,SRSS,SRATT,SRATC,SRSDATE,SRTN)) Q:'SRTN!(SRSOUT)  D SET

 Q

SET ; print case

 I $Y+7>IOSL S SRHDR=1 D PAGE Q:SRSOUT

 K SRCODE S CODE=SRATC I 'CODE S SRCODE="ATTENDING CODE NOT ENTERED"

 I CODE S Y=CODE,C=$P(^DD(130,.166,0),"^",2) D Y^DIQ S SRCODE=Y

 S:SRCODE<36 SRCODE(1)=SRCODE I $L(SRCODE)>35 D

 .N I,J,X,Y S X=SRCODE F I=0:1:34 S J=35-I,Y=$E(X,J) I Y=" " S SRCODE(1)=$E(X,1,J-1) S SRCODE(2)=$E(X,J+1,$L(X)) Q

 S SRDT=$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3),SR(0)=^SRF(SRTN,0),DFN=$P(SR(0),"^") D DEM^VADPT

 S SRDIAG=$S($D(^SRF(SRTN,34)):$P(^(34),"^"),1:"POSTOPERATIVE DIAGNOSIS NOT ENTERED")

 S SR(.1)=$S($D(^SRF(SRTN,.1)):^(.1),1:""),SRSUR=$P(SR(.1),"^",4),SRFST=$P(SR(.1),"^",5),SRTWO=$P(SR(.1),"^",6)

 I SRSUR S SRSUR=$P(^VA(200,SRSUR,0),"^") I $L(SRSUR)>17 S SRSUR=$P(SRSUR,",")_","_$E($P(SRSUR,",",2))

 I SRFST S SRFST=$P(^VA(200,SRFST,0),"^") I $L(SRFST)>17 S SRFST=$P(SRFST,",")_","_$E($P(SRFST,",",2))

 I SRTWO S SRTWO=$P(^VA(200,SRTWO,0),"^") I $L(SRTWO)>17 S SRTWO=$P(SRTWO,",")_","_$E($P(SRTWO,",",2))

OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F I=0:0 S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER=""  D OTHER

 K SROP,MM,MMM S:$L(SROPER)<55 SROP(1)=SROPER I $L(SROPER)>54 S SROPER=SROPER_"  " S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""

 W !!,SRDT,?12,VADM(1),?50,SRDIAG,?112,SRSUR,!,SRTN,?12,VA("PID"),?50,SROP(1),?112,SRFST,! W:$P($G(^SRF(SRTN,30)),"^") "ABORTED" W ?12,SRCODE(1) W:$D(SROP(2)) ?50,SROP(2) W ?112,SRTWO

 I $D(SRCODE(2))!$D(SROP(3)) W ! W:$D(SRCODE(2)) ?13,SRCODE(2) W:$D(SROP(3)) ?50,SROP(3)

 I $D(SROP(4)) W !,?50,SROP(4)

 Q

OTHER ; other operations

 S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>240 S SRLONG=0,OPER=999,SROPERS=" ..."

 I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")

 S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)

 Q

LOOP ; break procedure if greater than 55 characters

 S SROP(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM=""  Q:$L(SROP(M))+$L(MM)'<55  S SROP(M)=SROP(M)_MM_" ",SROPER=MMM

 Q

PAGE I $E(IOST)="P"!('SRFLG) D HDR S SRFLG=1 Q

 W !!,"Press RETURN to continue, or '^' to quit:  " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q

 I X["?" W !!,"There are more cases for the date range selected.  If you want to continue",!,"listing them, enter RETURN.  Enter '^' to exit from this option." G PAGE

HDR ; print heading

 I +$Y W @IOF

 W !,?(132-$L(SRINST)\2),SRINST,?120,"PAGE: ",SRPAGE,!,?58,"SURGICAL SERVICE",?100,"REVIEWED BY: ",!,?54,"ATTENDING SURGEON REPORT",?100,"DATE REVIEWED: "

 W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT

 W !!?3,"DATE",?12,"PATIENT",?50,"PRINCIPAL DIAGNOSIS",?112,"SURGEON",!,?2,"CASE #",?14,"ID#",?50,"PRINCIPAL OPERATIVE PROCEDURE",?112,"1ST ASST",!,?12,"ATTENDING CODE",?112,"2ND ASST",! F I=1:1:132 W "="

 S SRPAGE=SRPAGE+1

SPEC S SRSSN=$S($E(SRSS,1,2)="ZZ":"SPECIALTY NOT ENTERED",1:SRSS)

 S SRSS1="" F LINE=1:1:$L(SRSSN) S SRSS1=SRSS1_"="

 S X=132-$L(SRSSN)\2 W !!,?X,SRSSN,!,?X,SRSS1

AT I 'SRHDR S SRHDR=1 Q

 S SRATT2="" F LINE=1:1:$L(SRATT1) S SRATT2=SRATT2_"-"

 S X=132-$L(SRATT1)\2 W !!,?X,SRATT1,!,?X,SRATT2 S SRHDR=0

 Q

SROAT2P   ;B'HAM ISC/MAM - ATTENDING SURGEON REPORT (CONT.) ; [ 05/11/04  11:29 AM ]

 +1       ;;3.0; Surgery ;**52,50,129**;24 Jun 93

 +2        SET (SRHDR,SRSS)=0

           SET SRPAGE=1

 +3        FOR 

               SET SRSS=$ORDER(^TMP("SR",$JOB,SRSS))

               IF SRSS=""!(SRSOUT)

                   QUIT 

               SET (SRHDR,SRNEW)=0

               DO PAGE

               SET SRATT=0

               FOR 

                   SET SRATT=$ORDER(^TMP("SR",$JOB,SRSS,SRATT))

                   IF SRATT=""!(SRSOUT)

                       QUIT 

                   SET SRHDR=1

                   DO MORE

 +4        IF '$DATA(^TMP("SR",$JOB))

               DO HDR

               WRITE $$NODATA^SROUTL0()

 +5        QUIT 

MORE       SET SRATT1="ATTENDING SURGEON: "_$SELECT($EXTRACT(SRATT,1,3)'="ZZ ":SRATT,1:$EXTRACT(SRATT,4,99))

           Begin DoDot:1

 +1            IF 'SRB

                   IF $Y+11>IOSL

                       DO PAGE

                   IF SRSOUT

                       QUIT 

                   DO AT

 +2            IF SRB

                   IF SRNEW

                       DO PAGE

                   IF SRSOUT

                       QUIT 

                   IF 'SRNEW

                       DO AT

                   SET SRNEW=1

           End DoDot:1

           IF SRSOUT

               QUIT 

 +3        SET SRATC=""

           FOR 

               SET SRATC=$ORDER(^TMP("SR",$JOB,SRSS,SRATT,SRATC))

               IF SRATC=""!(SRSOUT)

                   QUIT 

               SET SRSDATE=0

               FOR 

                   SET SRSDATE=$ORDER(^TMP("SR",$JOB,SRSS,SRATT,SRATC,SRSDATE))

                   IF 'SRSDATE

                       QUIT 

                   DO CASE

 +4        QUIT 

CASE       SET SRTN=0

           FOR 

               SET SRTN=$ORDER(^TMP("SR",$JOB,SRSS,SRATT,SRATC,SRSDATE,SRTN))

               IF 'SRTN!(SRSOUT)

                   QUIT 

               DO SET

 +1        QUIT 

SET       ; print case

 +1        IF $Y+7>IOSL

               SET SRHDR=1

               DO PAGE

               IF SRSOUT

                   QUIT 

 +2        KILL SRCODE

           SET CODE=SRATC

           IF 'CODE

               SET SRCODE="ATTENDING CODE NOT ENTERED"

 +3        IF CODE

               SET Y=CODE

               SET C=$PIECE(^DD(130,.166,0),"^",2)

               DO Y^DIQ

               SET SRCODE=Y

 +4        IF SRCODE<36

               SET SRCODE(1)=SRCODE

           IF $LENGTH(SRCODE)>35

               Begin DoDot:1

 +5                NEW I,J,X,Y

                   SET X=SRCODE

                   FOR I=0:1:34

                       SET J=35-I

                       SET Y=$EXTRACT(X,J)

                       IF Y=" "

                           SET SRCODE(1)=$EXTRACT(X,1,J-1)

                           SET SRCODE(2)=$EXTRACT(X,J+1,$LENGTH(X))

                           QUIT 

               End DoDot:1

 +6        SET SRDT=$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)_"/"_$EXTRACT(SRSDATE,2,3)

           SET SR(0)=^SRF(SRTN,0)

           SET DFN=$PIECE(SR(0),"^")

           DO DEM^VADPT

 +7        SET SRDIAG=$SELECT($DATA(^SRF(SRTN,34)):$PIECE(^(34),"^"),1:"POSTOPERATIVE DIAGNOSIS NOT ENTERED")

 +8        SET SR(.1)=$SELECT($DATA(^SRF(SRTN,.1)):^(.1),1:"")

           SET SRSUR=$PIECE(SR(.1),"^",4)

           SET SRFST=$PIECE(SR(.1),"^",5)

           SET SRTWO=$PIECE(SR(.1),"^",6)

 +9        IF SRSUR

               SET SRSUR=$PIECE(^VA(200,SRSUR,0),"^")

               IF $LENGTH(SRSUR)>17

                   SET SRSUR=$PIECE(SRSUR,",")_","_$EXTRACT($PIECE(SRSUR,",",2))

 +10       IF SRFST

               SET SRFST=$PIECE(^VA(200,SRFST,0),"^")

               IF $LENGTH(SRFST)>17

                   SET SRFST=$PIECE(SRFST,",")_","_$EXTRACT($PIECE(SRFST,",",2))

 +11       IF SRTWO

               SET SRTWO=$PIECE(^VA(200,SRTWO,0),"^")

               IF $LENGTH(SRTWO)>17

                   SET SRTWO=$PIECE(SRTWO,",")_","_$EXTRACT($PIECE(SRTWO,",",2))

OPS        SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")

           SET OPER=0

           FOR I=0:0

               SET OPER=$ORDER(^SRF(SRTN,13,OPER))

               IF OPER=""

                   QUIT 

               DO OTHER

 +1        KILL SROP,MM,MMM

           IF $LENGTH(SROPER)<55

               SET SROP(1)=SROPER

           IF $LENGTH(SROPER)>54

               SET SROPER=SROPER_"  "

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   IF MMM=""

                       QUIT 

 +2        WRITE !!,SRDT,?12,VADM(1),?50,SRDIAG,?112,SRSUR,!,SRTN,?12,VA("PID"),?50,SROP(1),?112,SRFST,!

           IF $PIECE($GET(^SRF(SRTN,30)),"^")

               WRITE "ABORTED"

           WRITE ?12,SRCODE(1)

           IF $DATA(SROP(2))

               WRITE ?50,SROP(2)

           WRITE ?112,SRTWO

 +3        IF $DATA(SRCODE(2))!$DATA(SROP(3))

               WRITE !

               IF $DATA(SRCODE(2))

                   WRITE ?13,SRCODE(2)

               IF $DATA(SROP(3))

                   WRITE ?50,SROP(3)

 +4        IF $DATA(SROP(4))

               WRITE !,?50,SROP(4)

 +5        QUIT 

OTHER     ; other operations

 +1        SET SRLONG=1

           IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRTN,13,OPER,0),"^"))>240

               SET SRLONG=0

               SET OPER=999

               SET SROPERS=" ..."

 +2        IF SRLONG

               SET SROPERS=$PIECE(^SRF(SRTN,13,OPER,0),"^")

 +3        SET SROPER=SROPER_$SELECT(SROPERS=" ...":SROPERS,1:", "_SROPERS)

 +4        QUIT 

LOOP      ; break procedure if greater than 55 characters

 +1        SET SROP(M)=""

           FOR LOOP=1:1

               SET MM=$PIECE(SROPER," ")

               SET MMM=$PIECE(SROPER," ",2,200)

               IF MMM=""

                   QUIT 

               IF $LENGTH(SROP(M))+$LENGTH(MM)'<55

                   QUIT 

               SET SROP(M)=SROP(M)_MM_" "

               SET SROPER=MMM

 +2        QUIT 

PAGE       IF $EXTRACT(IOST)="P"!('SRFLG)

               DO HDR

               SET SRFLG=1

               QUIT 

 +1        WRITE !!,"Press RETURN to continue, or '^' to quit:  "

           READ X:DTIME

           IF '$TEST!(X["^")

               SET SRSOUT=1

               QUIT 

 +2        IF X["?"

               WRITE !!,"There are more cases for the date range selected.  If you want to continue",!,"listing them, enter RETURN.  Enter '^' to exit from this option."

               GOTO PAGE

HDR       ; print heading

 +1        IF +$Y

               WRITE @IOF

 +2        WRITE !,?(132-$LENGTH(SRINST)\2),SRINST,?120,"PAGE: ",SRPAGE,!,?58,"SURGICAL SERVICE",?100,"REVIEWED BY: ",!,?54,"ATTENDING SURGEON REPORT",?100,"DATE REVIEWED: "

 +3        WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO,?100,SRPRINT

 +4        WRITE !!?3,"DATE",?12,"PATIENT",?50,"PRINCIPAL DIAGNOSIS",?112,"SURGEON",!,?2,"CASE #",?14,"ID#",?50,"PRINCIPAL OPERATIVE PROCEDURE",?112,"1ST ASST",!,?12,"ATTENDING CODE",?112,"2ND ASST",!

           FOR I=1:1:132

               WRITE "="

 +5        SET SRPAGE=SRPAGE+1

SPEC       SET SRSSN=$SELECT($EXTRACT(SRSS,1,2)="ZZ":"SPECIALTY NOT ENTERED",1:SRSS)

 +1        SET SRSS1=""

           FOR LINE=1:1:$LENGTH(SRSSN)

               SET SRSS1=SRSS1_"="

 +2        SET X=132-$LENGTH(SRSSN)\2

           WRITE !!,?X,SRSSN,!,?X,SRSS1

AT         IF 'SRHDR

               SET SRHDR=1

               QUIT 

 +1        SET SRATT2=""

           FOR LINE=1:1:$LENGTH(SRATT1)

               SET SRATT2=SRATT2_"-"

 +2        SET X=132-$LENGTH(SRATT1)\2

           WRITE !!,?X,SRATT1,!,?X,SRATT2

           SET SRHDR=0

 +3        QUIT