- SROAOP1 ;BIR/MAM - SET OPERATION INFO ;02/28/07
- ;;3.0; Surgery ;**38,47,63,81,88,95,97,125,142,153,160**;24 Jun 93;Build 7
- N SRCSTAT K SRA,SRAO F I=0,200,"OP" S SRA(I)=$G(^SRF(SRTN,I))
- S SRDOC="Surgeon: "_$P(^VA(200,$P(^SRF(SRTN,.1),"^",4),0),"^") F I=3,4,5 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=$$ICDDX^ICDCODE(X,$P($G(^SRF(SRTN,0)),"^",9)),X=$P(X,"^",2)_" "_$P(X,"^",4)
- W "Postop Diagnosis Code (ICD9): ",$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)
- N SRPROC,SRL S SRL=49 D CPTS^SROAUTL0 W !," 3. 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 !," 4. Other Procedures:" W:$O(^SRF(SRTN,13,0)) ?33,"***INFORMATION ENTERED***"
- W !," 5. 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(6)=X_"^214",NYUK=$P(SRA(0),"^",10) D EMERG S SRAO(7)=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(8)=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(9)=Y_"^1.13"
- D TECH^SROPRIN S SRAO(10)=SRTECH
- S X=$P(SRA(200),"^",54),SRAO(11)=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(12)=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(13)=Y_"^446"
- W !," 6. PGY of Primary Surgeon:",?33,$P(SRAO(6),"^"),!," 7. Surgical Priority:",?33,$P(SRAO(7),"^"),!," 8. Wound Classification: ",?33,$P(SRAO(8),"^")
- W !," 9. ASA Classification:",?33,$P(SRAO(9),"^")
- W !,"10. Princ. Anesthesia Technique: ",$P(SRAO(10),"^")
- W !,"11. RBC Units Transfused:",?33,$P(SRAO(11),"^")
- W !,"12. Intraop Disseminated Cancer:",?33,$P(SRAO(12),"^")
- W !,"13. Intraoperative Ascites:",?33,$P(SRAO(13),"^")
- 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
- SROAOP1 ;BIR/MAM - SET OPERATION INFO ;02/28/07
- +1 ;;3.0; Surgery ;**38,47,63,81,88,95,97,125,142,153,160**;24 Jun 93;Build 7
- +2 NEW SRCSTAT
- KILL SRA,SRAO
- FOR I=0,200,"OP"
- SET SRA(I)=$GET(^SRF(SRTN,I))
- +3 SET SRDOC="Surgeon: "_$PIECE(^VA(200,$PIECE(^SRF(SRTN,.1),"^",4),0),"^")
- FOR I=3,4,5
- 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=$$ICDDX^ICDCODE(X,$PIECE($GET(^SRF(SRTN,0)),"^",9))
- SET X=$PIECE(X,"^",2)_" "_$PIECE(X,"^",4)
- +12 WRITE "Postop Diagnosis Code (ICD9): ",$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 NEW SRPROC,SRL
- SET SRL=49
- DO CPTS^SROAUTL0
- WRITE !," 3. CPT Codes (view only):"
- IF SRPROC(1)=""
- SET SRPROC(1)="NOT ENTERED"
- +15 FOR I=1:1
- IF '$DATA(SRPROC(I))
- QUIT
- IF I=1
- WRITE ?33,SRPROC(I)
- IF I'=1
- WRITE !,?33,SRPROC(I)
- +16 WRITE !," 4. Other Procedures:"
- IF $ORDER(^SRF(SRTN,13,0))
- WRITE ?33,"***INFORMATION ENTERED***"
- +17 WRITE !," 5. 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***"
- +18 SET X=$PIECE(SRA(200),"^",52)
- SET SRAO(6)=X_"^214"
- SET NYUK=$PIECE(SRA(0),"^",10)
- DO EMERG
- SET SRAO(7)=SHEMP_"^.035"
- +19 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(8)=Y_"^1.09"
- +20 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(9)=Y_"^1.13"
- +21 DO TECH^SROPRIN
- SET SRAO(10)=SRTECH
- +22 SET X=$PIECE(SRA(200),"^",54)
- SET SRAO(11)=X_"^340"
- KILL SRA(.2)
- +23 SET Y=$PIECE($GET(^SRF(SRTN,200.1)),"^",4)
- Begin DoDot:1
- +24 IF Y=""
- SET (Y,$PIECE(^SRF(SRTN,200.1),"^",4))="N"
- +25 SET C=$PIECE(^DD(130,443,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- SET SRAO(12)=Y_"^443"
- End DoDot:1
- +26 SET Y=$PIECE($GET(^SRF(SRTN,200.1)),"^",6)
- Begin DoDot:1
- +27 IF Y=""
- SET (Y,$PIECE(^SRF(SRTN,200.1),"^",6))="N"
- +28 SET C=$PIECE(^DD(130,446,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- SET SRAO(13)=Y_"^446"
- End DoDot:1
- +29 WRITE !," 6. PGY of Primary Surgeon:",?33,$PIECE(SRAO(6),"^"),!," 7. Surgical Priority:",?33,$PIECE(SRAO(7),"^"),!," 8. Wound Classification: ",?33,$PIECE(SRAO(8),"^")
- +30 WRITE !," 9. ASA Classification:",?33,$PIECE(SRAO(9),"^")
- +31 WRITE !,"10. Princ. Anesthesia Technique: ",$PIECE(SRAO(10),"^")
- +32 WRITE !,"11. RBC Units Transfused:",?33,$PIECE(SRAO(11),"^")
- +33 WRITE !,"12. Intraop Disseminated Cancer:",?33,$PIECE(SRAO(12),"^")
- +34 WRITE !,"13. Intraoperative Ascites:",?33,$PIECE(SRAO(13),"^")
- +35 WRITE !
- FOR LINE=1:1:80
- WRITE "-"
- +36 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