- 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 Mar 13, 2025@21:49:10 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
