- 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
