Routine: SROAPRT3

SROAPRT3 ;BIR/MAM - PRINT OPERATION INFO ;01/23/07

 ;;3.0; Surgery ;**38,47,63,81,88,95,125,142,153,160**;24 Jun 93;Build 7

 K SRAO S (SRAO(7),SRAO(8))="",SRA("OP")=^SRF(SRTN,"OP")

 S SRAO(2)="^1" K SROPS S SROPER=$P(SRA("OP"),"^")

 S:$L(SROPER)<49 SROPS(1)=SROPER K M,MM,MMM I $L(SROPER)>48 S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""

 S SRA(0)=^SRF(SRTN,0),X=$P(SRA(0),"^",4) S:X X=$P(^SRO(137.45,X,0),"^") S SRAO(2)=X_"^.04"

 W !,?29,"OPERATIVE INFORMATION",!!,$J("Surgical Specialty: ",39)_$P(SRAO(2),"^")

 W !!,$J("Principal Operation: ",39)_SROPS(1) I $D(SROPS(2)) W !,?40,SROPS(2) I $D(SROPS(3)) W !,?40,SROPS(3)

 D ^SROAOTH

 S X=$P(SRA(200),"^",52),SRAO(9)=X_"^214",NYUK=$P(SRA(0),"^",10),NYUK=$S(NYUK="EM":"YES",1:"NO") S SRAO(10)=NYUK_"^.035"

 S Y=$P($G(^SRF(SRTN,"1.0")),"^",8),C=$P(^DD(130,1.09,0),"^",2) D:Y'="" Y^DIQ S SRAO(11)=Y_"^1.09"

 S NYUK=$P(SRA(200),"^",53) D YN S SRAO(12)=SHEMP_"^201"

 S Y=$P($G(^SRF(SRTN,1.1)),"^",3),C=$P(^DD(130,1.13,0),"^",2) D:Y'="" Y^DIQ S SRAO(13)=Y_"^1.13"

 D TECH^SROPRIN S SRAO(14)=SRTECH

 S X=$P(SRA(200),"^",54),SRAO(15)=X_"^340"

 S Y=$P($G(^SRF(SRTN,200.1)),"^",4),C=$P(^DD(130,443,0),"^",2) D:Y'="" Y^DIQ S SRAO(5)=Y_"^443"

 S Y=$P($G(^SRF(SRTN,200.1)),"^",6),C=$P(^DD(130,446,0),"^",2) D:Y'="" Y^DIQ S SRAO(6)=Y_"^446"

 I $E(IOST)'="P" D PAGE^SROAPAS Q:SRSOUT  W !,?29,"OPERATIVE INFORMATION",!

 W !,$J("PGY of Primary Surgeon: ",39)_$P(SRAO(9),"^") W !,$J("Emergency Case (Y/N): ",39)_$P(SRAO(10),"^")

 W !,$J("Wound Classification: ",39)_$P(SRAO(11),"^")

 W !,$J("ASA Classification: ",39)_$P(SRAO(13),"^")

 W !,$J("Principal Anesthesia Technique: ",39)_$P(SRAO(14),"^")

 W !,$J("RBC Units Transfused: ",39)_$P(SRAO(15),"^")

 W !,$J("Intraop Disseminated Cancer: ",39)_$P(SRAO(5),"^")

 W !,$J("Intraoperative Ascites: ",39)_$P(SRAO(6),"^")

 I $E(IOST)="P" W !!

YN S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")

LOOP ; break procedures

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

OPTIMES ; print operation times

 K SRAO F I=1:1:7 S SRAO(I)=""

 W !,?24,"OPERATION DATE/TIMES INFORMATION"

 S X=$G(^SRF(SRTN,.2)),SRAO(1)=$P(X,"^",10),SRAO(2)=$P(X,"^",2),SRAO(3)=$P(X,"^",3),SRAO(4)=$P(X,"^",12),SRAO(5)=$P(X,"^"),SRAO(6)=$P(X,"^",4),SRAO(7)=$P($G(^SRF(SRTN,1.1)),"^",8)

 F SRI=1:1:7 S Y=SRAO(SRI) I Y X ^DD("DD") S X=$P(Y,"@")_"  "_$P(Y,"@",2),SRAO(SRI)=X

 W !!,$J("Patient in Room (PIR): ",39)_SRAO(1),!,$J("Procedure/Surgery Start Time (PST): ",39)_SRAO(2),!,$J("Procedure/Surgery Finish (PF): ",39)_SRAO(3)

 W !,$J("Patient Out of Room (POR): ",39)_SRAO(4),!,$J("Anesthesia Start (AS): ",39)_SRAO(5),!,$J("Anesthesia Finish (AF): ",39)_SRAO(6),!,$J("Discharge from PACU (DPACU): ",39)_SRAO(7)

 I $E(IOST)="P" W !

SROAPRT3  ;BIR/MAM - PRINT OPERATION INFO ;01/23/07

 +1       ;;3.0; Surgery ;**38,47,63,81,88,95,125,142,153,160**;24 Jun 93;Build 7

 +2        KILL SRAO

           SET (SRAO(7),SRAO(8))=""

           SET SRA("OP")=^SRF(SRTN,"OP")

 +3        SET SRAO(2)="^1"

           KILL SROPS

           SET SROPER=$PIECE(SRA("OP"),"^")

 +4        IF $LENGTH(SROPER)<49

               SET SROPS(1)=SROPER

           KILL M,MM,MMM

           IF $LENGTH(SROPER)>48

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   IF MMM=""

                       QUIT

 +5        SET SRA(0)=^SRF(SRTN,0)

           SET X=$PIECE(SRA(0),"^",4)

           IF X

               SET X=$PIECE(^SRO(137.45,X,0),"^")

           SET SRAO(2)=X_"^.04"

 +6        WRITE !,?29,"OPERATIVE INFORMATION",!!,$JUSTIFY("Surgical Specialty: ",39)_$PIECE(SRAO(2),"^")

 +7        WRITE !!,$JUSTIFY("Principal Operation: ",39)_SROPS(1)

           IF $DATA(SROPS(2))

               WRITE !,?40,SROPS(2)

               IF $DATA(SROPS(3))

                   WRITE !,?40,SROPS(3)

 +8        DO ^SROAOTH

 +9        SET X=$PIECE(SRA(200),"^",52)

           SET SRAO(9)=X_"^214"

           SET NYUK=$PIECE(SRA(0),"^",10)

           SET NYUK=$SELECT(NYUK="EM":"YES",1:"NO")

           SET SRAO(10)=NYUK_"^.035"

 +10       SET Y=$PIECE($GET(^SRF(SRTN,"1.0")),"^",8)

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

           IF Y'=""

               DO Y^DIQ

           SET SRAO(11)=Y_"^1.09"

 +11       SET NYUK=$PIECE(SRA(200),"^",53)

           DO YN

           SET SRAO(12)=SHEMP_"^201"

 +12       SET Y=$PIECE($GET(^SRF(SRTN,1.1)),"^",3)

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

           IF Y'=""

               DO Y^DIQ

           SET SRAO(13)=Y_"^1.13"

 +13       DO TECH^SROPRIN

           SET SRAO(14)=SRTECH

 +14       SET X=$PIECE(SRA(200),"^",54)

           SET SRAO(15)=X_"^340"

 +15       SET Y=$PIECE($GET(^SRF(SRTN,200.1)),"^",4)

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

           IF Y'=""

               DO Y^DIQ

           SET SRAO(5)=Y_"^443"

 +16       SET Y=$PIECE($GET(^SRF(SRTN,200.1)),"^",6)

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

           IF Y'=""

               DO Y^DIQ

           SET SRAO(6)=Y_"^446"

 +17       IF $EXTRACT(IOST)'="P"

               DO PAGE^SROAPAS

               IF SRSOUT

                   QUIT

               WRITE !,?29,"OPERATIVE INFORMATION",!

 +18       WRITE !,$JUSTIFY("PGY of Primary Surgeon: ",39)_$PIECE(SRAO(9),"^")

           WRITE !,$JUSTIFY("Emergency Case (Y/N): ",39)_$PIECE(SRAO(10),"^")

 +19       WRITE !,$JUSTIFY("Wound Classification: ",39)_$PIECE(SRAO(11),"^")

 +20       WRITE !,$JUSTIFY("ASA Classification: ",39)_$PIECE(SRAO(13),"^")

 +21       WRITE !,$JUSTIFY("Principal Anesthesia Technique: ",39)_$PIECE(SRAO(14),"^")

 +22       WRITE !,$JUSTIFY("RBC Units Transfused: ",39)_$PIECE(SRAO(15),"^")

 +23       WRITE !,$JUSTIFY("Intraop Disseminated Cancer: ",39)_$PIECE(SRAO(5),"^")

 +24       WRITE !,$JUSTIFY("Intraoperative Ascites: ",39)_$PIECE(SRAO(6),"^")

 +25       IF $EXTRACT(IOST)="P"

               WRITE !!

 +26       QUIT

YN         SET SHEMP=$SELECT(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")

 +1        QUIT

LOOP      ; break procedures

 +1        SET SROPS(M)=""

           FOR LOOP=1:1

               SET MM=$PIECE(SROPER," ")

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

               IF MMM=""

                   QUIT

               IF $LENGTH(SROPS(M))+$LENGTH(MM)'<49

                   QUIT

               SET SROPS(M)=SROPS(M)_MM_" "

               SET SROPER=MMM

 +2        QUIT

OPTIMES   ; print operation times

 +1        KILL SRAO

           FOR I=1:1:7

               SET SRAO(I)=""

 +2        WRITE !,?24,"OPERATION DATE/TIMES INFORMATION"

 +3        SET X=$GET(^SRF(SRTN,.2))

           SET SRAO(1)=$PIECE(X,"^",10)

           SET SRAO(2)=$PIECE(X,"^",2)

           SET SRAO(3)=$PIECE(X,"^",3)

           SET SRAO(4)=$PIECE(X,"^",12)

           SET SRAO(5)=$PIECE(X,"^")

           SET SRAO(6)=$PIECE(X,"^",4)

           SET SRAO(7)=$PIECE($GET(^SRF(SRTN,1.1)),"^",8)

 +4        FOR SRI=1:1:7

               SET Y=SRAO(SRI)

               IF Y

                   XECUTE ^DD("DD")

                   SET X=$PIECE(Y,"@")_"  "_$PIECE(Y,"@",2)

                   SET SRAO(SRI)=X

 +5        WRITE !!,$JUSTIFY("Patient in Room (PIR): ",39)_SRAO(1),!,$JUSTIFY("Procedure/Surgery Start Time (PST): ",39)_SRAO(2),!,$JUSTIFY("Procedure/Surgery Finish (PF): ",39)_SRAO(3)

 +6        WRITE !,$JUSTIFY("Patient Out of Room (POR): ",39)_SRAO(4),!,$JUSTIFY("Anesthesia Start (AS): ",39)_SRAO(5),!,$JUSTIFY("Anesthesia Finish (AF): ",39)_SRAO(6),!,$JUSTIFY("Discharge from PACU (DPACU): ",39)_SRAO(7)

 +7        IF $EXTRACT(IOST)="P"

               WRITE !

 +8        QUIT

SROAPRT3.m