SROCOMP ;BIR/MAM - VIEW OCCURRENCES ; [ 05/11/04 7:54 AM ]
;;3.0;Surgery;**37,38,88,129,177,182**;24 Jun 93;Build 49
S SRSOUT=0 K SRNEWOP D ^SROPS I '$D(SRTN) S SRSOUT=1 G END
S SR(0)=^SRF(SRTN,0),DFN=$P(SR(0),"^") D DEM^VADPT S SRNAME=VADM(1)_" ("_VA("PID")_")"
S Y=$P(SR(0),"^",9) D D^DIQ S SRSDATE=$P(Y,"@")_" "_$P(Y,"@",2)
S SR(.1)=$G(^SRF(SRTN,.1)),SRSUR=$P(SR(.1),"^",4),SRATT=$P(SR(.1),"^",13)
S SRSUR=$S(SRSUR:$P(^VA(200,SRSUR,0),"^"),1:"NOT ENTERED"),SRATT=$S(SRATT:$P(^VA(200,SRATT,0),"^"),1:"NOT ENTERED")
S SRATC="",Y=$P($G(^SRF(SRTN,.1)),"^",10) I Y S C=$P(^DD(130,.166,0),"^",2) D Y^DIQ S SRATC=Y
I SRATC="" S SRATC="ATTENDING/RES SUP CODE NOT ENTERED"
S SROPER=$P(^SRF(SRTN,"OP"),"^"),X=$P(^("OP"),"^",2) I X S CPT=$P($$CPT^ICPTCOD(X),"^",2),Y=CPT D SSPRIN^SROCPT S CPT=Y,SROPER=SROPER_" ("_CPT_")"
K SROPS,MM,MMM S:$L(SROPER)<55 SROPS(1)=SROPER I $L(SROPER)>54 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
S X=$P($G(^SRF(SRTN,.2)),"^",12) S DIAG=$S(X:"POST",1:"PRE")
S SRDIAG=$S(DIAG="POST":$P($G(^SRF(SRTN,34)),"^"),1:$P($G(^SRF(SRTN,33)),"^")) I DIAG="POST" S X=$P($G(^SRF(SRTN,34)),"^",2) I X S ICD=$$ICD^SROICD(SRTN,X),SRDIAG=SRDIAG_" ("_$P(ICD,"^",2)_")"
I '$L(SRDIAG) S SRDIAG="NOT ENTERED"
S (CMP,CNT)=0 F S CMP=$O(^SRF(SRTN,10,CMP)) Q:'CMP S CNT=CNT+1,INTRA(CNT)=$P(^SRF(SRTN,10,CMP,0),"^")_"^"_$P(^(0),"^",6)
S (CMP,CNT)=0 F S CMP=$O(^SRF(SRTN,16,CMP)) Q:'CMP S CNT=CNT+1,POST(CNT)=$P(^SRF(SRTN,16,CMP,0),"^")_"^"_$P(^(0),"^",6)_"^"_$P(^(0),"^",7)
D HDR
W !!,"Date of Operation: ",?21,SRSDATE,!,"Principal Operation: ",?21,SROPS(1) I $D(SROPS(2)) W !,?21,SROPS(2) I $D(SROPS(3)) W !,?21,SROPS(3)
W !!,"Surgeon: ",?19,SRSUR,!,"Attending Surgeon: "_SRATT,!,"Attending Code: ",?16,SRATC
W !!,"Principal "_$S(DIAG="POST":"Postop",1:"Preop")_" Diagnosis: ",?30,SRDIAG
W !!,"Intraoperative Occurrences: " I '$O(INTRA(0)) W "NONE ENTERED"
I $O(INTRA(0)) S CMP=0 F S CMP=$O(INTRA(CMP)) Q:'CMP!(SRSOUT) D INTRA
G:SRSOUT END W !!,"Postoperative Occurrences: " I '$O(POST(0)) W "NONE ENTERED"
I $O(POST(0)) S CMP=0 F S CMP=$O(POST(CMP)) Q:'CMP!(SRSOUT) D POST
I SRSOUT G END
K SRRET S (RET,CNT)=0 F S RET=$O(^SRF(SRTN,29,RET)) Q:'RET S X=^SRF(SRTN,29,RET,0),Y=$P(X,"^",3) I Y="R" S CNT=CNT+1,SRRET(CNT)=$P(X,"^")
I $O(SRRET(0)) D RET W !!,"Related Returns to Surgery: " S RET=0 F S RET=$O(SRRET(RET)) Q:'RET!(SRSOUT) D RELATE
END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
D ^SRSKILL K SRTN W @IOF
Q
LOOP ; break procedure if greater than 55 characters
S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<55 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
RET W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
I X["?" W !!,"Press RETURN to list more information, or '^' to leave this option." G RET
HDR W @IOF,!,SRNAME,?50,"OCCURRENCES",! F LINE=1:1:80 W "-"
Q
INTRA ; intraop occurrences
I $Y+4>IOSL D RET I SRSOUT Q
W:CMP>1 ! W ?30,$P(INTRA(CMP),"^") S OUT=$P(INTRA(CMP),"^",2),OUT=$S(OUT="I":"IMPROVED",OUT="W":"WORSE",OUT="D":"DEATH",OUT="U":"UNRESOLVED",1:"NOT ENTERED") W !,?30,"Outcome: "_OUT
Q
POST ; postop occurrences
I $Y+4>IOSL D RET I SRSOUT Q
W:CMP>1 ! W ?30,$P(POST(CMP),"^") S D=$P(POST(CMP),"^",3) I D S D=" ("_$E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)_")" W D
S OUT=$P(POST(CMP),"^",2),OUT=$S(OUT="I":"IMPROVED",OUT="W":"WORSE",OUT="D":"DEATH",OUT="U":"UNRESOLVED",1:"NOT ENTERED") W !,?30,"Outcome: "_OUT
Q
RELATE ; print related returns
I $Y+4>IOSL D RET I SRSOUT Q
S Y=$P(^SRF(SRRET(RET),0),"^",9),SRSDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),SROPER=$P(^SRF(SRRET(RET),"OP"),"^")
K SROPS,MM,MMM S:$L(SROPER)<55 SROPS(1)=SROPER I $L(SROPER)>54 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
W !,SRSDATE,?10,SROPS(1) I $D(SROPS(2)) W !,?10,SROPS(2) I $D(SROPS(3)) W !,?10,SROPS(3)
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROCOMP 3919 printed Dec 13, 2024@02:42:55 Page 2
SROCOMP ;BIR/MAM - VIEW OCCURRENCES ; [ 05/11/04 7:54 AM ]
+1 ;;3.0;Surgery;**37,38,88,129,177,182**;24 Jun 93;Build 49
+2 SET SRSOUT=0
KILL SRNEWOP
DO ^SROPS
IF '$DATA(SRTN)
SET SRSOUT=1
GOTO END
+3 SET SR(0)=^SRF(SRTN,0)
SET DFN=$PIECE(SR(0),"^")
DO DEM^VADPT
SET SRNAME=VADM(1)_" ("_VA("PID")_")"
+4 SET Y=$PIECE(SR(0),"^",9)
DO D^DIQ
SET SRSDATE=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
+5 SET SR(.1)=$GET(^SRF(SRTN,.1))
SET SRSUR=$PIECE(SR(.1),"^",4)
SET SRATT=$PIECE(SR(.1),"^",13)
+6 SET SRSUR=$SELECT(SRSUR:$PIECE(^VA(200,SRSUR,0),"^"),1:"NOT ENTERED")
SET SRATT=$SELECT(SRATT:$PIECE(^VA(200,SRATT,0),"^"),1:"NOT ENTERED")
+7 SET SRATC=""
SET Y=$PIECE($GET(^SRF(SRTN,.1)),"^",10)
IF Y
SET C=$PIECE(^DD(130,.166,0),"^",2)
DO Y^DIQ
SET SRATC=Y
+8 IF SRATC=""
SET SRATC="ATTENDING/RES SUP CODE NOT ENTERED"
+9 SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
SET X=$PIECE(^("OP"),"^",2)
IF X
SET CPT=$PIECE($$CPT^ICPTCOD(X),"^",2)
SET Y=CPT
DO SSPRIN^SROCPT
SET CPT=Y
SET SROPER=SROPER_" ("_CPT_")"
+10 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<55
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>54
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+11 SET X=$PIECE($GET(^SRF(SRTN,.2)),"^",12)
SET DIAG=$SELECT(X:"POST",1:"PRE")
+12 SET SRDIAG=$SELECT(DIAG="POST":$PIECE($GET(^SRF(SRTN,34)),"^"),1:$PIECE($GET(^SRF(SRTN,33)),"^"))
IF DIAG="POST"
SET X=$PIECE($GET(^SRF(SRTN,34)),"^",2)
IF X
SET ICD=$$ICD^SROICD(SRTN,X)
SET SRDIAG=SRDIAG_" ("_$PIECE(ICD,"^",2)_")"
+13 IF '$LENGTH(SRDIAG)
SET SRDIAG="NOT ENTERED"
+14 SET (CMP,CNT)=0
FOR
SET CMP=$ORDER(^SRF(SRTN,10,CMP))
if 'CMP
QUIT
SET CNT=CNT+1
SET INTRA(CNT)=$PIECE(^SRF(SRTN,10,CMP,0),"^")_"^"_$PIECE(^(0),"^",6)
+15 SET (CMP,CNT)=0
FOR
SET CMP=$ORDER(^SRF(SRTN,16,CMP))
if 'CMP
QUIT
SET CNT=CNT+1
SET POST(CNT)=$PIECE(^SRF(SRTN,16,CMP,0),"^")_"^"_$PIECE(^(0),"^",6)_"^"_$PIECE(^(0),"^",7)
+16 DO HDR
+17 WRITE !!,"Date of Operation: ",?21,SRSDATE,!,"Principal Operation: ",?21,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?21,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?21,SROPS(3)
+18 WRITE !!,"Surgeon: ",?19,SRSUR,!,"Attending Surgeon: "_SRATT,!,"Attending Code: ",?16,SRATC
+19 WRITE !!,"Principal "_$SELECT(DIAG="POST":"Postop",1:"Preop")_" Diagnosis: ",?30,SRDIAG
+20 WRITE !!,"Intraoperative Occurrences: "
IF '$ORDER(INTRA(0))
WRITE "NONE ENTERED"
+21 IF $ORDER(INTRA(0))
SET CMP=0
FOR
SET CMP=$ORDER(INTRA(CMP))
if 'CMP!(SRSOUT)
QUIT
DO INTRA
+22 if SRSOUT
GOTO END
WRITE !!,"Postoperative Occurrences: "
IF '$ORDER(POST(0))
WRITE "NONE ENTERED"
+23 IF $ORDER(POST(0))
SET CMP=0
FOR
SET CMP=$ORDER(POST(CMP))
if 'CMP!(SRSOUT)
QUIT
DO POST
+24 IF SRSOUT
GOTO END
+25 KILL SRRET
SET (RET,CNT)=0
FOR
SET RET=$ORDER(^SRF(SRTN,29,RET))
if 'RET
QUIT
SET X=^SRF(SRTN,29,RET,0)
SET Y=$PIECE(X,"^",3)
IF Y="R"
SET CNT=CNT+1
SET SRRET(CNT)=$PIECE(X,"^")
+26 IF $ORDER(SRRET(0))
DO RET
WRITE !!,"Related Returns to Surgery: "
SET RET=0
FOR
SET RET=$ORDER(SRRET(RET))
if 'RET!(SRSOUT)
QUIT
DO RELATE
END IF 'SRSOUT
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+1 DO ^SRSKILL
KILL SRTN
WRITE @IOF
+2 QUIT
LOOP ; break procedure if greater than 55 characters
+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)'<55
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
RET WRITE !!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+1 IF X["?"
WRITE !!,"Press RETURN to list more information, or '^' to leave this option."
GOTO RET
HDR WRITE @IOF,!,SRNAME,?50,"OCCURRENCES",!
FOR LINE=1:1:80
WRITE "-"
+1 QUIT
INTRA ; intraop occurrences
+1 IF $Y+4>IOSL
DO RET
IF SRSOUT
QUIT
+2 if CMP>1
WRITE !
WRITE ?30,$PIECE(INTRA(CMP),"^")
SET OUT=$PIECE(INTRA(CMP),"^",2)
SET OUT=$SELECT(OUT="I":"IMPROVED",OUT="W":"WORSE",OUT="D":"DEATH",OUT="U":"UNRESOLVED",1:"NOT ENTERED")
WRITE !,?30,"Outcome: "_OUT
+3 QUIT
POST ; postop occurrences
+1 IF $Y+4>IOSL
DO RET
IF SRSOUT
QUIT
+2 if CMP>1
WRITE !
WRITE ?30,$PIECE(POST(CMP),"^")
SET D=$PIECE(POST(CMP),"^",3)
IF D
SET D=" ("_$EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)_")"
WRITE D
+3 SET OUT=$PIECE(POST(CMP),"^",2)
SET OUT=$SELECT(OUT="I":"IMPROVED",OUT="W":"WORSE",OUT="D":"DEATH",OUT="U":"UNRESOLVED",1:"NOT ENTERED")
WRITE !,?30,"Outcome: "_OUT
+4 QUIT
RELATE ; print related returns
+1 IF $Y+4>IOSL
DO RET
IF SRSOUT
QUIT
+2 SET Y=$PIECE(^SRF(SRRET(RET),0),"^",9)
SET SRSDATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
SET SROPER=$PIECE(^SRF(SRRET(RET),"OP"),"^")
+3 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<55
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>54
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+4 WRITE !,SRSDATE,?10,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?10,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?10,SROPS(3)
+5 WRITE !
+6 QUIT
