SROINQ ;B'HAM ISC/MAM - OPERATION INQUIRY ; [ 07/20/04 12:44 PM ]
;;3.0;Surgery;**38,48,129,151,182**;24 Jun 93;Build 49
;
; Reference to ^PSS50 supported by DBIA #4533
;
I '$D(SRTN) W !!,"OPERATION NOT SELECTED !",! Q
S S(0)=^SRF(SRTN,0),DFN=$P(S(0),"^") D DEM^VADPT S SRTNM=VADM(1),SSN=VA("PID"),SRTNM=SRTNM_" ("_VA("PID")_")"
S SRLINE="" F I=0:1:79 S SRLINE=SRLINE_"-"
S SRTCC=$P($G(^SRF(SRTN,"1.0")),"^",8),S(.1)=$S($D(^SRF(SRTN,.1)):^(.1),1:"")
S SRTSP=$S($P(S(0),"^",4):$P(^SRO(137.45,$P(S(0),"^",4),0),"^"),1:"")
S Y=SRTCC,C=$P(^DD(130,1.09,0),"^",2) D:Y'="" Y^DIQ S SRTCC=Y S SRSUR=$P(S(.1),"^",4),SRATT=$P(S(.1),"^",13),SRANE=$P($G(^SRF(SRTN,.3)),"^") S:SRSUR]"" SRSUR=$P(^VA(200,SRSUR,0),"^") S:SRATT]"" SRATT=$P(^VA(200,SRATT,0),"^")
S:SRANE SRANE=$P(^VA(200,SRANE,0),"^")
S SRATCD="",Y=$P($G(^SRF(SRTN,.1)),"^",10) I Y S C=$P(^DD(130,.166,0),"^",2) D Y^DIQ S SRATCD=Y
I SRATCD="" S SRATCD="ATTENDING/RES SUP CODE NOT ENTERED"
;S X=$P(S(.1),"^",16),SRTACD=$S(X=0:"0. STAFF",X=1:"1. ATTENDING IN O.R.",X=2:"2. ATTENDING IN O.R. SUITE",X=3:"3. ATTENDING NOT PRESENT, BUT AVAILABLE",1:"")
I $L(SRANE)>18 S SRANE=$P(SRANE,",")_","_$E($P(SRANE,",",2),1)_"."
S SRTCMP=$S($O(^SRF(SRTN,10,0)):"YES",1:"NO"),SRTCMP1=$S($O(^SRF(SRTN,16,0)):"YES",1:"NO")
S Y=$P(^SRF(SRTN,0),"^",9) D D^DIQ S SRSDATE=Y
S:'$D(SRICD("*")) SRICD("*")="NOT ENTERED"
ANES I $D(^SRF(SRTN,6,0)) S I=0 F J=0:0 S I=$O(^SRF(SRTN,6,I)) Q:'I S SRANE(I)=$P(^(I,0),U) D AGENT
TIME S S(.2)=$G(^SRF(SRTN,.2)),(X1,SRTDG)=$P(S(.2),"^",3),X=$P(S(.2),"^",2) D MINS^SRSUTL2 S SRTIME=X S SRTBL=$P(S(.2),"^",5)
S:'$D(SRTIME) SRTIME="" S:'$D(SRTBL) SRTBL=""
OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F I=0:0 S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
K SROPS,MM,MMM S:$L(SROPER)<75 SROPS(1)=SROPER I $L(SROPER)>74 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
ICD9 S:'$D(SRTDG) SRTDG="" S SRTDG=$S(+SRTDG:15,1:14),SRTDG1=$S(SRTDG=15:3,1:1),SRTDG2=$S(SRTDG=15:33,1:34)
S SRICD=0 S:$D(^SRF(SRTN,SRTDG2)) SRICD("*")=$P(^SRF(SRTN,SRTDG2),"^") F I=0:0 S SRICD=$O(^SRF(SRTN,SRTDG,SRICD)) Q:'SRICD S SRICD(SRICD)=$P(^SRF(SRTN,SRTDG,SRICD,0),"^")
S:'$D(SRTDG("*")) SRTDG("*")=""
PRINT ; print inquiry
W @IOF,!,SRLINE,!,"Patient: "_SRTNM,?50,"Operation Date: "_$P(SRSDATE,"@"),!,"Primary Surgeon: "_SRSUR
W !,"Attending Surgeon: "_SRATT,?50,"Operation Time: "_SRTIME I SRTIME W " Minutes",!,"Attending/Res Sup Code: "_SRATCD,!,SRLINE
W !,"Operation(s): ",!,SROPS(1) I $D(SROPS(2)) W !,SROPS(2) I $D(SROPS(3)) W !,SROPS(3) I $D(SROPS(4)) W !,SROPS(4) I $D(SROPS(5)) W !,SROPS(5)
W !,SRLINE,!,$S(SRTDG2=33:"Postop",1:"Preop")," Diagnosis:",?47,"Intraop Occurrences: ",SRTCMP,!,"* ",SRICD("*"),?47,"Postop Occurrences: ",SRTCMP1 F I=0:0 S I=$O(SRICD(I)) Q:'I W !,?4,SRICD(I)
W !,SRLINE,!,"Anesthesia Technique: ",?47,"Anesthetist: ",SRANE F I=0:0 S I=$O(SRANE(I)) Q:'I W !,?4 S Y=$P(SRANE(I),"^"),C=$P(^DD(130.06,.01,0),"^",2) D:Y'="" Y^DIQ W:Y]"" Y D AGT
W !,SRLINE,!,"Wound Classification: ",SRTCC,!,"Intraoperative Blood Loss: ",SRTBL,$S(SRTBL]"":" CC'S",1:""),!,SRLINE
W !!!,"Press RETURN to continue " R ANS:DTIME
END D ^SRSKILL W @IOF
Q
OTHER ; other operations
S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..."
I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")
S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
Q
LOOP ; break procedure if greater than 75 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)'<75 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
AGT F T=0:0 S T=$O(SRANE(I,T)) Q:'T W !,?6,SRANE(I,T)
Q
AGENT ; anesthesia agents
S Q=0 F T=0:0 S Q=$O(^SRF(SRTN,6,I,1,Q)) Q:'Q S Z=$P(^(Q,0),U) D
.D DATA^PSS50(Z,,,,,"SRRX") S SRANE(I,Q)=$P($G(^TMP($J,"SRRX",Z,.01)),"^") K ^TMP($J,"SRRX",Z)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROINQ 3872 printed Nov 22, 2024@17:53:57 Page 2
SROINQ ;B'HAM ISC/MAM - OPERATION INQUIRY ; [ 07/20/04 12:44 PM ]
+1 ;;3.0;Surgery;**38,48,129,151,182**;24 Jun 93;Build 49
+2 ;
+3 ; Reference to ^PSS50 supported by DBIA #4533
+4 ;
+5 IF '$DATA(SRTN)
WRITE !!,"OPERATION NOT SELECTED !",!
QUIT
+6 SET S(0)=^SRF(SRTN,0)
SET DFN=$PIECE(S(0),"^")
DO DEM^VADPT
SET SRTNM=VADM(1)
SET SSN=VA("PID")
SET SRTNM=SRTNM_" ("_VA("PID")_")"
+7 SET SRLINE=""
FOR I=0:1:79
SET SRLINE=SRLINE_"-"
+8 SET SRTCC=$PIECE($GET(^SRF(SRTN,"1.0")),"^",8)
SET S(.1)=$SELECT($DATA(^SRF(SRTN,.1)):^(.1),1:"")
+9 SET SRTSP=$SELECT($PIECE(S(0),"^",4):$PIECE(^SRO(137.45,$PIECE(S(0),"^",4),0),"^"),1:"")
+10 SET Y=SRTCC
SET C=$PIECE(^DD(130,1.09,0),"^",2)
if Y'=""
DO Y^DIQ
SET SRTCC=Y
SET SRSUR=$PIECE(S(.1),"^",4)
SET SRATT=$PIECE(S(.1),"^",13)
SET SRANE=$PIECE($GET(^SRF(SRTN,.3)),"^")
if SRSUR]""
SET SRSUR=$PIECE(^VA(200,SRSUR,0),"^")
if SRATT]""
SET SRATT=$PIECE(^VA(200,SRATT,0),"^")
+11 if SRANE
SET SRANE=$PIECE(^VA(200,SRANE,0),"^")
+12 SET SRATCD=""
SET Y=$PIECE($GET(^SRF(SRTN,.1)),"^",10)
IF Y
SET C=$PIECE(^DD(130,.166,0),"^",2)
DO Y^DIQ
SET SRATCD=Y
+13 IF SRATCD=""
SET SRATCD="ATTENDING/RES SUP CODE NOT ENTERED"
+14 ;S X=$P(S(.1),"^",16),SRTACD=$S(X=0:"0. STAFF",X=1:"1. ATTENDING IN O.R.",X=2:"2. ATTENDING IN O.R. SUITE",X=3:"3. ATTENDING NOT PRESENT, BUT AVAILABLE",1:"")
+15 IF $LENGTH(SRANE)>18
SET SRANE=$PIECE(SRANE,",")_","_$EXTRACT($PIECE(SRANE,",",2),1)_"."
+16 SET SRTCMP=$SELECT($ORDER(^SRF(SRTN,10,0)):"YES",1:"NO")
SET SRTCMP1=$SELECT($ORDER(^SRF(SRTN,16,0)):"YES",1:"NO")
+17 SET Y=$PIECE(^SRF(SRTN,0),"^",9)
DO D^DIQ
SET SRSDATE=Y
+18 if '$DATA(SRICD("*"))
SET SRICD("*")="NOT ENTERED"
ANES IF $DATA(^SRF(SRTN,6,0))
SET I=0
FOR J=0:0
SET I=$ORDER(^SRF(SRTN,6,I))
if 'I
QUIT
SET SRANE(I)=$PIECE(^(I,0),U)
DO AGENT
TIME SET S(.2)=$GET(^SRF(SRTN,.2))
SET (X1,SRTDG)=$PIECE(S(.2),"^",3)
SET X=$PIECE(S(.2),"^",2)
DO MINS^SRSUTL2
SET SRTIME=X
SET SRTBL=$PIECE(S(.2),"^",5)
+1 if '$DATA(SRTIME)
SET SRTIME=""
if '$DATA(SRTBL)
SET SRTBL=""
OPS SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
SET OPER=0
FOR I=0:0
SET OPER=$ORDER(^SRF(SRTN,13,OPER))
if OPER=""
QUIT
DO OTHER
+1 KILL SROPS,MM,MMM
if $LENGTH(SROPER)<75
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>74
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
ICD9 if '$DATA(SRTDG)
SET SRTDG=""
SET SRTDG=$SELECT(+SRTDG:15,1:14)
SET SRTDG1=$SELECT(SRTDG=15:3,1:1)
SET SRTDG2=$SELECT(SRTDG=15:33,1:34)
+1 SET SRICD=0
if $DATA(^SRF(SRTN,SRTDG2))
SET SRICD("*")=$PIECE(^SRF(SRTN,SRTDG2),"^")
FOR I=0:0
SET SRICD=$ORDER(^SRF(SRTN,SRTDG,SRICD))
if 'SRICD
QUIT
SET SRICD(SRICD)=$PIECE(^SRF(SRTN,SRTDG,SRICD,0),"^")
+2 if '$DATA(SRTDG("*"))
SET SRTDG("*")=""
PRINT ; print inquiry
+1 WRITE @IOF,!,SRLINE,!,"Patient: "_SRTNM,?50,"Operation Date: "_$PIECE(SRSDATE,"@"),!,"Primary Surgeon: "_SRSUR
+2 WRITE !,"Attending Surgeon: "_SRATT,?50,"Operation Time: "_SRTIME
IF SRTIME
WRITE " Minutes",!,"Attending/Res Sup Code: "_SRATCD,!,SRLINE
+3 WRITE !,"Operation(s): ",!,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,SROPS(3)
IF $DATA(SROPS(4))
WRITE !,SROPS(4)
IF $DATA(SROPS(5))
WRITE !,SROPS(5)
+4 WRITE !,SRLINE,!,$SELECT(SRTDG2=33:"Postop",1:"Preop")," Diagnosis:",?47,"Intraop Occurrences: ",SRTCMP,!,"* ",SRICD("*"),?47,"Postop Occurrences: ",SRTCMP1
FOR I=0:0
SET I=$ORDER(SRICD(I))
if 'I
QUIT
WRITE !,?4,SRICD(I)
+5 WRITE !,SRLINE,!,"Anesthesia Technique: ",?47,"Anesthetist: ",SRANE
FOR I=0:0
SET I=$ORDER(SRANE(I))
if 'I
QUIT
WRITE !,?4
SET Y=$PIECE(SRANE(I),"^")
SET C=$PIECE(^DD(130.06,.01,0),"^",2)
if Y'=""
DO Y^DIQ
if Y]""
WRITE Y
DO AGT
+6 WRITE !,SRLINE,!,"Wound Classification: ",SRTCC,!,"Intraoperative Blood Loss: ",SRTBL,$SELECT(SRTBL]"":" CC'S",1:""),!,SRLINE
+7 WRITE !!!,"Press RETURN to continue "
READ ANS:DTIME
END DO ^SRSKILL
WRITE @IOF
+1 QUIT
OTHER ; other operations
+1 SET SRLONG=1
IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRTN,13,OPER,0),"^"))>250
SET SRLONG=0
SET OPER=999
SET SROPERS=" ..."
+2 IF SRLONG
SET SROPERS=$PIECE(^SRF(SRTN,13,OPER,0),"^")
+3 SET SROPER=SROPER_$SELECT(SROPERS=" ...":SROPERS,1:", "_SROPERS)
+4 QUIT
LOOP ; break procedure if greater than 75 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)'<75
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
AGT FOR T=0:0
SET T=$ORDER(SRANE(I,T))
if 'T
QUIT
WRITE !,?6,SRANE(I,T)
+1 QUIT
AGENT ; anesthesia agents
+1 SET Q=0
FOR T=0:0
SET Q=$ORDER(^SRF(SRTN,6,I,1,Q))
if 'Q
QUIT
SET Z=$PIECE(^(Q,0),U)
Begin DoDot:1
+2 DO DATA^PSS50(Z,,,,,"SRRX")
SET SRANE(I,Q)=$PIECE($GET(^TMP($JOB,"SRRX",Z,.01)),"^")
KILL ^TMP($JOB,"SRRX",Z)
End DoDot:1
