- SROAOP1 ;BIR/MAM - SET OPERATION INFO ;02/28/07
- ;;3.0;Surgery;**38,47,63,81,88,95,97,125,142,153,160,177,182,200**;24 Jun 93;Build 9
- N SRCSTAT K SRA,SRAO F I=0,200,"OP" S SRA(I)=$G(^SRF(SRTN,I))
- S SRDOC="Primary Surgeon: "_$P(^VA(200,$P(^SRF(SRTN,.1),"^",4),0),"^") F I=4,5,6 S SRAO(I)=""
- K SROPS S SROPER=$P(SRA("OP"),"^")
- S SRAO(2)="^26"
- S:$L(SROPER)<49 SROPS(1)=SROPER K M,MM,MMM I $L(SROPER)>48 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
- S X=$P(SRA(0),"^",4) S:X X=$P(^SRO(137.45,X,0),"^",1) S SRAO(1)=X_"^.04"
- S SRHDR(.5)=SRDOC,SRPAGE="PAGE: 1 OF 2"
- S SRCSTAT=">> Coding "_$S($P($G(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
- D HDR^SROAUTL
- S X=$P($G(^SRO(136,SRTN,0)),"^",3) S:X X=$$ICD^SROICD(SRTN,X),X=$P(X,"^",2)_" "_$P(X,"^",4)
- W "Postop Diagnosis Code "_$$ICDSTR^SROICD(SRTN)_": ",$S(X'="":X,1:"NOT ENTERED"),!
- W !," 1. Surgical Specialty: ",?33,$P(SRAO(1),"^"),!," 2. Principal Operation: ",?33,SROPS(1) I $D(SROPS(2)) W !,?33,SROPS(2) I $D(SROPS(3)) W !,?33,SROPS(3) I $D(SROPS(4)) W !,?33,SROPS(4)
- S Y=$P(SRA("OP"),"^",3),C=$P(^DD(130,2006,0),"^",2) D:Y'="" Y^DIQ S:$G(Y)']"" Y="NOT ENTERED" S SRAO(3)=Y_"^2006"
- W !," 3. Robotic Assistance (Y/N):",?33,$P(SRAO(3),"^")
- N SRPROC,SRL S SRL=49 D CPTS^SROAUTL0 W !," 4. CPT Codes (view only):" I SRPROC(1)="" S SRPROC(1)="NOT ENTERED"
- F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?33,SRPROC(I) W:I'=1 !,?33,SRPROC(I)
- W !," 5. Other Procedures:" W:$O(^SRF(SRTN,13,0)) ?33,"***INFORMATION ENTERED***"
- W !," 6. Concurrent Procedure:" S CON=$P($G(^SRF(SRTN,"CON")),"^") I CON,'($P($G(^SRF(CON,30)),"^")!($P($G(^SRF(CON,31)),"^",8))) W ?33,"***INFORMATION ENTERED***"
- S X=$P(SRA(200),"^",52),SRAO(7)=X_"^214",NYUK=$P(SRA(0),"^",10) D EMERG S SRAO(8)=SHEMP_"^.035"
- S Y=$P($G(^SRF(SRTN,"1.0")),"^",8),C=$P(^DD(130,1.09,0),"^",2) D:Y'="" Y^DIQ S SRAO(9)=Y_"^1.09"
- S Y=$P($G(^SRF(SRTN,1.1)),"^",3),C=$P(^DD(130,1.13,0),"^",2) D:Y'="" Y^DIQ S SRAO(10)=Y_"^1.13"
- D TECH^SROPRIN S SRAO(11)=SRTECH
- S X=$P(SRA(200),"^",54),SRAO(12)=X_"^340" K SRA(.2)
- S Y=$P($G(^SRF(SRTN,200.1)),"^",4) D
- .I Y="" S (Y,$P(^SRF(SRTN,200.1),"^",4))="N"
- .S C=$P(^DD(130,443,0),"^",2) D:Y'="" Y^DIQ S SRAO(13)=Y_"^443"
- S Y=$P($G(^SRF(SRTN,200.1)),"^",6) D
- .I Y="" S (Y,$P(^SRF(SRTN,200.1),"^",6))="N"
- .S C=$P(^DD(130,446,0),"^",2) D:Y'="" Y^DIQ S SRAO(14)=Y_"^446"
- W !," 7. PGY of Primary Surgeon:",?33,$P(SRAO(7),"^"),!," 8. Surgical Priority:",?33,$P(SRAO(8),"^"),!," 9. Wound Classification: ",?33,$P(SRAO(9),"^")
- W !,"10. ASA Classification:",?33,$P(SRAO(10),"^")
- W !,"11. Princ. Anesthesia Technique: ",$P(SRAO(11),"^")
- W !,"12. RBC Units Transfused:",?33,$P(SRAO(12),"^")
- W !,"13. Intraop Disseminated Cancer:",?33,$P(SRAO(13),"^")
- W !,"14. Intraoperative Ascites:",?33,$P(SRAO(14),"^")
- W ! F LINE=1:1:80 W "-"
- Q
- YN S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
- Q
- LOOP ; break procedures
- S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<49 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
- Q
- EMERG ; surgical priority
- I NYUK="" S SHEMP="" Q
- S Y=NYUK,C=$P(^DD(130,.035,0),"^",2) D Y^DIQ S SHEMP=Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAOP1 3174 printed Feb 19, 2025@00:07:50 Page 2
- SROAOP1 ;BIR/MAM - SET OPERATION INFO ;02/28/07
- +1 ;;3.0;Surgery;**38,47,63,81,88,95,97,125,142,153,160,177,182,200**;24 Jun 93;Build 9
- +2 NEW SRCSTAT
- KILL SRA,SRAO
- FOR I=0,200,"OP"
- SET SRA(I)=$GET(^SRF(SRTN,I))
- +3 SET SRDOC="Primary Surgeon: "_$PIECE(^VA(200,$PIECE(^SRF(SRTN,.1),"^",4),0),"^")
- FOR I=4,5,6
- SET SRAO(I)=""
- +4 KILL SROPS
- SET SROPER=$PIECE(SRA("OP"),"^")
- +5 SET SRAO(2)="^26"
- +6 if $LENGTH(SROPER)<49
- SET SROPS(1)=SROPER
- KILL M,MM,MMM
- IF $LENGTH(SROPER)>48
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +7 SET X=$PIECE(SRA(0),"^",4)
- if X
- SET X=$PIECE(^SRO(137.45,X,0),"^",1)
- SET SRAO(1)=X_"^.04"
- +8 SET SRHDR(.5)=SRDOC
- SET SRPAGE="PAGE: 1 OF 2"
- +9 SET SRCSTAT=">> Coding "_$SELECT($PIECE($GET(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
- +10 DO HDR^SROAUTL
- +11 SET X=$PIECE($GET(^SRO(136,SRTN,0)),"^",3)
- if X
- SET X=$$ICD^SROICD(SRTN,X)
- SET X=$PIECE(X,"^",2)_" "_$PIECE(X,"^",4)
- +12 WRITE "Postop Diagnosis Code "_$$ICDSTR^SROICD(SRTN)_": ",$SELECT(X'="":X,1:"NOT ENTERED"),!
- +13 WRITE !," 1. Surgical Specialty: ",?33,$PIECE(SRAO(1),"^"),!," 2. Principal Operation: ",?33,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?33,SROPS(2)
- IF $DATA(SROPS(3))
- WRITE !,?33,SROPS(3)
- IF $DATA(SROPS(4))
- WRITE !,?33,SROPS(4)
- +14 SET Y=$PIECE(SRA("OP"),"^",3)
- SET C=$PIECE(^DD(130,2006,0),"^",2)
- if Y'=""
- DO Y^DIQ
- if $GET(Y)']""
- SET Y="NOT ENTERED"
- SET SRAO(3)=Y_"^2006"
- +15 WRITE !," 3. Robotic Assistance (Y/N):",?33,$PIECE(SRAO(3),"^")
- +16 NEW SRPROC,SRL
- SET SRL=49
- DO CPTS^SROAUTL0
- WRITE !," 4. CPT Codes (view only):"
- IF SRPROC(1)=""
- SET SRPROC(1)="NOT ENTERED"
- +17 FOR I=1:1
- if '$DATA(SRPROC(I))
- QUIT
- if I=1
- WRITE ?33,SRPROC(I)
- if I'=1
- WRITE !,?33,SRPROC(I)
- +18 WRITE !," 5. Other Procedures:"
- if $ORDER(^SRF(SRTN,13,0))
- WRITE ?33,"***INFORMATION ENTERED***"
- +19 WRITE !," 6. Concurrent Procedure:"
- SET CON=$PIECE($GET(^SRF(SRTN,"CON")),"^")
- IF CON
- IF '($PIECE($GET(^SRF(CON,30)),"^")!($PIECE($GET(^SRF(CON,31)),"^",8)))
- WRITE ?33,"***INFORMATION ENTERED***"
- +20 SET X=$PIECE(SRA(200),"^",52)
- SET SRAO(7)=X_"^214"
- SET NYUK=$PIECE(SRA(0),"^",10)
- DO EMERG
- SET SRAO(8)=SHEMP_"^.035"
- +21 SET Y=$PIECE($GET(^SRF(SRTN,"1.0")),"^",8)
- SET C=$PIECE(^DD(130,1.09,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRAO(9)=Y_"^1.09"
- +22 SET Y=$PIECE($GET(^SRF(SRTN,1.1)),"^",3)
- SET C=$PIECE(^DD(130,1.13,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRAO(10)=Y_"^1.13"
- +23 DO TECH^SROPRIN
- SET SRAO(11)=SRTECH
- +24 SET X=$PIECE(SRA(200),"^",54)
- SET SRAO(12)=X_"^340"
- KILL SRA(.2)
- +25 SET Y=$PIECE($GET(^SRF(SRTN,200.1)),"^",4)
- Begin DoDot:1
- +26 IF Y=""
- SET (Y,$PIECE(^SRF(SRTN,200.1),"^",4))="N"
- +27 SET C=$PIECE(^DD(130,443,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRAO(13)=Y_"^443"
- End DoDot:1
- +28 SET Y=$PIECE($GET(^SRF(SRTN,200.1)),"^",6)
- Begin DoDot:1
- +29 IF Y=""
- SET (Y,$PIECE(^SRF(SRTN,200.1),"^",6))="N"
- +30 SET C=$PIECE(^DD(130,446,0),"^",2)
- if Y'=""
- DO Y^DIQ
- SET SRAO(14)=Y_"^446"
- End DoDot:1
- +31 WRITE !," 7. PGY of Primary Surgeon:",?33,$PIECE(SRAO(7),"^"),!," 8. Surgical Priority:",?33,$PIECE(SRAO(8),"^"),!," 9. Wound Classification: ",?33,$PIECE(SRAO(9),"^")
- +32 WRITE !,"10. ASA Classification:",?33,$PIECE(SRAO(10),"^")
- +33 WRITE !,"11. Princ. Anesthesia Technique: ",$PIECE(SRAO(11),"^")
- +34 WRITE !,"12. RBC Units Transfused:",?33,$PIECE(SRAO(12),"^")
- +35 WRITE !,"13. Intraop Disseminated Cancer:",?33,$PIECE(SRAO(13),"^")
- +36 WRITE !,"14. Intraoperative Ascites:",?33,$PIECE(SRAO(14),"^")
- +37 WRITE !
- FOR LINE=1:1:80
- WRITE "-"
- +38 QUIT
- YN SET SHEMP=$SELECT(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
- +1 QUIT
- LOOP ; break procedures
- +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)'<49
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT
- EMERG ; surgical priority
- +1 IF NYUK=""
- SET SHEMP=""
- QUIT
- +2 SET Y=NYUK
- SET C=$PIECE(^DD(130,.035,0),"^",2)
- DO Y^DIQ
- SET SHEMP=Y
- +3 QUIT
