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 !!
Q
YN S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
Q
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
Q
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 !
Q
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