SROAPRT6 ;BIR/MAM - PRINT OUTCOME INFO ;01/29/07
;;3.0; Surgery ;**38,47,88,127,156,160**;24 Jun 93;Build 7
K SRA S X=$P($G(^SRO(136,SRTN,0)),"^",3) S:X X=$$ICDDX^ICDCODE(X,$P($G(^SRF(SRTN,0)),"^",9)),X=$P(X,"^",2)_" "_$P(X,"^",4) S SRAO(1)=X_"^.03"
S SRA(205)=$G(^SRF(SRTN,205)),X=$P(SRA(205),"^") I X'="" S X=$S(X="NA":"NA",1:X_" DAYS")
S SRAO(2)=X_"^247"
S X=$P(SRA(205),"^",3),Y=$S(X'="":X,1:$P($G(^DPT(DFN,.35)),"^")),SRDEAD=Y I Y D D^DIQ S SRDEAD=Y
S SRAO(3)=SRDEAD,NYUK="N",SRET=0 K SRCPT
F S SRET=$O(^SRF(SRTN,29,SRET)) Q:'SRET S CASE=$P(^SRF(SRTN,29,SRET,0),"^"),SRC=$P($G(^SRO(136,CASE,0)),"^",2) I $P($G(^SRF(CASE,.2)),"^",10),SRC D
.S Y=$P($$CPT^ICPTCOD(SRC),"^",2) D MOD
.S NYUK="Y",SRCPT(SRC)=Y
S $P(^SRF(SRTN,205),"^",4)=NYUK D YN S SRAO(4)=SHEMP_"^262" F I="6A","6B","6C","6D","6E","6F","7A","7B","7C","7D","7E","7F" S SRAO(I)=""
DISP ;
W !,?27,"OUTCOME INFORMATION"
W !!,$J("Postoperative Diagnosis Code (ICD9): ",39)_$P(SRAO(1),"^"),!,$J("Length of Postoperative Hospital Stay: ",39)_$P(SRAO(2),"^")
W !,$J("Date of Death: ",39)_$P(SRAO(3),"^")
I SRAO(3) S X1=$P(^SRF(SRTN,0),"^",9),X2=90 D C^%DTC D
.I SRAO(3)'>X W !,$J("Death Unrelated/Related: ",39)_$S($P($G(^SRF(SRTN,.4)),"^",7)="R":"RELATED",$P($G(^SRF(SRTN,.4)),"^",7)="U":"UNRELATED",1:"")
.I SRA(3)>X W !,$J("Death Unrelated/Related: ",39)_"N/A"
W !,$J("Return to OR Within 30 Days: ",39)_$P(SRAO(4),"^")
D RET W:$E(IOST)="P" ! I $Y+24>IOSL D PAGE^SROAPAS I SRSOUT Q
D ^SROAPRT7
Q
MOD ;; append CPT modifiers to CPT code
N SRTN S SRTN=CASE D SSPRIN^SROCPT0
Q
YN ;
S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
Q
RET ; print returns
S X=0 F S X=$O(SRCPT(X)) Q:'X W !,?15,"CPT Code: "_SRCPT(X)
Q
SROAPRT6 ;BIR/MAM - PRINT OUTCOME INFO ;01/29/07
+1 ;;3.0; Surgery ;**38,47,88,127,156,160**;24 Jun 93;Build 7
+2 KILL SRA
SET X=$PIECE($GET(^SRO(136,SRTN,0)),"^",3)
IF X
SET X=$$ICDDX^ICDCODE(X,$PIECE($GET(^SRF(SRTN,0)),"^",9))
SET X=$PIECE(X,"^",2)_" "_$PIECE(X,"^",4)
SET SRAO(1)=X_"^.03"
+3 SET SRA(205)=$GET(^SRF(SRTN,205))
SET X=$PIECE(SRA(205),"^")
IF X'=""
SET X=$SELECT(X="NA":"NA",1:X_" DAYS")
+4 SET SRAO(2)=X_"^247"
+5 SET X=$PIECE(SRA(205),"^",3)
SET Y=$SELECT(X'="":X,1:$PIECE($GET(^DPT(DFN,.35)),"^"))
SET SRDEAD=Y
IF Y
DO D^DIQ
SET SRDEAD=Y
+6 SET SRAO(3)=SRDEAD
SET NYUK="N"
SET SRET=0
KILL SRCPT
+7 FOR
SET SRET=$ORDER(^SRF(SRTN,29,SRET))
IF 'SRET
QUIT
SET CASE=$PIECE(^SRF(SRTN,29,SRET,0),"^")
SET SRC=$PIECE($GET(^SRO(136,CASE,0)),"^",2)
IF $PIECE($GET(^SRF(CASE,.2)),"^",10)
IF SRC
Begin DoDot:1
+8 SET Y=$PIECE($$CPT^ICPTCOD(SRC),"^",2)
DO MOD
+9 SET NYUK="Y"
SET SRCPT(SRC)=Y
End DoDot:1
+10 SET $PIECE(^SRF(SRTN,205),"^",4)=NYUK
DO YN
SET SRAO(4)=SHEMP_"^262"
FOR I="6A","6B","6C","6D","6E","6F","7A","7B","7C","7D","7E","7F"
SET SRAO(I)=""
DISP ;
+1 WRITE !,?27,"OUTCOME INFORMATION"
+2 WRITE !!,$JUSTIFY("Postoperative Diagnosis Code (ICD9): ",39)_$PIECE(SRAO(1),"^"),!,$JUSTIFY("Length of Postoperative Hospital Stay: ",39)_$PIECE(SRAO(2),"^")
+3 WRITE !,$JUSTIFY("Date of Death: ",39)_$PIECE(SRAO(3),"^")
+4 IF SRAO(3)
SET X1=$PIECE(^SRF(SRTN,0),"^",9)
SET X2=90
DO C^%DTC
Begin DoDot:1
+5 IF SRAO(3)'>X
WRITE !,$JUSTIFY("Death Unrelated/Related: ",39)_$SELECT($PIECE($GET(^SRF(SRTN,.4)),"^",7)="R":"RELATED",$PIECE($GET(^SRF(SRTN,.4)),"^",7)="U":"UNRELATED",1:"")
+6 IF SRA(3)>X
WRITE !,$JUSTIFY("Death Unrelated/Related: ",39)_"N/A"
End DoDot:1
+7 WRITE !,$JUSTIFY("Return to OR Within 30 Days: ",39)_$PIECE(SRAO(4),"^")
+8 DO RET
IF $EXTRACT(IOST)="P"
WRITE !
IF $Y+24>IOSL
DO PAGE^SROAPAS
IF SRSOUT
QUIT
+9 DO ^SROAPRT7
+10 QUIT
MOD ;; append CPT modifiers to CPT code
+1 NEW SRTN
SET SRTN=CASE
DO SSPRIN^SROCPT0
+2 QUIT
YN ;
+1 SET SHEMP=$SELECT(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
+2 QUIT
RET ; print returns
+1 SET X=0
FOR
SET X=$ORDER(SRCPT(X))
IF 'X
QUIT
WRITE !,?15,"CPT Code: "_SRCPT(X)
+2 QUIT
